scopes

beautiful-racket-lib/br/syntax-scopes-test.rkt

@@ -8,36 +8,54 @@
   (define-scope green (blue yellow))
   (define-scope purple (blue red)))
 
-(define #'(define-blue _id _val)
-  (with-blue-binding-form ([x '_id])
-    #'(define x _val)))
+(define #'(def-blue-x)
+  (with-blue-binding-form (x)
+                          #'(define x (+ 42 42))))
 
-#;(define-blue x (+ 42 42))
 
-(define #'(def-x)
-  (with-blue-binding-form ([x 'x])
-    #'(define x (+ 42 42))))
+(define #'(print-blue-x)
+  (with-purple-identifiers (x)
+                           #'x))
 
-(define #'(def-x-2)
-  (with-yellow-binding-form ([x 'x])
-    #'(define x (+ 42))))
 
-(define #'(print-x)
-  (with-yellow-syntax ([x 'x])
-                      #'(println (+ x x))))
+(define #'(define-blue _id _expr)
+  (with-syntax ([_id (blue-binding-form #'_id)])
+    #'(define _id _expr)))
 
-(define #'(print-x-2)
-  (with-purple-syntax ([x 'x])
-                      #'(println (+ x x x))))
 
 
-(scopes (syntax-find (expand-once #'(def-x)) 'x))
-(def-x)
-(def-x-2)
+(define #'(print-blue-y)
+  (with-blue-identifiers (y)
+                         #'y))
+
+(scopes (syntax-find (expand-once #'(def-blue-x)) 'x))
+(def-blue-x)
+(scopes (syntax-find (expand-once #'(print-blue-x)) 'x))
+(print-blue-x)
+(let ()
+  (scopes (syntax-find (expand-once #'(print-blue-x)) 'x))
+  #;(print-blue-x)) ;; error why?
+
+(define-blue y (+ 42 42))
+(print-blue-y)
+
+#|
+(define #'(def-y)
+  (with-yellow-binding-form (y)
+                            #'(define y (+ 42))))
+
+
+
+
+#;(scopes (syntax-find (expand-once #'(def-x)) 'x))
+#;(def-x)
+(def-y)
 (scopes (syntax-find (expand-once #'(print-x)) 'x))
 (print-x)
-(scopes (syntax-find (expand-once #'(print-x-2)) 'x))
-(print-x-2)
+(scopes (syntax-find (expand-once #'(print-y)) 'y))
+(print-y)
 
 #;(let-syntax ([x (λ(stx) (syntax-case stx () [_ #'42]))])
-  (* x 4))
+    (* x 4))
+
+|#

beautiful-racket-lib/br/syntax.rkt

@@ -67,9 +67,9 @@
           [else (raise-argument-error 'syntax-find "not given syntax or datum as second argument" stx-or-datum)]))
   (let/ec exit
     (let loop ([so stx])
-        (cond
-          [(eq? (syntax->datum so) datum) (exit so)]
-          [(syntax->list so) => (curry map loop)]))))
+      (cond
+        [(eq? (syntax->datum so) datum) (exit so)]
+        [(syntax->list so) => (curry map loop)]))))
 
 
 (define (->syntax x)
@@ -85,7 +85,8 @@
                    [add-id (format-id #'id "add-~a" #'id)]
                    [flip-id (format-id #'id "flip-~a" #'id)]
                    [id-binding-form (format-id #'id "~a-binding-form" #'id)]
-                   [with-id-syntax (format-id #'id "with-~a-syntax" #'id)]
+                   [define-id (format-id #'id "define-~a" #'id)]
+                   [with-id-identifiers (format-id #'id "with-~a-identifiers" #'id)]
                    [let-id-syntax (format-id #'id "let-~a-syntax" #'id)]
                    [with-id-binding-form (format-id #'id "with-~a-binding-form" #'id)]
                    [remove-id (format-id #'id "remove-~a" #'id)]
@@ -113,10 +114,10 @@
               (member (car (context (add-id (datum->syntax #f '_))))
                       (context (->syntax x)))
               #t))
-           (define-syntax-rule (with-id-syntax ([pat val] (... ...)) . body)
-             (with-syntax ([pat (id* val)] (... ...)) . body))
-           (define-syntax-rule (with-id-binding-form ([pat val] (... ...)) . body)
-             (with-syntax ([pat (id-binding-form val)] (... ...)) . body))
+           (define-syntax-rule (with-id-identifiers (name (... ...)) . body)
+             (with-syntax ([name (id* 'name)] (... ...)) . body))
+           (define-syntax-rule (with-id-binding-form  (name (... ...)) . body)
+             (with-syntax ([name (id-binding-form 'name)] (... ...)) . body))
            (define-syntax-rule (let-id-syntax ([pat val] (... ...)) . body)
              (let-syntax ([pat (id* val)] (... ...)) . body))))]))