commit 9d33c3a0e8b887342c0d09596867f0ca9e05d8a7
parent 9eff29070c0e535e5f3cf88915d89234f85c80f8
Author: Stephen Chang <stchang@ccs.neu.edu>
Date: Wed, 15 Jun 2016 13:58:49 -0400
add define-base-names, eg define-base-types, abbreviation
Diffstat:
2 files changed, 6 insertions(+), 4 deletions(-)
diff --git a/tapl/stlc+sub.rkt b/tapl/stlc+sub.rkt
@@ -20,9 +20,7 @@
;; - also *
;; Other: sub? current-sub?
-(define-base-type Top)
-(define-base-type Num)
-(define-base-type Nat)
+(define-base-types Top Num Nat)
(define-primop + : (→ Num Num Num))
(define-primop * : (→ Num Num Num))
diff --git a/tapl/typecheck.rkt b/tapl/typecheck.rkt
@@ -654,6 +654,7 @@
#:with current-is-name? (format-id #'is-name? "current-~a" #'is-name?)
#:with mk-name (format-id #'name "mk-~a" #'name)
#:with define-base-name (format-id #'name "define-base-~a" #'name)
+ #:with define-base-names (format-id #'name "define-base-~as" #'name)
#:with define-name-cons (format-id #'name "define-~a-constructor" #'name)
#:with name-ann (format-id #'name "~a-ann" #'name)
#:with name=? (format-id #'name "~a=?" #'name)
@@ -662,7 +663,7 @@
#:with same-names? (format-id #'name "same-~as?" #'name)
#'(begin
(provide (for-syntax current-is-name? is-name? #%tag? mk-name name name-bind name-ann name-ctx same-names?)
- #%tag define-base-name define-name-cons)
+ #%tag define-base-name define-base-names define-name-cons)
(define #%tag void)
(begin-for-syntax
(define (#%tag? t) (and (identifier? t) (free-identifier=? t #'#%tag)))
@@ -728,6 +729,9 @@
(define-syntax define-base-name
(syntax-parser
[(_ (~var x id)) #'(define-basic-checked-id-stx x : name)]))
+ (define-syntax define-base-names
+ (syntax-parser
+ [(_ (~var x id) (... ...)) #'(begin (define-base-name x) (... ...))]))
(define-syntax define-name-cons
(syntax-parser
[(_ (~var x id) . rst) #'(define-basic-checked-stx x : name . rst)])))]))