diff --git a/beautiful-racket-lib/br/define.rkt b/beautiful-racket-lib/br/define.rkt index da19ca2..e8d15fd 100644 --- a/beautiful-racket-lib/br/define.rkt +++ b/beautiful-racket-lib/br/define.rkt @@ -250,11 +250,14 @@ #'(datum->syntax caller-stx (if (syntax? form) (syntax-e form) form))]))])))) -(provide (for-syntax let-shared-id)) +(provide (for-syntax with-shared-id with-calling-site-id)) (begin-for-syntax - (define-syntax-rule (let-shared-id (id ...) . body) + (define-syntax-rule (with-shared-id (id ...) . body) (with-syntax ([id (shared-syntax 'id)] ...) - . body))) + . body)) + + (define-syntax with-calling-site-id (make-rename-transformer #'with-shared-id))) + (define-syntax (br:define-cases-inverting stx) (syntax-case stx (syntax) diff --git a/beautiful-racket-lib/br/main.rkt b/beautiful-racket-lib/br/main.rkt index 17bf42d..723edfb 100644 --- a/beautiful-racket-lib/br/main.rkt +++ b/beautiful-racket-lib/br/main.rkt @@ -6,7 +6,7 @@ (all-from-out racket/list racket/string racket/format racket/match racket/port br/syntax br/datum br/debug br/conditional) (for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug)) - (for-syntax caller-stx shared-syntax let-shared-id) ; from br/define + (for-syntax caller-stx shared-syntax with-shared-id with-calling-site-id) ; from br/define (filtered-out (λ (name) (let ([pat (regexp "^br:")]) diff --git a/beautiful-racket-lib/br/syntax.rkt b/beautiful-racket-lib/br/syntax.rkt index f6815f2..c6b36ec 100644 --- a/beautiful-racket-lib/br/syntax.rkt +++ b/beautiful-racket-lib/br/syntax.rkt @@ -127,10 +127,5 @@ (check-true (syntax-property* x 'bar)) (check-equal? (syntax-property* x 'foo 'bar 'zam) '(#f #t boni))) -(define-syntax-rule (introduce-id (id ...) . body) - (with-syntax ([id (syntax-local-introduce (datum->syntax #f 'id))] ...) - . body)) -(define-syntax with-shared-id (make-rename-transformer #'introduce-id)) -(define-syntax mark-as-shared-id (make-rename-transformer #'introduce-id)) diff --git a/beautiful-racket/br/demo/hdl-tst/expander.rkt b/beautiful-racket/br/demo/hdl-tst/expander.rkt index 39f88f1..0246304 100644 --- a/beautiful-racket/br/demo/hdl-tst/expander.rkt +++ b/beautiful-racket/br/demo/hdl-tst/expander.rkt @@ -36,9 +36,11 @@ (define-macro (tst-program EXPR ...) - #'(begin - EXPR ... - (compare-files))) + (with-shared-id + (compare-files) + #'(begin + EXPR ... + (compare-files)))) (define-macro (load-expr CHIPFILE-STRING) @@ -49,7 +51,7 @@ (define-macro (output-file-expr OUTPUT-FILE-STRING) - (mark-as-shared-id + (with-shared-id (output-file output-filename) #'(begin (define output-filename OUTPUT-FILE-STRING) @@ -60,15 +62,15 @@ (define-macro (compare-to-expr COMPARE-FILE-STRING) - (mark-as-shared-id - (compare-files) + (with-shared-id + (compare-files output-filename) #'(define (compare-files) (check-equal? (file->lines output-filename) (file->lines COMPARE-FILE-STRING))))) (define-macro (output-list-expr (COL-NAME FORMAT-SPEC) ...) - (mark-as-shared-id - (eval-result eval-chip output) + (with-shared-id + (eval-result eval-chip output output-filename) (with-pattern ([(COL-ID ...) (suffix-id #'(COL-NAME ...))] [(CHIP-COL-ID ...) (prefix-id chip-prefix "-" #'(COL-NAME ...))]) @@ -86,7 +88,13 @@ #'(CHIP-IN-BUS-ID-WRITE IN-VAL))) -(define-macro (eval-expr) #'(set! eval-result (eval-chip))) +(define-macro (eval-expr) + (with-shared-id + (eval-result eval-chip) + #'(set! eval-result (eval-chip)))) -(define-macro (output-expr) #'(apply output eval-result)) +(define-macro (output-expr) + (with-shared-id + (output eval-result) + #'(apply output eval-result))) diff --git a/beautiful-racket/br/demo/txtadv/expander.rkt b/beautiful-racket/br/demo/txtadv/expander.rkt index 97f8b88..dcb1277 100644 --- a/beautiful-racket/br/demo/txtadv/expander.rkt +++ b/beautiful-racket/br/demo/txtadv/expander.rkt @@ -40,7 +40,7 @@ (provide verb-section) (define-macro-cases verb-section [(_ ((NAME0 . TRANSITIVE0?) (NAME . _) ... DESC) ...) - (mark-as-shared-id + (with-shared-id (in-verbs) #'(define-verbs in-verbs [(NAME0 . TRANSITIVE0?) (= NAME ...) DESC] ...))]) @@ -70,9 +70,11 @@ (provide start-section) (define-macro (start-section WHERE) - #'(init-game WHERE - in-verbs - everywhere-actions)) + (with-shared-id + (in-verbs) + #'(init-game WHERE + in-verbs + everywhere-actions))) ;; ============================================================ ;; Model: