suzanne.soy/beautiful-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

experiment

Browse Source
This commit is contained in:
Matthew Butterick 2016-05-26 07:36:27 -07:00
parent 3e036415b2
commit 6adee321c0
2 changed files with 23 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
beautiful-racket/br/demo/hdl/expander.rkt
View File

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

21
beautiful-racket/br/demo/hdl/syntax-local-eval-experiment.rkt Normal file
View File

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