renamings

pull/2/head
Matthew Butterick 8 years ago
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…
Cancel
Save