From 9d33c3a0e8b887342c0d09596867f0ca9e05d8a7 Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Wed, 15 Jun 2016 13:58:49 -0400 Subject: [PATCH] add define-base-names, eg define-base-types, abbreviation --- tapl/stlc+sub.rkt | 4 +--- tapl/typecheck.rkt | 6 +++++- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/tapl/stlc+sub.rkt b/tapl/stlc+sub.rkt index 4a0490e..5a70064 100644 --- 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 index 1ca6f97..0b08e8e 100644 --- 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)])))]))