[icfp] fix define/no-colon
This commit is contained in:
parent
f6840626d2
commit
38d79619f0
|
@ -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)
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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* ...))])))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user