resume in stx pattern
This commit is contained in:
parent
7e367b3d8d
commit
b4a47b754f
|
@ -1,3 +1,3 @@
|
|||
#lang reader "bf-reader.rkt"
|
||||
Greatest language ever!
|
||||
++++++++[>++++++++<-]>.
|
||||
++++-+++-++-++[>++++-+++-++-++<-]>.[
|
|
@ -5,10 +5,24 @@
|
|||
PARSE-TREE))
|
||||
(provide (rename-out [bf-module-begin #%module-begin]))
|
||||
|
||||
(define-macro (bf-program PROGRAM-ARG ...)
|
||||
#'(void PROGRAM-ARG ...))
|
||||
(define-macro (bf-program OP-OR-LOOP-ARG ...)
|
||||
#'(void OP-OR-LOOP-ARG ...))
|
||||
(provide bf-program)
|
||||
|
||||
(define-macro-cases op
|
||||
[(op ">") #'(gt)]
|
||||
[(op "<") #'(lt)]
|
||||
[(op "+") #'(plus)]
|
||||
[(op "-") #'(minus)]
|
||||
[(op ".") #'(period)]
|
||||
[(op ",") #'(comma)])
|
||||
(provide op)
|
||||
|
||||
(define-macro (loop LOOP-ARG ...)
|
||||
#'(until (zero? (current-byte))
|
||||
LOOP-ARG ...))
|
||||
(provide loop)
|
||||
|
||||
(define arr (make-vector 30000 0))
|
||||
(define ptr 0)
|
||||
|
||||
|
@ -23,16 +37,3 @@
|
|||
(define (period) (write-byte (current-byte)))
|
||||
(define (comma) (set-current-byte! (read-byte)))
|
||||
|
||||
(define-macro-cases op
|
||||
[(op ">") #'(gt)]
|
||||
[(op "<") #'(lt)]
|
||||
[(op "+") #'(plus)]
|
||||
[(op "-") #'(minus)]
|
||||
[(op ".") #'(period)]
|
||||
[(op ",") #'(comma)])
|
||||
(provide op)
|
||||
|
||||
(define-macro (loop LOOP-ARG ...)
|
||||
#'(until (zero? (current-byte))
|
||||
LOOP-ARG ...))
|
||||
(provide loop)
|
||||
|
|
|
@ -11,10 +11,27 @@
|
|||
0)))
|
||||
(provide bf-program)
|
||||
|
||||
(define-macro-cases op
|
||||
[(op ">") #'gt]
|
||||
[(op "<") #'lt]
|
||||
[(op "+") #'plus]
|
||||
[(op "-") #'minus]
|
||||
[(op ".") #'period]
|
||||
[(op ",") #'comma])
|
||||
(provide op)
|
||||
|
||||
(define-macro (loop LOOP-ARG ...)
|
||||
#'(lambda (arr ptr)
|
||||
(for/fold ([apl (list arr ptr)])
|
||||
([i (in-naturals)]
|
||||
#:break (zero? (apply current-byte apl)))
|
||||
(apply fold-args (list LOOP-ARG ...) apl))))
|
||||
(provide loop)
|
||||
|
||||
(define (fold-args bf-args arr ptr)
|
||||
(for/fold ([ap (list arr ptr)])
|
||||
(for/fold ([apl (list arr ptr)])
|
||||
([bf-arg (in-list bf-args)])
|
||||
(apply bf-arg ap)))
|
||||
(apply bf-arg apl)))
|
||||
|
||||
(define (current-byte arr ptr) (vector-ref arr ptr))
|
||||
|
||||
|
@ -29,19 +46,3 @@
|
|||
(define (period arr ptr) (write-byte (current-byte arr ptr)) (list arr ptr))
|
||||
(define (comma arr ptr) (list (set-current-byte arr ptr (read-byte)) ptr))
|
||||
|
||||
(define-macro-cases op
|
||||
[(op ">") #'gt]
|
||||
[(op "<") #'lt]
|
||||
[(op "+") #'plus]
|
||||
[(op "-") #'minus]
|
||||
[(op ".") #'period]
|
||||
[(op ",") #'comma])
|
||||
(provide op)
|
||||
|
||||
(define-macro (loop LOOP-ARG ...)
|
||||
#'(lambda (arr ptr)
|
||||
(for/fold ([ap (list arr ptr)])
|
||||
([i (in-naturals)]
|
||||
#:break (zero? (apply current-byte ap)))
|
||||
(apply fold-args (list LOOP-ARG ...) ap))))
|
||||
(provide loop)
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
#lang brag
|
||||
bf-program : (op | loop)*
|
||||
op : ">" | "<" | "+" | "-" | "." | ","
|
||||
loop : /"[" (op | loop)* /"]"
|
||||
loop : "[" (op | loop)* "]"
|
|
@ -1,20 +1,20 @@
|
|||
#lang br/quicklang
|
||||
(require parser-tools/lex brag/support)
|
||||
(require "bf-parser.rkt")
|
||||
|
||||
(define (tokenize input-port)
|
||||
(define (read-syntax path port)
|
||||
(define parse-tree (parse path (tokenize port)))
|
||||
(define module-datum `(module bf-mod br/demo/bf/bf-expander-imperative
|
||||
,parse-tree))
|
||||
(datum->syntax #f module-datum))
|
||||
(provide read-syntax)
|
||||
|
||||
(require parser-tools/lex brag/support)
|
||||
(define (tokenize port)
|
||||
(define (next-token)
|
||||
(define our-lexer
|
||||
(lexer
|
||||
[(eof) eof]
|
||||
[(char-set "><-.,+[]") lexeme]
|
||||
[(char-complement (char-set "><-.,+[]"))
|
||||
(token 'COMMENT #:skip? #t)]
|
||||
[(eof) eof]))
|
||||
(our-lexer input-port))
|
||||
[any-char (token 'COMMENT #:skip? #t)]))
|
||||
(our-lexer port))
|
||||
next-token)
|
||||
|
||||
(require "bf-parser.rkt")
|
||||
(define (read-syntax source-path input-port)
|
||||
(define parse-tree (parse source-path (tokenize input-port)))
|
||||
(datum->syntax #f `(module bf-mod br/demo/bf/bf-expander-imperative
|
||||
,parse-tree)))
|
||||
(provide read-syntax)
|
||||
|
|
|
@ -15,8 +15,8 @@
|
|||
(make-parameter
|
||||
(lambda (tok-name tok-value offset line col span)
|
||||
(raise (exn:fail:parsing
|
||||
(format "Encountered parsing error near token ~e (~e) while parsing ~e [line=~a, column=~a, offset=~a]"
|
||||
tok-name tok-value
|
||||
(format "Encountered parsing error near ~e (token ~e) while parsing ~e [line=~a, column=~a, offset=~a]"
|
||||
tok-value tok-name
|
||||
(current-source)
|
||||
line col offset)
|
||||
(current-continuation-marks)
|
||||
|
|
Loading…
Reference in New Issue
Block a user