From 6adee321c04fcd1a8a2a0eb1a017e1e2d9a3fd00 Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Thu, 26 May 2016 07:36:27 -0700
Subject: [PATCH] experiment

---
 beautiful-racket/br/demo/hdl/expander.rkt     |  8 ++-----
 .../demo/hdl/syntax-local-eval-experiment.rkt | 21 +++++++++++++++++++
 2 files changed, 23 insertions(+), 6 deletions(-)
 create mode 100644 beautiful-racket/br/demo/hdl/syntax-local-eval-experiment.rkt

diff --git a/beautiful-racket/br/demo/hdl/expander.rkt b/beautiful-racket/br/demo/hdl/expander.rkt
index 0da27d4..8188542 100644
--- a/beautiful-racket/br/demo/hdl/expander.rkt
+++ b/beautiful-racket/br/demo/hdl/expander.rkt
@@ -23,7 +23,7 @@
    ([(PARTNAME-BUS-LEFT ...) (prefix-id #'PARTNAME "-" #'(BUS-LEFT ...))]
     [CHIP-MODULE-PATH (format-string "~a.hdl.rkt" #'PARTNAME)])
    #'(begin
-       (require (import-chip CHIP-MODULE-PATH) #;(for-syntax (import-chip CHIP-MODULE-PATH)))
+       (require (import-chip CHIP-MODULE-PATH) (for-syntax (import-chip CHIP-MODULE-PATH)))
        (handle-buses ((PARTNAME-BUS-LEFT . BUS-LEFT-ARGS) BUS-RIGHT-EXPR) ...))))
 
 
@@ -34,7 +34,6 @@
        [(_ module-path)
         (expand-import #'module-path)]))))
 
-(require (for-syntax rackunit))
 (define-macro (handle-buses BUS-ASSIGNMENTS ...)
   (let-values
       ([(in-bus-assignments out-bus-assignments)
@@ -52,15 +51,12 @@ phase 1 binding of `input-bus?` with shift 1:
                                   
                                   
                                   (syntax-local-eval (with-syntax ([ib (syntax-shift-phase-level #'input-bus? 1)]
-                                                                   [pw (syntax-shift-phase-level #'PREFIXED-WIRE 3)])
+                                                                   [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))))])])
-    (check-equal? (length in-bus-assignments) 2)
-    (check-equal? (length out-bus-assignments) 1)
-    (error 'stop)
     (with-pattern
      ([(((IN-BUS IN-BUS-ARG ...) IN-BUS-VALUE) ...) in-bus-assignments]
       [(IN-BUS-WRITE ...) (suffix-id #'(IN-BUS ...) "-write")]
diff --git a/beautiful-racket/br/demo/hdl/syntax-local-eval-experiment.rkt b/beautiful-racket/br/demo/hdl/syntax-local-eval-experiment.rkt
new file mode 100644
index 0000000..df58a9f
--- /dev/null
+++ b/beautiful-racket/br/demo/hdl/syntax-local-eval-experiment.rkt
@@ -0,0 +1,21 @@
+#lang racket
+(require (for-syntax racket/syntax))
+
+(module pred racket
+  (provide pred?)
+  (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))
+             #''yay
+             #''boo)]))
+
+(foo)
+