diff --git a/private/common.rkt b/private/common.rkt index 99cf88d..c0278b3 100644 --- a/private/common.rkt +++ b/private/common.rkt @@ -80,7 +80,7 @@ ;; - syntax property key ;; Put transformers here too? Then the id table never escapes (define (make-value-property sym parser) - (define key (gensym sym)) + (define key sym) (define tbl (make-free-id-table)) (define f-parse (lambda (stx) @@ -123,16 +123,14 @@ f-define f-let)) -(define ((make-alias id-sym parser) stx) +(define ((make-alias id-stx parser) stx) (or (parser stx) - (syntax-parse stx - [_:id - #:with id-stx (format-id id-sym "~a" (syntax-e id-sym)) - (syntax/loc stx id-stx)] - [(_ e* ...) - #:with id-stx (format-id id-sym "~a" (syntax-e id-sym)) - #:with app-stx (format-id stx "#%app") - (syntax/loc stx (app-stx id-stx e* ...))]))) + (syntax-parse stx + [_:id + id-stx] + [(_ e* ...) + #:with app-stx (format-id stx "#%app") + #`(app-stx #,id-stx e* ...)]))) (define ((make-keyword-alias id-sym parser) stx) (or (parser stx) diff --git a/private/vector.rkt b/private/vector.rkt index ff32a1a..f7ca794 100644 --- a/private/vector.rkt +++ b/private/vector.rkt @@ -83,7 +83,7 @@ (define-syntax let-vector: (make-keyword-alias 'let vec-let)) (define-syntax vector-length: (make-alias #'vector-length - (lambda (stx) (printf "hehhl ~a\n" (syntax->datum stx)) (syntax-parse stx + (lambda (stx) (syntax-parse stx [(_ v:vector/length) (syntax/loc stx 'v.evidence)] [_ #f])))) diff --git a/test/regexp-fail.rkt b/test/regexp-fail.rkt index c5598a6..81ca8e7 100644 --- a/test/regexp-fail.rkt +++ b/test/regexp-fail.rkt @@ -34,15 +34,26 @@ (define rx "he(l*)(o*)") (regexp-match: rx "helloooooooo")) (U #f (List String String String))) - ;; -- set! problems - (ann (let-regexp: ([a #rx"(b)(B)"]) - (set! a #rx"") - (regexp-match: a "hai")) - (List String String String)) ;; --- Can't handle |, yet (ann (regexp-match: "this(group)|that" "that") (U #f (List String String))) ;; --- can't handle starred groups (ann (regexp-match: "(a)*(b)" "b") (U #f (List String String))) +) (test-compile-error + #:require trivial/regexp + #:exn #rx"mutation not allowed" + ;; -- set! problems + (ann (let-regexp: ([a #rx"(b)(B)"]) + (set! a #rx"") + (regexp-match: a "hai")) + (List String String String)) + (let () + (define-regexp: a #rx"h(i)") + (set! a #rx"hi") + (regexp-match a "hi")) + + (let-regexp: ([a #rx"h(i)"]) + (set! a #rx"(h)(i)") + (regexp-match a "hi")) )) diff --git a/test/regexp-pass.rkt b/test/regexp-pass.rkt index 77bf924..d0b31ff 100644 --- a/test/regexp-pass.rkt +++ b/test/regexp-pass.rkt @@ -8,24 +8,6 @@ trivial/regexp typed/rackunit) - ;; -- set! ruins everything - (check-equal? - (ann - (let () - (define-regexp: a #rx"h(i)") - (set! a #rx"hi") - (regexp-match a "hi")) - (U #f (Pairof String (Listof (U #f String))))) - (list "hi")) - - (check-equal? - (ann - (let-regexp: ([a #rx"h(i)"]) - (set! a #rx"(h)(i)") - (regexp-match a "hi")) - (U #f (Pairof String (Listof (U #f String))))) - (list "hi" "h" "i")) - ;; -- regexp-match: (check-equal? (ann diff --git a/test/vector-pass.rkt b/test/vector-pass.rkt index 8b5868c..8e94197 100644 --- a/test/vector-pass.rkt +++ b/test/vector-pass.rkt @@ -250,6 +250,15 @@ (let () (define-vector: v (vector 1 1 2 2)) (check-equal? (vector-ref: v 0) 1)) + (let () + (define-vector: v (vector 2 1 3)) + (define w (vector 2 1 3)) + (check-equal? (vector-length: v) 3) + (check-equal? (vector-length: w) 3) + (check-equal? + ((lambda ([z : (Vectorof Integer)]) + (vector-length: z)) v) + 3)) ;; -- let-vector: )