This source listing assumes that we’ve created a basic directory and installed it as a package as described in specification and setup.
1 2 3 4 5 6 7 8 9 | #lang basic 30 rem print 'ignored' 35 50 print "never gets here" 40 end 60 print 'three' : print 1.0 + 3 70 goto 11. + 18.5 + .5 rem ignored 10 print "o" ; "n" ; "e" 20 print : goto 60.0 : end |
1 2 3 4 5 6 7 8 9 10 11 | #lang br/quicklang (require "parser.rkt" "tokenizer.rkt") (define (read-syntax path port) (define parse-tree (parse path (make-tokenizer port path))) (strip-bindings #`(module basic-mod basic/expander #,parse-tree))) (module+ reader (provide read-syntax)) |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | #lang br (require brag/support) (define-lex-abbrev digits (:+ (char-set "0123456789"))) (define basic-lexer (lexer-srcloc ["\n" (token 'NEWLINE lexeme)] [whitespace (token lexeme #:skip? #t)] [(from/stop-before "rem" "\n") (token 'REM lexeme)] [(:or "print" "goto" "end" "+" ":" ";") (token lexeme lexeme)] [digits (token 'INTEGER (string->number lexeme))] [(:or (:seq (:? digits) "." digits) (:seq digits ".")) (token 'DECIMAL (string->number lexeme))] [(:or (from/to "\"" "\"") (from/to "'" "'")) (token 'STRING (substring lexeme 1 (sub1 (string-length lexeme))))])) (provide basic-lexer) |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 | #lang br (require "lexer.rkt" brag/support rackunit) (define (lex str) (apply-port-proc basic-lexer str)) (check-equal? (lex "") empty) (check-equal? (lex " ") (list (srcloc-token (token " " #:skip? #t) (srcloc 'string 1 0 1 1)))) (check-equal? (lex "rem ignored\n") (list (srcloc-token (token 'REM "rem ignored") (srcloc 'string 1 0 1 11)) (srcloc-token (token 'NEWLINE "\n") (srcloc 'string 1 11 12 1)))) (check-equal? (lex "print") (list (srcloc-token (token "print" "print") (srcloc 'string 1 0 1 5)))) (check-equal? (lex "goto") (list (srcloc-token (token "goto" "goto") (srcloc 'string 1 0 1 4)))) (check-equal? (lex "end") (list (srcloc-token (token "end" "end") (srcloc 'string 1 0 1 3)))) (check-equal? (lex "+") (list (srcloc-token (token "+" "+") (srcloc 'string 1 0 1 1)))) (check-equal? (lex ";") (list (srcloc-token (token ";" ";") (srcloc 'string 1 0 1 1)))) (check-equal? (lex ":") (list (srcloc-token (token ":" ":") (srcloc 'string 1 0 1 1)))) (check-equal? (lex "12") (list (srcloc-token (token 'INTEGER 12) (srcloc 'string 1 0 1 2)))) (check-equal? (lex "1.2") (list (srcloc-token (token 'DECIMAL 1.2) (srcloc 'string 1 0 1 3)))) (check-equal? (lex "12.") (list (srcloc-token (token 'DECIMAL 12.) (srcloc 'string 1 0 1 3)))) (check-equal? (lex ".12") (list (srcloc-token (token 'DECIMAL .12) (srcloc 'string 1 0 1 3)))) (check-equal? (lex "\"foo\"") (list (srcloc-token (token 'STRING "foo") (srcloc 'string 1 0 1 5)))) (check-equal? (lex "'foo'") (list (srcloc-token (token 'STRING "foo") (srcloc 'string 1 0 1 5)))) (check-exn exn:fail:read? (lambda () (lex "x"))) |
1 2 3 4 5 6 7 8 9 10 | #lang br (require "lexer.rkt" brag/support) (define (make-tokenizer ip [path #f]) (port-count-lines! ip) (lexer-file-path path) (define (next-token) (basic-lexer ip)) next-token) (provide make-tokenizer) |
1 2 3 4 5 6 7 8 9 10 11 12 13 | #lang brag b-program : [b-line] (/NEWLINE [b-line])* b-line : b-line-num [b-statement] (/":" [b-statement])* [b-rem] @b-line-num : INTEGER @b-statement : b-end | b-print | b-goto b-rem : REM b-end : /"end" b-print : /"print" [b-printable] (/";" [b-printable])* @b-printable : STRING | b-expr b-goto : /"goto" b-expr b-expr : b-sum b-sum : b-number (/"+" b-number)* @b-number : INTEGER | DECIMAL |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | #lang br/quicklang (require "parser.rkt" "tokenizer.rkt") (define (read-syntax path port) (define parse-tree (parse path (make-tokenizer port path))) (strip-bindings #`(module basic-parser-mod basic/parse-only #,parse-tree))) (module+ reader (provide read-syntax)) (define-macro (parser-only-mb PARSE-TREE) #'(#%module-begin 'PARSE-TREE)) (provide (rename-out [parser-only-mb #%module-begin])) |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | #lang br/quicklang (require brag/support "tokenizer.rkt") (define (read-syntax path port) (define tokens (apply-tokenizer make-tokenizer port)) (strip-bindings #`(module basic-tokens-mod basic/tokenize-only #,@tokens))) (module+ reader (provide read-syntax)) (define-macro (tokenize-only-mb TOKEN ...) #'(#%module-begin (list TOKEN ...))) (provide (rename-out [tokenize-only-mb #%module-begin])) |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 | #lang br/quicklang (provide (matching-identifiers-out #rx"^b-" (all-defined-out))) (define-macro (b-line NUM STATEMENT ...) (with-pattern ([LINE-NUM (prefix-id "line-" #'NUM #:source #'NUM)]) (syntax/loc caller-stx (define (LINE-NUM) (void) STATEMENT ...)))) (define-macro (b-module-begin (b-program LINE ...)) (with-pattern ([((b-line NUM STMT ...) ...) #'(LINE ...)] [(LINE-FUNC ...) (prefix-id "line-" #'(NUM ...))]) #'(#%module-begin LINE ... (define line-table (apply hasheqv (append (list NUM LINE-FUNC) ...))) (void (run line-table))))) (provide (rename-out [b-module-begin #%module-begin])) (struct end-program-signal ()) (struct change-line-signal (val)) (define (b-end) (raise (end-program-signal))) (define (b-goto expr) (raise (change-line-signal expr))) (define (run line-table) (define line-vec (list->vector (sort (hash-keys line-table) <))) (with-handlers ([end-program-signal? (λ (exn-val) (void))]) (for/fold ([line-idx 0]) ([i (in-naturals)] #:break (>= line-idx (vector-length line-vec))) (define line-num (vector-ref line-vec line-idx)) (define line-func (hash-ref line-table line-num)) (with-handlers ([change-line-signal? (λ (cls) (define clsv (change-line-signal-val cls)) (or (and (exact-positive-integer? clsv) (vector-member clsv line-vec)) (error (format "error in line ~a: line ~a not found" line-num clsv))))]) (line-func) (add1 line-idx))))) (define (b-rem val) (void)) (define (b-print . vals) (displayln (string-append* (map ~a vals)))) (define (b-sum . vals) (apply + vals)) (define (b-expr expr) (if (integer? expr) (inexact->exact expr) expr)) |