resume in hdl-tst
parent
f02e605a9c
commit
c0a3020947
@ -1,27 +1,26 @@
|
||||
#lang racket/base
|
||||
(require (for-syntax racket/base racket/syntax))
|
||||
(require (for-syntax racket/base br/syntax)
|
||||
br/define)
|
||||
(provide (all-defined-out))
|
||||
|
||||
(define-syntax (report stx)
|
||||
(syntax-case stx ()
|
||||
[(_ EXPR) #'(report EXPR EXPR)]
|
||||
[(_ EXPR NAME)
|
||||
#'(let ([expr-result EXPR])
|
||||
(eprintf "~a = ~v\n" 'NAME expr-result)
|
||||
expr-result)]))
|
||||
(define-macro-cases report
|
||||
[(_ EXPR) #'(report EXPR EXPR)]
|
||||
[(_ EXPR NAME)
|
||||
#'(let ([expr-result EXPR])
|
||||
(eprintf "~a = ~v\n" 'NAME expr-result)
|
||||
expr-result)])
|
||||
|
||||
(define-syntax (report-datum stx)
|
||||
(syntax-case stx ()
|
||||
[(_ STX-EXPR)
|
||||
(with-syntax ([datum (syntax->datum #'STX-EXPR)])
|
||||
#'(report-datum STX-EXPR datum))]
|
||||
[(_ STX-EXPR NAME)
|
||||
#'(let ()
|
||||
(eprintf "~a = ~v\n" 'NAME (syntax->datum STX-EXPR))
|
||||
STX-EXPR)]))
|
||||
(define-macro-cases report-datum
|
||||
[(_ STX-EXPR)
|
||||
(with-pattern ([datum (syntax->datum #'STX-EXPR)])
|
||||
#'(report-datum STX-EXPR datum))]
|
||||
[(_ STX-EXPR NAME)
|
||||
#'(let ()
|
||||
(eprintf "~a = ~v\n" 'NAME (syntax->datum STX-EXPR))
|
||||
STX-EXPR)])
|
||||
|
||||
(define-syntax-rule (define-multi-version MULTI-NAME NAME)
|
||||
(define-syntax-rule (MULTI-NAME x (... ...))
|
||||
(begin (NAME x) (... ...))))
|
||||
(define-macro (define-multi-version MULTI-NAME NAME)
|
||||
#'(define-macro (MULTI-NAME X (... ...))
|
||||
#'(begin (NAME X) (... ...))))
|
||||
|
||||
(define-multi-version report* report)
|
@ -1,43 +1,41 @@
|
||||
#lang racket/base
|
||||
(require (for-syntax racket/base racket/syntax) syntax/strip-context)
|
||||
(require (for-syntax racket/base racket/syntax br/syntax) br/define syntax/strip-context)
|
||||
(provide define-read-and-read-syntax)
|
||||
|
||||
;; `define-read-functions` simplifies support for the standard reading API,
|
||||
;; which asks for `read` and `read-syntax`.
|
||||
;; in general, `read` is just the datum from the result of `read-syntax`.
|
||||
|
||||
(define-syntax (define-read-and-read-syntax calling-site-stx)
|
||||
(syntax-case calling-site-stx ()
|
||||
[(_ (PATH PORT) BODY ...)
|
||||
(let ([internal-prefix (gensym)])
|
||||
(with-syntax ([READ (datum->syntax calling-site-stx 'read)]
|
||||
[READ-SYNTAX (datum->syntax calling-site-stx 'read-syntax)]
|
||||
;; use prefixed names to prevent namespace collisions with possibly existing `read` & `read-syntax`
|
||||
[INTERNAL-READ (format-id #'here "~a-~a" internal-prefix 'read)]
|
||||
[INTERNAL-READ-SYNTAX (format-id #'here "~a-~a" internal-prefix 'read-syntax)])
|
||||
#'(begin
|
||||
(provide (rename-out [INTERNAL-READ READ]
|
||||
[INTERNAL-READ-SYNTAX READ-SYNTAX]))
|
||||
(define (calling-site-function PATH PORT)
|
||||
BODY ...) ; don't care whether this produces datum or syntax
|
||||
(define-macro (define-read-and-read-syntax (PATH PORT) BODY ...)
|
||||
(let ([internal-prefix (gensym)])
|
||||
(with-syntax ([READ (datum->syntax caller-stx 'read)]
|
||||
[READ-SYNTAX (datum->syntax caller-stx 'read-syntax)]
|
||||
;; use prefixed names to prevent namespace collisions with possibly existing `read` & `read-syntax`
|
||||
[INTERNAL-READ (format-id #'here "~a-~a" internal-prefix 'read)]
|
||||
[INTERNAL-READ-SYNTAX (format-id #'here "~a-~a" internal-prefix 'read-syntax)])
|
||||
#'(begin
|
||||
(provide (rename-out [INTERNAL-READ READ]
|
||||
[INTERNAL-READ-SYNTAX READ-SYNTAX]))
|
||||
(define (calling-site-function PATH PORT)
|
||||
BODY ...) ; don't care whether this produces datum or syntax
|
||||
|
||||
(define INTERNAL-READ-SYNTAX
|
||||
(procedure-rename (λ (path port) ; rename proc so it looks right in the REPL (otherwise retains internal prefix name)
|
||||
;; because `read-syntax` must produce syntax
|
||||
;; coerce a datum result to syntax if needed (à la `with-syntax`)
|
||||
(define result-syntax (let ([output (calling-site-function path port)])
|
||||
(if (syntax? output)
|
||||
output
|
||||
(datum->syntax #f output))))
|
||||
;; because `read-syntax` must produce syntax without context
|
||||
;; see http://docs.racket-lang.org/guide/hash-lang_reader.html
|
||||
;; "a `read-syntax` function should return a syntax object with no lexical context"
|
||||
(strip-context result-syntax)) 'READ-SYNTAX))
|
||||
(define INTERNAL-READ-SYNTAX
|
||||
(procedure-rename (λ (path port) ; rename proc so it looks right in the REPL (otherwise retains internal prefix name)
|
||||
;; because `read-syntax` must produce syntax
|
||||
;; coerce a datum result to syntax if needed (à la `with-syntax`)
|
||||
(define result-syntax (let ([output (calling-site-function path port)])
|
||||
(if (syntax? output)
|
||||
output
|
||||
(datum->syntax #f output))))
|
||||
;; because `read-syntax` must produce syntax without context
|
||||
;; see http://docs.racket-lang.org/guide/hash-lang_reader.html
|
||||
;; "a `read-syntax` function should return a syntax object with no lexical context"
|
||||
(strip-context result-syntax)) 'READ-SYNTAX))
|
||||
|
||||
(define INTERNAL-READ
|
||||
(procedure-rename (λ (port)
|
||||
; because `read` must produce a datum
|
||||
(let ([output (calling-site-function #f port)])
|
||||
(if (syntax? output)
|
||||
(syntax->datum output)
|
||||
output))) 'READ)))))]))
|
||||
(define INTERNAL-READ
|
||||
(procedure-rename (λ (port)
|
||||
; because `read` must produce a datum
|
||||
(let ([output (calling-site-function #f port)])
|
||||
(if (syntax? output)
|
||||
(syntax->datum output)
|
||||
output))) 'READ))))))
|
Loading…
Reference in New Issue