diff --git a/define.rkt b/define.rkt index 13d6cb0..1e10e59 100644 --- a/define.rkt +++ b/define.rkt @@ -9,7 +9,8 @@ trivial/private/set-bang (for-syntax trivial/private/common - racket/base) + syntax/parse + typed/racket/base) (only-in trivial/private/math num-define num-let) @@ -25,6 +26,7 @@ (or (num-define stx) (rx-define stx) (vec-define stx))))) + (define-syntax let: (make-keyword-alias 'let (lambda (stx) (or (num-let stx) diff --git a/define/no-colon.rkt b/define/no-colon.rkt index cbc9b17..7299d83 100644 --- a/define/no-colon.rkt +++ b/define/no-colon.rkt @@ -1,6 +1,4 @@ #lang typed/racket/base -;; TODO Can't yet remove the colon from define: and let:, its breaking things - -(provide (all-from-out trivial/define)) +(provide (rename-out [define: define] [let: let])) (require trivial/define) diff --git a/private/common.rkt b/private/common.rkt index c0278b3..cd1d386 100644 --- a/private/common.rkt +++ b/private/common.rkt @@ -29,10 +29,9 @@ racket/syntax syntax/parse syntax/id-table - (for-syntax (only-in typed/racket/base let let-syntax #%app)) (for-template - (prefix-in r: (only-in racket/base quote)) - (prefix-in tr: (only-in typed/racket/base quote)))) + (prefix-in tr: (only-in typed/racket/base define let let-syntax quote set!)) + (prefix-in r: (only-in racket/base quote)))) ;; ============================================================================= @@ -97,10 +96,9 @@ #:when (syntax-e (syntax/loc stx v+)) #:with m (f-parse (syntax/loc stx v+)) #:when (syntax-e (syntax/loc stx m)) - #:with define-stx (format-id stx "define") (free-id-table-set! tbl #'name (syntax-e #'m)) (syntax/loc stx - (define-stx name v+))] + (tr:define name v+))] [_ #f]))) (define f-let (lambda (stx) @@ -109,12 +107,10 @@ #:with (v+* ...) (map expand-expr (syntax-e (syntax/loc stx (v* ...)))) #:with (m* ...) (map f-parse (syntax-e (syntax/loc stx (v+* ...)))) #:when (andmap syntax-e (syntax-e (syntax/loc stx (m* ...)))) - #:with let-stx (format-id stx "let") - #:with let-syntax-stx (format-id stx "let-syntax") (quasisyntax/loc stx - (let-stx ([name* v+*] ...) - (let-syntax-stx ([name* (make-rename-transformer - (syntax-property #'name* '#,key 'm*))] ...) + (tr:let ([name* v+*] ...) + (tr:let-syntax ([name* (make-rename-transformer + (syntax-property #'name* '#,key 'm*))] ...) e* ...)))] [_ #f]))) (values @@ -136,5 +132,9 @@ (or (parser stx) (syntax-parse stx [(_ e* ...) - #:with id-stx (format-id stx "~a" id-sym) + #:with id-stx (case id-sym + [(define) #'tr:define] + [(let) #'tr:let] + [(set!) #'tr:set!] + [else (error 'trivial "Unknown keyword '~a'" id-sym)]) (syntax/loc stx (id-stx e* ...))]))) diff --git a/private/math.rkt b/private/math.rkt index 47875f4..6bb3f05 100644 --- a/private/math.rkt +++ b/private/math.rkt @@ -92,8 +92,8 @@ ;; ----------------------------------------------------------------------------- -(define-syntax define-num: (make-keyword-alias #'define num-define)) -(define-syntax let-num: (make-keyword-alias #'let num-let)) +(define-syntax define-num: (make-keyword-alias 'define num-define)) +(define-syntax let-num: (make-keyword-alias 'let num-let)) (define-syntax make-numeric-operator (syntax-parser diff --git a/private/set-bang.rkt b/private/set-bang.rkt index d73cdf8..2dab6ef 100644 --- a/private/set-bang.rkt +++ b/private/set-bang.rkt @@ -24,7 +24,7 @@ ; (syntax-property stx rx-key) ; (syntax-property stx vector-length-key))) -(define-syntax set!: (make-keyword-alias #'set! +(define-syntax set!: (make-keyword-alias 'set! (lambda (stx) (syntax-parse stx [(_ name val) #:when (has-important-syntax-property? #'name)