reorg
This commit is contained in:
parent
a79eefee9c
commit
e68ae258f9
|
@ -1,25 +1,25 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
(require (for-syntax racket/base) syntax/strip-context)
|
(require (for-syntax racket/base) syntax/strip-context)
|
||||||
(provide define-read-functions)
|
(provide define-read-and-read-syntax)
|
||||||
|
|
||||||
;; `define-read-functions` simplifies support for the standard reading API,
|
;; `define-read-functions` simplifies support for the standard reading API,
|
||||||
;; which asks for `read` and `read-syntax`.
|
;; which asks for `read` and `read-syntax`.
|
||||||
;; in general, `read` is just the datum from the result of `read-syntax`.
|
;; in general, `read` is just the datum from the result of `read-syntax`.
|
||||||
|
|
||||||
(define-syntax (define-read-functions use-site-stx)
|
(define-syntax (define-read-and-read-syntax calling-site-stx)
|
||||||
(syntax-case use-site-stx ()
|
(syntax-case calling-site-stx ()
|
||||||
[(_ (PATH PORT) BODY ...)
|
[(_ (PATH PORT) BODY ...)
|
||||||
(with-syntax ([READ (datum->syntax use-site-stx 'read)]
|
(with-syntax ([READ (datum->syntax calling-site-stx 'read)]
|
||||||
[READ-SYNTAX (datum->syntax use-site-stx 'read-syntax)])
|
[READ-SYNTAX (datum->syntax calling-site-stx 'read-syntax)])
|
||||||
#'(begin
|
#'(begin
|
||||||
(provide READ READ-SYNTAX)
|
(provide READ READ-SYNTAX)
|
||||||
(define (use-site-read-function PATH PORT)
|
(define (calling-site-function PATH PORT)
|
||||||
BODY ...) ; don't care whether this produces datum or syntax
|
BODY ...) ; don't care whether this produces datum or syntax
|
||||||
|
|
||||||
(define (READ-SYNTAX path port)
|
(define (READ-SYNTAX path port)
|
||||||
;; because `read-syntax` must produce syntax
|
;; because `read-syntax` must produce syntax
|
||||||
;; coerce a datum result to syntax if needed (à la `with-syntax`)
|
;; coerce a datum result to syntax if needed (à la `with-syntax`)
|
||||||
(define result-syntax (let ([output (use-site-read-function path port)])
|
(define result-syntax (let ([output (calling-site-function path port)])
|
||||||
(if (syntax? output)
|
(if (syntax? output)
|
||||||
output
|
output
|
||||||
(datum->syntax #f output))))
|
(datum->syntax #f output))))
|
||||||
|
@ -30,7 +30,7 @@
|
||||||
|
|
||||||
(define (READ port)
|
(define (READ port)
|
||||||
; because `read` must produce a datum
|
; because `read` must produce a datum
|
||||||
(let ([output (use-site-read-function #f port)])
|
(let ([output (calling-site-function #f port)])
|
||||||
(if (syntax? output)
|
(if (syntax? output)
|
||||||
(syntax->datum output)
|
(syntax->datum output)
|
||||||
output)))))]))
|
output)))))]))
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
(module reader br
|
(module reader br
|
||||||
(provide read-syntax)
|
(provide read-syntax)
|
||||||
(require "tokenizer.rkt" "parser.rkt")
|
(require "bf/tokenizer.rkt" "bf/parser.rkt")
|
||||||
(define (read-syntax src-path src-port)
|
(define (read-syntax src-path src-port)
|
||||||
(define parsed-syntax (parse src-path (tokenize src-port)))
|
(define parsed-syntax (parse src-path (tokenize src-port)))
|
||||||
;; `strip-context` because `read-syntax` promises
|
;; `strip-context` because `read-syntax` promises
|
||||||
|
@ -10,14 +10,14 @@
|
||||||
;; (so later operations can add it)
|
;; (so later operations can add it)
|
||||||
(strip-context
|
(strip-context
|
||||||
(inject-syntax ([parsed-syntax])
|
(inject-syntax ([parsed-syntax])
|
||||||
#'(module bf-interpreter br-bf
|
#'(module bf-interpreter br/bf
|
||||||
parsed-syntax)))))
|
parsed-syntax)))))
|
||||||
|
|
||||||
;; compact version
|
;; compact version
|
||||||
#;(module reader br
|
#;(module reader br
|
||||||
(require br/read-functions "tokenizer.rkt" "parser.rkt")
|
(require br/reader-utils "tokenizer.rkt" "parser.rkt")
|
||||||
(define-read-functions (src-path src-port)
|
(define-read-and-read-syntax (src-path src-port)
|
||||||
#`(module bf-interpreter br-bf
|
#`(module bf-interpreter br/bf
|
||||||
#,(parse src-path (tokenize src-port)))))
|
#,(parse src-path (tokenize src-port)))))
|
||||||
|
|
||||||
(provide (rename-out [bf-module-begin #%module-begin])
|
(provide (rename-out [bf-module-begin #%module-begin])
|
|
@ -1,2 +1,2 @@
|
||||||
#lang s-exp br-bf
|
#lang s-exp br/bf
|
||||||
(bf-program (op "+") (op "+") (op "+") (op "+") (op "+") (op "+") (op "+") (loop "[" (op ">") (op "+") (op "+") (op "+") (op "+") (op "+") (op "<") (op "-") "]") (op ">") (op "."))
|
(bf-program (op "+") (op "+") (op "+") (op "+") (op "+") (op "+") (op "+") (loop "[" (op ">") (op "+") (op "+") (op "+") (op "+") (op "+") (op "<") (op "-") "]") (op ">") (op "."))
|
|
@ -1,2 +1,2 @@
|
||||||
#lang br-bf
|
#lang br/bf
|
||||||
+++++++[>+++++<-]>.
|
+++++++[>+++++<-]>.
|
|
@ -1,4 +1,4 @@
|
||||||
#lang br-bf
|
#lang br/bf
|
||||||
++++++[>++++++++++++<-]>.
|
++++++[>++++++++++++<-]>.
|
||||||
>++++++++++[>++++++++++<-]>+.
|
>++++++++++[>++++++++++<-]>+.
|
||||||
+++++++..+++.>++++[>+++++++++++<-]>.
|
+++++++..+++.>++++[>+++++++++++<-]>.
|
Loading…
Reference in New Issue
Block a user