This source listing assumes that we’ve created a basic directory and installed it as a package as described in specification and setup.
#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
#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))
#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)
#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")))
#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)
#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
#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]))
#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]))
#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))