lessons learned

beautiful-racket-lib/br/syntax.rkt

@@ -128,4 +128,9 @@
   (check-equal? (syntax-property* x 'foo 'bar 'zam) '(#f #t boni)))
 
 
+;; the Søgaard technique
+;; http://blog.scheme.dk/2006/05/how-to-write-unhygienic-macro.html
+(define-syntax-rule (introduce-id (id ...) . body)
+  (with-syntax ([id (syntax-local-introduce (syntax-local-get-shadower #'id))] ...)
+    . body))
 

beautiful-racket/br/demo/hdl/expander.rkt

@@ -1,5 +1,5 @@
 #lang br
-(require "helper.rkt" (for-syntax racket/syntax racket/require-transform br/syntax))
+(require "helper.rkt" (for-syntax racket/syntax racket/require-transform br/syntax "helper.rkt"))
 (provide #%top-interaction #%module-begin #%app #%datum (all-defined-out))
 
 (define-macro (chip-program CHIPNAME
@@ -34,29 +34,13 @@
        [(_ module-path)
         (expand-import #'module-path)]))))
 
+
 (define-macro (handle-buses BUS-ASSIGNMENTS ...)
   (let-values
       ([(in-bus-assignments out-bus-assignments)
         (syntax-case-partition #'(BUS-ASSIGNMENTS ...) ()
                                [((PREFIXED-WIRE . _) _)
-                                (let ()
+                                (input-bus? (syntax-local-eval #'PREFIXED-WIRE))])])
-                                  #|
-phase 1 binding with `for-syntax` import active, no shift: (works)
-'(#<module-path-index:("Nand.hdl.rkt")> a #<module-path-index:("Nand.hdl.rkt")> Nand-a 0 1 0)
-phase 1 binding without `for-syntax` import (only regular require), but shifted up 1: (doesn't work)
-'(#<module-path-index:("Nand.hdl.rkt")> a #<module-path-index:("Nand.hdl.rkt")> Nand-a 0 0 0)
-phase 1 binding of `input-bus?` with shift 1:
-'(#<module-path-index:("helper.rkt" br/demo/hdl/expander)> input-bus #<module-path-index:("helper.rkt" br/demo/hdl/expander)> input-bus 0 0 0)
-|#
-                                  
-                                  
-                                  (syntax-local-eval (with-syntax ([ib (syntax-shift-phase-level #'input-bus? 1)]
-                                                                   [pw (syntax-shift-phase-level #'PREFIXED-WIRE 1)])
-                                                       #;(report (identifier-binding #'input-bus? 0))
-                                                       #;(report (identifier-binding #'ib 1))
-                                                       #;(report (identifier-binding #'PREFIXED-WIRE 0))
-                                                       #;(report (identifier-binding #'pw 1))
-                                                       #'(ib pw))))])])
     (with-pattern
      ([(((IN-BUS IN-BUS-ARG ...) IN-BUS-VALUE) ...) in-bus-assignments]
       [(IN-BUS-WRITE ...) (suffix-id #'(IN-BUS ...) "-write")]

beautiful-racket/br/demo/hdl/syntax-local-eval-experiment.rkt

@@ -1,21 +1,31 @@
-#lang racket
+#lang br
-(require (for-syntax racket/syntax))
+(require (for-syntax racket/syntax) rackunit)
 
 (module pred racket
-  (provide pred?)
+  (provide pred? val)
+  (define val 43)
   (define (pred? x) (zero? (modulo x 7))))
 
 (require 'pred)
-(require (for-syntax 'pred))
 
-(define val 42)
-(define-for-syntax val 43)
 
 (define-syntax (foo stx)
   (syntax-case stx ()
-    [(_) (if (syntax-local-eval (syntax-shift-phase-level #'(pred? val) 0))
+    [(_) #'(if (pred? val)
+               'yay
+               'boo)]))
+
+(check-equal? (foo) 'boo)
+
+
+(define-syntax (foo2 stx)
+  (syntax-case stx ()
+    [(_)
+     (let ()
+       (local-require (submod "." pred))
+       (if (syntax-local-eval (syntax-shift-phase-level #'(pred? val) 1))
              #''yay
-             #''boo)]))
+             #''boo))]))
 
-(foo)
+(check-equal? (foo2) 'boo)