renamings
This commit is contained in:
parent
6adee321c0
commit
991f052049
|
@ -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)
|
||||
|
|
|
@ -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:")])
|
||||
|
|
|
@ -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))
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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:
|
||||
|
|
Loading…
Reference in New Issue
Block a user