[icfp] fix define/no-colon

This commit is contained in:
ben 2016-03-14 20:31:16 -04:00
parent f6840626d2
commit 38d79619f0
5 changed files with 18 additions and 18 deletions

View File

@ -9,7 +9,8 @@
trivial/private/set-bang trivial/private/set-bang
(for-syntax (for-syntax
trivial/private/common trivial/private/common
racket/base) syntax/parse
typed/racket/base)
(only-in trivial/private/math (only-in trivial/private/math
num-define num-define
num-let) num-let)
@ -25,6 +26,7 @@
(or (num-define stx) (or (num-define stx)
(rx-define stx) (rx-define stx)
(vec-define stx))))) (vec-define stx)))))
(define-syntax let: (make-keyword-alias 'let (define-syntax let: (make-keyword-alias 'let
(lambda (stx) (lambda (stx)
(or (num-let stx) (or (num-let stx)

View File

@ -1,6 +1,4 @@
#lang typed/racket/base #lang typed/racket/base
;; TODO Can't yet remove the colon from define: and let:, its breaking things (provide (rename-out [define: define] [let: let]))
(provide (all-from-out trivial/define))
(require trivial/define) (require trivial/define)

View File

@ -29,10 +29,9 @@
racket/syntax racket/syntax
syntax/parse syntax/parse
syntax/id-table syntax/id-table
(for-syntax (only-in typed/racket/base let let-syntax #%app))
(for-template (for-template
(prefix-in r: (only-in racket/base quote)) (prefix-in tr: (only-in typed/racket/base define let let-syntax quote set!))
(prefix-in tr: (only-in typed/racket/base quote)))) (prefix-in r: (only-in racket/base quote))))
;; ============================================================================= ;; =============================================================================
@ -97,10 +96,9 @@
#:when (syntax-e (syntax/loc stx v+)) #:when (syntax-e (syntax/loc stx v+))
#:with m (f-parse (syntax/loc stx v+)) #:with m (f-parse (syntax/loc stx v+))
#:when (syntax-e (syntax/loc stx m)) #:when (syntax-e (syntax/loc stx m))
#:with define-stx (format-id stx "define")
(free-id-table-set! tbl #'name (syntax-e #'m)) (free-id-table-set! tbl #'name (syntax-e #'m))
(syntax/loc stx (syntax/loc stx
(define-stx name v+))] (tr:define name v+))]
[_ #f]))) [_ #f])))
(define f-let (define f-let
(lambda (stx) (lambda (stx)
@ -109,11 +107,9 @@
#:with (v+* ...) (map expand-expr (syntax-e (syntax/loc stx (v* ...)))) #:with (v+* ...) (map expand-expr (syntax-e (syntax/loc stx (v* ...))))
#:with (m* ...) (map f-parse (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* ...)))) #: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 (quasisyntax/loc stx
(let-stx ([name* v+*] ...) (tr:let ([name* v+*] ...)
(let-syntax-stx ([name* (make-rename-transformer (tr:let-syntax ([name* (make-rename-transformer
(syntax-property #'name* '#,key 'm*))] ...) (syntax-property #'name* '#,key 'm*))] ...)
e* ...)))] e* ...)))]
[_ #f]))) [_ #f])))
@ -136,5 +132,9 @@
(or (parser stx) (or (parser stx)
(syntax-parse stx (syntax-parse stx
[(_ e* ...) [(_ 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* ...))]))) (syntax/loc stx (id-stx e* ...))])))

View File

@ -92,8 +92,8 @@
;; ----------------------------------------------------------------------------- ;; -----------------------------------------------------------------------------
(define-syntax define-num: (make-keyword-alias #'define num-define)) (define-syntax define-num: (make-keyword-alias 'define num-define))
(define-syntax let-num: (make-keyword-alias #'let num-let)) (define-syntax let-num: (make-keyword-alias 'let num-let))
(define-syntax make-numeric-operator (define-syntax make-numeric-operator
(syntax-parser (syntax-parser

View File

@ -24,7 +24,7 @@
; (syntax-property stx rx-key) ; (syntax-property stx rx-key)
; (syntax-property stx vector-length-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 (lambda (stx) (syntax-parse stx
[(_ name val) [(_ name val)
#:when (has-important-syntax-property? #'name) #:when (has-important-syntax-property? #'name)