[define] one define/let for all
This commit is contained in:
parent
f8928affc2
commit
532dba9e53
30
define.rkt
Normal file
30
define.rkt
Normal file
|
@ -0,0 +1,30 @@
|
||||||
|
#lang typed/racket/base
|
||||||
|
|
||||||
|
(provide
|
||||||
|
define: let:
|
||||||
|
)
|
||||||
|
|
||||||
|
(require
|
||||||
|
(for-syntax
|
||||||
|
trivial/private/common
|
||||||
|
racket/base)
|
||||||
|
(only-in trivial/private/math
|
||||||
|
num-define
|
||||||
|
num-let)
|
||||||
|
(only-in trivial/private/regexp
|
||||||
|
rx-define
|
||||||
|
rx-let)
|
||||||
|
(only-in trivial/private/vector
|
||||||
|
vec-define
|
||||||
|
vec-let))
|
||||||
|
|
||||||
|
(define-syntax define: (make-keyword-alias 'define
|
||||||
|
(lambda (stx)
|
||||||
|
(or (num-define stx)
|
||||||
|
(rx-define stx)
|
||||||
|
(vec-define stx)))))
|
||||||
|
(define-syntax let: (make-keyword-alias 'let
|
||||||
|
(lambda (stx)
|
||||||
|
(or (num-let stx)
|
||||||
|
(rx-let stx)
|
||||||
|
(vec-let stx)))))
|
7
define/no-colon.rkt
Normal file
7
define/no-colon.rkt
Normal file
|
@ -0,0 +1,7 @@
|
||||||
|
#lang typed/racket/base
|
||||||
|
|
||||||
|
(provide (rename-out
|
||||||
|
[define: define]
|
||||||
|
[let: let]))
|
||||||
|
|
||||||
|
(require trivial/define)
|
12
main.rkt
12
main.rkt
|
@ -1,11 +1,19 @@
|
||||||
#lang typed/racket/base
|
#lang typed/racket/base
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
|
(all-from-out trivial/define)
|
||||||
(all-from-out trivial/format)
|
(all-from-out trivial/format)
|
||||||
|
(all-from-out trivial/function)
|
||||||
(all-from-out trivial/math)
|
(all-from-out trivial/math)
|
||||||
(all-from-out trivial/regexp))
|
(all-from-out trivial/regexp)
|
||||||
|
(all-from-out trivial/vector))
|
||||||
|
|
||||||
(require
|
(require
|
||||||
|
;trivial/db
|
||||||
|
trivial/define
|
||||||
trivial/format
|
trivial/format
|
||||||
|
trivial/function
|
||||||
trivial/math
|
trivial/math
|
||||||
trivial/regexp)
|
trivial/regexp
|
||||||
|
trivial/vector)
|
||||||
|
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
#lang typed/racket/base
|
#lang typed/racket/base
|
||||||
|
|
||||||
;; TODO do not use this library, it's just for demonstration
|
;; TODO do not use this library, it's just for demonstration
|
||||||
|
;; TODO confusing row/column
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
start-transaction
|
start-transaction
|
||||||
|
|
|
@ -5,6 +5,7 @@
|
||||||
;; -
|
;; -
|
||||||
;; - vectorized ops
|
;; - vectorized ops
|
||||||
;; - (TODO) improve apply/map? ask Leif
|
;; - (TODO) improve apply/map? ask Leif
|
||||||
|
;; - TODO get types, not arity
|
||||||
|
|
||||||
(provide
|
(provide
|
||||||
curry:
|
curry:
|
||||||
|
|
|
@ -17,7 +17,9 @@
|
||||||
stx->num
|
stx->num
|
||||||
nat/expand
|
nat/expand
|
||||||
int/expand
|
int/expand
|
||||||
num/expand)
|
num/expand
|
||||||
|
num-define
|
||||||
|
num-let)
|
||||||
)
|
)
|
||||||
|
|
||||||
(require (for-syntax
|
(require (for-syntax
|
||||||
|
|
|
@ -11,6 +11,10 @@
|
||||||
let-regexp:
|
let-regexp:
|
||||||
|
|
||||||
regexp-match:
|
regexp-match:
|
||||||
|
|
||||||
|
(for-syntax
|
||||||
|
rx-define
|
||||||
|
rx-let)
|
||||||
)
|
)
|
||||||
|
|
||||||
(require
|
(require
|
||||||
|
@ -104,7 +108,7 @@
|
||||||
(define parse-groups/byte-pregexp
|
(define parse-groups/byte-pregexp
|
||||||
parse-groups/byte-regexp)
|
parse-groups/byte-regexp)
|
||||||
|
|
||||||
(define-values (num-groups-key rx? def-rx let-rx)
|
(define-values (num-groups-key rx? rx-define rx-let)
|
||||||
(make-value-property 'rx:groups parse-groups))
|
(make-value-property 'rx:groups parse-groups))
|
||||||
(define-syntax-class/predicate pattern/groups rx?)
|
(define-syntax-class/predicate pattern/groups rx?)
|
||||||
)
|
)
|
||||||
|
@ -128,8 +132,8 @@
|
||||||
|
|
||||||
(define-matcher* regexp pregexp byte-regexp byte-pregexp)
|
(define-matcher* regexp pregexp byte-regexp byte-pregexp)
|
||||||
|
|
||||||
(define-syntax define-regexp: (make-keyword-alias 'define def-rx))
|
(define-syntax define-regexp: (make-keyword-alias 'define rx-define))
|
||||||
(define-syntax let-regexp: (make-keyword-alias 'let let-rx))
|
(define-syntax let-regexp: (make-keyword-alias 'let rx-let))
|
||||||
|
|
||||||
(define-syntax regexp-match: (make-alias #'regexp-match
|
(define-syntax regexp-match: (make-alias #'regexp-match
|
||||||
(lambda (stx) (syntax-parse stx
|
(lambda (stx) (syntax-parse stx
|
||||||
|
|
|
@ -21,6 +21,8 @@
|
||||||
|
|
||||||
;; --- private
|
;; --- private
|
||||||
(for-syntax
|
(for-syntax
|
||||||
|
vec-define
|
||||||
|
vec-let
|
||||||
parse-vector-length
|
parse-vector-length
|
||||||
vector-length-key)
|
vector-length-key)
|
||||||
)
|
)
|
||||||
|
@ -58,6 +60,7 @@
|
||||||
#(e* ...)
|
#(e* ...)
|
||||||
;; TODO #{} #[] #6{} ...
|
;; TODO #{} #[] #6{} ...
|
||||||
(#%plain-app vector e* ...)
|
(#%plain-app vector e* ...)
|
||||||
|
(#%plain-app vector e* ...)
|
||||||
(vector e* ...))
|
(vector e* ...))
|
||||||
(length (syntax-e #'(e* ...)))]
|
(length (syntax-e #'(e* ...)))]
|
||||||
[(~or (make-vector n e* ...)
|
[(~or (make-vector n e* ...)
|
||||||
|
@ -80,7 +83,7 @@
|
||||||
(define-syntax let-vector: (make-keyword-alias 'let vec-let))
|
(define-syntax let-vector: (make-keyword-alias 'let vec-let))
|
||||||
|
|
||||||
(define-syntax vector-length: (make-alias #'vector-length
|
(define-syntax vector-length: (make-alias #'vector-length
|
||||||
(lambda (stx) (syntax-parse stx
|
(lambda (stx) (printf "hehhl ~a\n" (syntax->datum stx)) (syntax-parse stx
|
||||||
[(_ v:vector/length)
|
[(_ v:vector/length)
|
||||||
(syntax/loc stx 'v.evidence)]
|
(syntax/loc stx 'v.evidence)]
|
||||||
[_ #f]))))
|
[_ #f]))))
|
||||||
|
|
24
test/define-pass.rkt
Normal file
24
test/define-pass.rkt
Normal file
|
@ -0,0 +1,24 @@
|
||||||
|
#lang typed/racket/base
|
||||||
|
(require trivial/define trivial/math trivial/regexp trivial/vector)
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require typed/rackunit)
|
||||||
|
|
||||||
|
(check-equal?
|
||||||
|
(let ()
|
||||||
|
(define: n 3)
|
||||||
|
(let: ([m n])
|
||||||
|
(ann (-: n m) Zero)))
|
||||||
|
0)
|
||||||
|
|
||||||
|
(check-equal?
|
||||||
|
(let: ([x (regexp: "(a*)(b*)")])
|
||||||
|
(let ([m (regexp-match: x "aaabbb")])
|
||||||
|
(if m (string-append (cadr m) (caddr m)) "")))
|
||||||
|
"aaabbb")
|
||||||
|
|
||||||
|
(check-equal?
|
||||||
|
(let: ([v '#(3 9 2)])
|
||||||
|
(ann (-: (vector-length: v) 3) Zero))
|
||||||
|
0)
|
||||||
|
)
|
|
@ -255,6 +255,11 @@
|
||||||
'(#"hellooo" #"ll" #"ooo"))
|
'(#"hellooo" #"ll" #"ooo"))
|
||||||
|
|
||||||
;; -- special cases / miscellaneous
|
;; -- special cases / miscellaneous
|
||||||
|
(check-equal?
|
||||||
|
(ann
|
||||||
|
(regexp-match: "((a)b)" "ab")
|
||||||
|
(U #f (List String String String)))
|
||||||
|
'("ab" "ab" "a"))
|
||||||
|
|
||||||
;; --- Can't handle |, yet
|
;; --- Can't handle |, yet
|
||||||
(check-equal?
|
(check-equal?
|
||||||
|
|
Loading…
Reference in New Issue
Block a user