diff --git a/beautiful-racket-lib/br/reader-utils.rkt b/beautiful-racket-lib/br/reader-utils.rkt index 9dc9e39..8b31f1b 100644 --- a/beautiful-racket-lib/br/reader-utils.rkt +++ b/beautiful-racket-lib/br/reader-utils.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require (for-syntax racket/base) syntax/strip-context) +(require (for-syntax racket/base racket/syntax) syntax/strip-context) (provide define-read-and-read-syntax) ;; `define-read-functions` simplifies support for the standard reading API, @@ -9,28 +9,35 @@ (define-syntax (define-read-and-read-syntax calling-site-stx) (syntax-case calling-site-stx () [(_ (PATH PORT) BODY ...) - (with-syntax ([READ (datum->syntax calling-site-stx 'read)] - [READ-SYNTAX (datum->syntax calling-site-stx 'read-syntax)]) - #'(begin - (provide READ READ-SYNTAX) - (define (calling-site-function PATH PORT) - BODY ...) ; don't care whether this produces datum or syntax - - (define (READ-SYNTAX path port) - ;; 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)]) + (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 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) - 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)) - - (define (READ port) - ; because `read` must produce a datum - (let ([output (calling-site-function #f port)]) - (if (syntax? output) - (syntax->datum output) - output)))))])) + (syntax->datum output) + output))) 'READ)))))])) \ No newline at end of file diff --git a/beautiful-racket/br/basic.rkt b/beautiful-racket/br/basic.rkt new file mode 100644 index 0000000..f7c4a25 --- /dev/null +++ b/beautiful-racket/br/basic.rkt @@ -0,0 +1,4 @@ +#lang br +(module reader br + (require br/basic/reader) + (provide (all-from-out br/basic/reader))) diff --git a/beautiful-racket/br/basic/expander.rkt b/beautiful-racket/br/basic/expander.rkt new file mode 100644 index 0000000..d3b2cb8 --- /dev/null +++ b/beautiful-racket/br/basic/expander.rkt @@ -0,0 +1,39 @@ +#lang br +(provide (all-defined-out) + #%top-interaction + #%datum + (rename-out [basic-module-begin #%module-begin])) + +(define #'(basic-module-begin PARSE-TREE ...) + #'(#%module-begin + 'PARSE-TREE ...)) + +(define #'(basic-program LINE ...) + #'(begin + (define program-lines (vector LINE ...)) + (run program-lines))) + +(define (run program-lines) + (for/fold ([line-idx 0]) + ([i (in-naturals)] + #:break (= line-idx (vector-length program-lines))) + (match-define (list line-number proc jump-number) + (vector-ref program-lines line-idx)) + (when proc (proc)) + (if jump-number + (for/first ([idx (in-range (vector-length program-lines))] + #:when (= (car (vector-ref program-lines idx)) jump-number)) + idx) + (add1 line-idx)))) + +(define-cases #'line + [#'(line 'end) #'(list #f #f #f)] + [#'(_ NUMBER (statement ARG ...) 'end) #'(list NUMBER (statement ARG ...) #f)] + [#'(_ (statement ARG ...) 'end) #'(list #f (statement ARG ...) #f)]) + +(define-cases #'statement + [#'(_ "PRINT" EXPR-LIST) #'(λ _ (begin (for-each display EXPR-LIST) (displayln "")))]) + +(define-cases #'expr-list + [#'(_ EXPR ...) #'(list EXPR ...)]) + diff --git a/beautiful-racket/br/basic/parser.rkt b/beautiful-racket/br/basic/parser.rkt new file mode 100644 index 0000000..a93afe7 --- /dev/null +++ b/beautiful-racket/br/basic/parser.rkt @@ -0,0 +1,32 @@ +#lang ragg + +basic-program : line* + +line : CR | NUMBER statement CR | statement CR +| NUMBER statement | statement + +statement : "PRINT" expr-list +| "IF" expression relop expression "THEN" statement +| "GOTO" expression +| "INPUT" var-list +| "LET" var "=" expression +| "GOSUB" expression +| "RETURN" +| "CLEAR" +| "LIST" +| "RUN" +| "END" + +expr-list : (STRING | expression) ("," (STRING | expression) )* + +var-list : var ("," var)* + +expression : term (("+"|"-") term)* + +term : factor (("*"|"/") factor)* + +factor : var | NUMBER | (expression) + +var : UPPERCASE + +relop : "<" (">"|"="|"ε") | ">" ("<"|"="|"ε") | "=" \ No newline at end of file diff --git a/beautiful-racket/br/basic/reader.rkt b/beautiful-racket/br/basic/reader.rkt new file mode 100644 index 0000000..f4e9c07 --- /dev/null +++ b/beautiful-racket/br/basic/reader.rkt @@ -0,0 +1,7 @@ +#lang br +(require br/reader-utils br/basic/parser br/basic/tokenizer) + +(define-read-and-read-syntax (source-path input-port) + (strip-context + #`(module bf-mod br/basic/expander + #,(parse source-path (tokenize input-port))))) diff --git a/beautiful-racket/br/basic/test.rkt b/beautiful-racket/br/basic/test.rkt new file mode 100644 index 0000000..4ef2bde --- /dev/null +++ b/beautiful-racket/br/basic/test.rkt @@ -0,0 +1,2 @@ +#lang br/basic +20 GOTO 10 diff --git a/beautiful-racket/br/basic/tokenizer.rkt b/beautiful-racket/br/basic/tokenizer.rkt new file mode 100644 index 0000000..18ad12b --- /dev/null +++ b/beautiful-racket/br/basic/tokenizer.rkt @@ -0,0 +1,24 @@ +#lang br +(require parser-tools/lex + (prefix-in : parser-tools/lex-sre) + ragg/support + racket/string) +(provide tokenize) + +(define (tokenize input-port) + (define (next-token) + (define get-token + (lexer + ["\n" (token 'CR ''end)] + [(union "PRINT" "IF" "THEN" "GOTO" + "INPUT" "LET" "GOSUB" "RETURN" + "CLEAR" "LIST" "RUN" "END") lexeme] + ;; this only matches integers + [(repetition 1 +inf.0 numeric) (token 'NUMBER (string->number lexeme))] + [(char-set ",+-ε*/<>=") lexeme] + [upper-case (token 'UPPERCASE lexeme)] + [whitespace (token 'WHITESPACE lexeme #:skip? #t)] + [(:seq "\"" (complement (:: any-string "\"" any-string)) "\"") (token 'STRING (string-trim lexeme "\""))] + [(eof) eof])) + (get-token input-port)) + next-token)