renamings

pull/2/head
Matthew Butterick 9 years ago
parent 6adee321c0
commit 991f052049

@ -250,11 +250,14 @@
#'(datum->syntax caller-stx (if (syntax? form) #'(datum->syntax caller-stx (if (syntax? form)
(syntax-e form) (syntax-e form)
form))]))])))) form))]))]))))
(provide (for-syntax let-shared-id)) (provide (for-syntax with-shared-id with-calling-site-id))
(begin-for-syntax (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)] ...) (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) (define-syntax (br:define-cases-inverting stx)
(syntax-case stx (syntax) (syntax-case stx (syntax)

@ -6,7 +6,7 @@
(all-from-out racket/list racket/string racket/format racket/match racket/port (all-from-out racket/list racket/string racket/format racket/match racket/port
br/syntax br/datum br/debug br/conditional) br/syntax br/datum br/debug br/conditional)
(for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug)) (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 (filtered-out
(λ (name) (λ (name)
(let ([pat (regexp "^br:")]) (let ([pat (regexp "^br:")])

@ -127,10 +127,5 @@
(check-true (syntax-property* x 'bar)) (check-true (syntax-property* x 'bar))
(check-equal? (syntax-property* x 'foo 'bar 'zam) '(#f #t boni))) (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 ...) (define-macro (tst-program EXPR ...)
#'(begin (with-shared-id
EXPR ... (compare-files)
(compare-files))) #'(begin
EXPR ...
(compare-files))))
(define-macro (load-expr CHIPFILE-STRING) (define-macro (load-expr CHIPFILE-STRING)
@ -49,7 +51,7 @@
(define-macro (output-file-expr OUTPUT-FILE-STRING) (define-macro (output-file-expr OUTPUT-FILE-STRING)
(mark-as-shared-id (with-shared-id
(output-file output-filename) (output-file output-filename)
#'(begin #'(begin
(define output-filename OUTPUT-FILE-STRING) (define output-filename OUTPUT-FILE-STRING)
@ -60,15 +62,15 @@
(define-macro (compare-to-expr COMPARE-FILE-STRING) (define-macro (compare-to-expr COMPARE-FILE-STRING)
(mark-as-shared-id (with-shared-id
(compare-files) (compare-files output-filename)
#'(define (compare-files) #'(define (compare-files)
(check-equal? (file->lines output-filename) (file->lines COMPARE-FILE-STRING))))) (check-equal? (file->lines output-filename) (file->lines COMPARE-FILE-STRING)))))
(define-macro (output-list-expr (COL-NAME FORMAT-SPEC) ...) (define-macro (output-list-expr (COL-NAME FORMAT-SPEC) ...)
(mark-as-shared-id (with-shared-id
(eval-result eval-chip output) (eval-result eval-chip output output-filename)
(with-pattern (with-pattern
([(COL-ID ...) (suffix-id #'(COL-NAME ...))] ([(COL-ID ...) (suffix-id #'(COL-NAME ...))]
[(CHIP-COL-ID ...) (prefix-id chip-prefix "-" #'(COL-NAME ...))]) [(CHIP-COL-ID ...) (prefix-id chip-prefix "-" #'(COL-NAME ...))])
@ -86,7 +88,13 @@
#'(CHIP-IN-BUS-ID-WRITE IN-VAL))) #'(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) (provide verb-section)
(define-macro-cases verb-section (define-macro-cases verb-section
[(_ ((NAME0 . TRANSITIVE0?) (NAME . _) ... DESC) ...) [(_ ((NAME0 . TRANSITIVE0?) (NAME . _) ... DESC) ...)
(mark-as-shared-id (with-shared-id
(in-verbs) (in-verbs)
#'(define-verbs in-verbs #'(define-verbs in-verbs
[(NAME0 . TRANSITIVE0?) (= NAME ...) DESC] ...))]) [(NAME0 . TRANSITIVE0?) (= NAME ...) DESC] ...))])
@ -70,9 +70,11 @@
(provide start-section) (provide start-section)
(define-macro (start-section WHERE) (define-macro (start-section WHERE)
#'(init-game WHERE (with-shared-id
in-verbs (in-verbs)
everywhere-actions)) #'(init-game WHERE
in-verbs
everywhere-actions)))
;; ============================================================ ;; ============================================================
;; Model: ;; Model:

Loading…
Cancel
Save