[private] stop gensym'ming keys

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
+      (syntax-parse stx
-     [_:id
+       [_:id
-      #:with id-stx (format-id id-sym "~a" (syntax-e id-sym))
+        id-stx]
-      (syntax/loc stx id-stx)]
+       [(_ e* ...)
-     [(_ e* ...)
+        #:with app-stx (format-id stx "#%app")
-      #:with id-stx (format-id id-sym "~a" (syntax-e id-sym))
+        #`(app-stx #,id-stx e* ...)])))
-      #:with app-stx (format-id stx "#%app")
-      (syntax/loc stx (app-stx id-stx e* ...))])))
 
 (define ((make-keyword-alias id-sym parser) stx)
   (or (parser stx)

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]))))

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"))
 ))

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

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:
 )