From 5c15093fc9018a2b124a7239e770372603c1d298 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 26 May 2016 16:39:43 -0700 Subject: [PATCH] lessons learned --- beautiful-racket-lib/br/syntax.rkt | 5 ++++ beautiful-racket/br/demo/hdl/expander.rkt | 22 ++------------- .../demo/hdl/syntax-local-eval-experiment.rkt | 28 +++++++++++++------ 3 files changed, 27 insertions(+), 28 deletions(-) diff --git a/beautiful-racket-lib/br/syntax.rkt b/beautiful-racket-lib/br/syntax.rkt index c6b36ec..5d00f83 100644 --- a/beautiful-racket-lib/br/syntax.rkt +++ b/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)) diff --git a/beautiful-racket/br/demo/hdl/expander.rkt b/beautiful-racket/br/demo/hdl/expander.rkt index 8188542..9e53675 100644 --- a/beautiful-racket/br/demo/hdl/expander.rkt +++ b/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 () - #| -phase 1 binding with `for-syntax` import active, no shift: (works) -'(# a # Nand-a 0 1 0) -phase 1 binding without `for-syntax` import (only regular require), but shifted up 1: (doesn't work) -'(# a # Nand-a 0 0 0) -phase 1 binding of `input-bus?` with shift 1: -'(# input-bus # 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))))])]) + (input-bus? (syntax-local-eval #'PREFIXED-WIRE))])]) (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 index df58a9f..f519539 100644 --- a/beautiful-racket/br/demo/hdl/syntax-local-eval-experiment.rkt +++ b/beautiful-racket/br/demo/hdl/syntax-local-eval-experiment.rkt @@ -1,21 +1,31 @@ -#lang racket -(require (for-syntax racket/syntax)) +#lang br +(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)