reorg
parent
715b9c0f1d
commit
acf9e65315
@ -0,0 +1,9 @@
|
||||
#lang br
|
||||
(provide (struct-out end-program-signal)
|
||||
(struct-out change-line-signal)
|
||||
(struct-out line-error))
|
||||
|
||||
(struct end-program-signal ())
|
||||
(struct change-line-signal (val))
|
||||
|
||||
(struct line-error (msg))
|
@ -0,0 +1,6 @@
|
||||
#lang br
|
||||
(require "line.rkt" "go.rkt"
|
||||
"expr.rkt" "misc.rkt")
|
||||
(provide
|
||||
(all-from-out "line.rkt" "go.rkt"
|
||||
"expr.rkt" "misc.rkt"))
|
@ -0,0 +1,37 @@
|
||||
#lang br/quicklang
|
||||
(require "struct.rkt" "elements.rkt")
|
||||
(provide (rename-out [b-module-begin #%module-begin])
|
||||
(all-from-out "elements.rkt"))
|
||||
|
||||
(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)))))
|
||||
|
||||
(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)))))
|
||||
|
||||
|
@ -0,0 +1,7 @@
|
||||
#lang br
|
||||
(provide b-sum b-expr)
|
||||
|
||||
(define (b-sum . vals) (apply + vals))
|
||||
|
||||
(define (b-expr expr)
|
||||
(if (integer? expr) (inexact->exact expr) expr))
|
@ -0,0 +1,8 @@
|
||||
#lang br
|
||||
(require "struct.rkt" "line.rkt")
|
||||
(provide b-end b-goto)
|
||||
|
||||
(define (b-end) (raise (end-program-signal)))
|
||||
|
||||
(define (b-goto num-expr)
|
||||
(raise (change-line-signal num-expr)))
|
@ -0,0 +1,4 @@
|
||||
#lang info
|
||||
|
||||
(define compile-omit-paths 'all)
|
||||
(define test-omit-paths 'all)
|
@ -0,0 +1,23 @@
|
||||
#lang br
|
||||
(require brag/support)
|
||||
|
||||
(define-lex-abbrev digits (:+ (char-set "0123456789")))
|
||||
|
||||
(define basic-lexer
|
||||
(lexer-srcloc
|
||||
[(eof) (return-without-srcloc eof)]
|
||||
["\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)
|
@ -0,0 +1,9 @@
|
||||
#lang br
|
||||
(require "struct.rkt")
|
||||
(provide b-line)
|
||||
|
||||
(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 ...))))
|
@ -0,0 +1,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-demo-2a/expander
|
||||
#,parse-tree)))
|
||||
|
||||
(module+ reader
|
||||
(provide read-syntax))
|
@ -0,0 +1,8 @@
|
||||
#lang br
|
||||
(require "struct.rkt")
|
||||
(provide b-rem b-print)
|
||||
|
||||
(define (b-rem val) (void))
|
||||
|
||||
(define (b-print . vals)
|
||||
(displayln (string-append* (map ~a vals))))
|
@ -0,0 +1,13 @@
|
||||
#lang brag
|
||||
b-program : [b-line] (/NEWLINE [b-line])*
|
||||
b-line : b-line-number [b-statement] (/":" [b-statement])*
|
||||
@b-line-number : INTEGER
|
||||
@b-statement : b-rem | 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
|
@ -0,0 +1,9 @@
|
||||
#lang basic-demo-2a
|
||||
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
|
||||
10 print "o" ; "n" ; "e"
|
||||
20 print : goto 60.0 : end
|
@ -0,0 +1,6 @@
|
||||
#lang br
|
||||
(provide (struct-out end-program-signal)
|
||||
(struct-out change-line-signal))
|
||||
|
||||
(struct end-program-signal ())
|
||||
(struct change-line-signal (val))
|
@ -0,0 +1,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)
|
@ -0,0 +1,22 @@
|
||||
#lang br
|
||||
(require "lexer.rkt" brag/support)
|
||||
(provide color-basic)
|
||||
|
||||
(define (color-basic port)
|
||||
(define srcloc-tok (basic-lexer port))
|
||||
(match srcloc-tok
|
||||
[(? eof-object?) (values srcloc-tok 'eof #f #f #f)]
|
||||
[else ; reverse-engineer with `match-define`
|
||||
(match-define (srcloc-token (token-struct type val _ _ _ _ _)
|
||||
(srcloc _ _ _ pos span)) srcloc-tok)
|
||||
(define (color cat [paren #f])
|
||||
(values (or val "") cat paren pos (+ pos span)))
|
||||
(match type
|
||||
['STRING (color 'string)]
|
||||
['REM (color 'comment)]
|
||||
[else (match val
|
||||
[(? number?) (color 'constant)]
|
||||
[(? symbol?) (color 'symbol)]
|
||||
["(" (color 'parenthesis '|(|)]
|
||||
[")" (color 'parenthesis '|)|)]
|
||||
[else (color 'no-color)])])]))
|
@ -0,0 +1,3 @@
|
||||
#lang br
|
||||
(require "line.rkt" "go.rkt" "if.rkt" "expr.rkt" "for.rkt" "misc.rkt")
|
||||
(provide (all-from-out "line.rkt" "go.rkt" "if.rkt" "expr.rkt" "for.rkt" "misc.rkt"))
|
@ -0,0 +1,35 @@
|
||||
#lang br/quicklang
|
||||
(require "runtime.rkt"
|
||||
"run.rkt"
|
||||
"elements.rkt")
|
||||
(provide (rename-out [b-module-begin #%module-begin])
|
||||
(all-from-out "elements.rkt"))
|
||||
|
||||
(define-macro (b-module-begin (b-program LINE ...))
|
||||
(with-pattern
|
||||
([((b-line NUM STMT ...) ...) #'(LINE ...)]
|
||||
[(LINE-FUNC ...) (prefix-id "line-" #'(NUM ...))]
|
||||
[(VAR-NAME ...) (find-unique-var-names #'(LINE ...))])
|
||||
#'(#%module-begin
|
||||
(module configure-runtime br
|
||||
(require basic-demo-2/runtime)
|
||||
(current-basic-port (current-output-port)))
|
||||
(define VAR-NAME 0) ...
|
||||
(provide VAR-NAME ...)
|
||||
LINE ...
|
||||
(define line-table
|
||||
(apply hasheqv (append (list NUM LINE-FUNC) ...)))
|
||||
(void (parameterize ([current-output-port
|
||||
(or (current-basic-port) (open-output-nowhere))])
|
||||
(run line-table))))))
|
||||
|
||||
(begin-for-syntax
|
||||
(require racket/list)
|
||||
(define (find-unique-var-names stx)
|
||||
(remove-duplicates
|
||||
(for/list ([var-stx (in-list (syntax-flatten stx))]
|
||||
#:when (syntax-property var-stx 'b-id))
|
||||
var-stx)
|
||||
#:key syntax->datum)))
|
||||
|
||||
|
@ -0,0 +1,26 @@
|
||||
#lang br
|
||||
(provide (all-defined-out))
|
||||
|
||||
;; b-sum : b-product (("+" | "-") b-product)*
|
||||
(define-macro-cases b-sum
|
||||
[(_ PROD) #'PROD]
|
||||
[(_ LEFT-PROD "+" RIGHT-PROD) #'(+ LEFT-PROD RIGHT-PROD)]
|
||||
[(_ LEFT-PROD "-" RIGHT-PROD) #'(- LEFT-PROD RIGHT-PROD)])
|
||||
|
||||
;; b-product : [b-product ("*"|"/"|"%"|"^")] b-value
|
||||
(define-macro-cases b-product
|
||||
[(_ VAL) #'VAL]
|
||||
[(_ LEFT "*" RIGHT) #'(* LEFT RIGHT)]
|
||||
[(_ LEFT "/" RIGHT) #'(/ LEFT RIGHT 1.0)]
|
||||
[(_ LEFT "^" RIGHT) #'(expt LEFT RIGHT)]
|
||||
[(_ LEFT "%" RIGHT) #'(modulo LEFT RIGHT)])
|
||||
|
||||
(define (b-expr expr)
|
||||
(if (integer? expr) (inexact->exact expr) expr))
|
||||
|
||||
(define (b-negative num) (- num))
|
||||
|
||||
(define (b-not expr) (if (zero? expr) 1 0))
|
||||
|
||||
(define-macro (b-def ID VAR EXPR)
|
||||
#'(set! ID (λ (VAR) EXPR)))
|
@ -0,0 +1,30 @@
|
||||
#lang br
|
||||
(require "misc.rkt" "line.rkt")
|
||||
(provide b-for b-next)
|
||||
|
||||
(define thunk-table (make-hasheq))
|
||||
|
||||
(define-macro-cases b-for
|
||||
[(_ LOOP-ID START END) #'(b-for LOOP-ID START END 1)]
|
||||
[(_ LOOP-ID START END STEP)
|
||||
#'(b-let LOOP-ID (let/cc loop-cc
|
||||
(hash-set! thunk-table
|
||||
'LOOP-ID
|
||||
(λ ()
|
||||
(define next-val (+ LOOP-ID STEP))
|
||||
(if (next-val . in-closed-interval? . START END)
|
||||
(loop-cc next-val)
|
||||
(hash-remove! thunk-table 'LOOP-ID))))
|
||||
START))])
|
||||
|
||||
(define (in-closed-interval? x start end)
|
||||
(if (< start end)
|
||||
(<= start x end)
|
||||
(<= end x start)))
|
||||
|
||||
(define-macro (b-next LOOP-ID)
|
||||
#'(begin
|
||||
(unless (hash-has-key? thunk-table 'LOOP-ID)
|
||||
(raise-line-error "next without for"))
|
||||
(define thunk (hash-ref thunk-table 'LOOP-ID))
|
||||
(thunk)))
|
@ -0,0 +1,19 @@
|
||||
#lang br
|
||||
(require "structs.rkt" "line.rkt")
|
||||
(provide b-goto b-gosub b-return)
|
||||
|
||||
(define (b-goto num-expr)
|
||||
(raise (change-line-signal num-expr)))
|
||||
|
||||
(define return-stack empty)
|
||||
|
||||
(define (b-gosub num-expr)
|
||||
(let/cc return-cc
|
||||
(push! return-stack return-cc)
|
||||
(b-goto num-expr)))
|
||||
|
||||
(define (b-return)
|
||||
(unless (pair? return-stack)
|
||||
(raise-line-error "return without gosub"))
|
||||
(define top-return-k (pop! return-stack))
|
||||
(top-return-k))
|
@ -0,0 +1,4 @@
|
||||
#lang info
|
||||
|
||||
(define compile-omit-paths 'all)
|
||||
(define test-omit-paths 'all)
|
@ -0,0 +1,24 @@
|
||||
#lang br
|
||||
(require brag/support)
|
||||
|
||||
(define-lex-abbrev digits (:+ (char-set "0123456789")))
|
||||
|
||||
(define basic-lexer
|
||||
(lexer-srcloc
|
||||
[(eof) (return-without-srcloc eof)]
|
||||
["\n" (token 'NEWLINE lexeme)]
|
||||
[whitespace (token lexeme #:skip? #t)]
|
||||
[(from/stop-before "rem" "\n") (token 'REM lexeme)]
|
||||
[(:or "print" "goto" "end" "+" ":" "gosub" "return" "let" "=" "-" "for" "to" "step" "next"
|
||||
"if" "then" "else" "and" "or" "<" ">" "*" "/" "(" ")" "^" "!" "%" "input" ";" "def") (token lexeme lexeme)]
|
||||
[(:seq (:+ alphabetic) (:* (:or alphabetic numeric "$"))) (token 'ID (string->symbol 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)
|
@ -0,0 +1,17 @@
|
||||
#lang br
|
||||
(require "structs.rkt")
|
||||
(provide (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 #:error [msg #f])
|
||||
(with-handlers ([line-error? (λ (le) (handle-line-error NUM le))])
|
||||
(when msg (raise-line-error msg))
|
||||
STATEMENT ...)))))
|
||||
|
||||
(define (handle-line-error num le)
|
||||
(error (format "error in line ~a: ~a" num (line-error-msg le))))
|
||||
|
||||
(define (raise-line-error str) (raise (line-error str)))
|
@ -0,0 +1,19 @@
|
||||
#lang br/quicklang
|
||||
(require "parser.rkt" "tokenizer.rkt")
|
||||
|
||||
(module+ reader
|
||||
(provide read-syntax get-info))
|
||||
|
||||
(define (read-syntax path port)
|
||||
(define parse-tree (parse path (make-tokenizer port path)))
|
||||
(strip-bindings
|
||||
#`(module basic-mod basic-demo-2/expander
|
||||
#,parse-tree)))
|
||||
|
||||
(define (get-info port mod line col pos)
|
||||
(define (handle-query key default)
|
||||
(case key
|
||||
[(color-lexer)
|
||||
(dynamic-require 'basic-demo-2/colorer 'color-basic)]
|
||||
[else default]))
|
||||
handle-query)
|
@ -0,0 +1,17 @@
|
||||
#lang br
|
||||
(require "structs.rkt")
|
||||
(provide (all-defined-out))
|
||||
|
||||
(define (b-rem val) (void))
|
||||
|
||||
(define (b-print . vals)
|
||||
(displayln (string-append* (map ~a vals))))
|
||||
|
||||
(define-macro (b-let ID VAL) #'(set! ID VAL))
|
||||
|
||||
(define-macro (b-input ID)
|
||||
#'(b-let ID (let* ([str (read-line)]
|
||||
[num (string->number (string-trim str))])
|
||||
(or num str))))
|
||||
|
||||
(define (b-end) (raise (end-program-signal)))
|
@ -0,0 +1,37 @@
|
||||
#lang brag
|
||||
;; program & lines
|
||||
b-program : [b-line] (/NEWLINE [b-line])*
|
||||
b-line : b-line-number [b-statement] (/":" [b-statement])*
|
||||
@b-line-number : INTEGER
|
||||
|
||||
;; statements
|
||||
@b-statement : b-rem | b-end | b-print | b-let | b-input | b-def
|
||||
| b-goto | b-gosub | b-return | b-for | b-next | b-if
|
||||
b-rem : REM
|
||||
b-end : /"end"
|
||||
b-print : /"print" [STRING | b-expr] (/";" [STRING | b-expr])*
|
||||
b-goto : /"goto" b-expr
|
||||
b-if : /"if" b-expr /"then" b-expr [/"else" b-expr]
|
||||
b-gosub : /"gosub" b-expr
|
||||
b-return : /"return"
|
||||
b-input : /"input" b-id
|
||||
b-def : /"def" b-id /"(" b-id /")" /"=" b-expr
|
||||
b-let : [/"let"] b-id /"=" [STRING | b-expr]
|
||||
b-for : /"for" b-id /"=" b-expr /"to" b-expr [/"step" b-expr]
|
||||
b-next : /"next" [b-id]
|
||||
|
||||
;; expressions with precedence & order
|
||||
b-expr : b-logic-expr
|
||||
b-logic-expr : [b-logic-expr ("and" | "or")] b-comp-expr
|
||||
b-comp-expr : [b-comp-expr ("=" | "<" | ">")] b-sum
|
||||
b-sum : [b-sum ("+"|"-")] b-product
|
||||
b-product : [b-product ("*"|"/"|"%"|"^")] b-value
|
||||
|
||||
;; values
|
||||
@b-value : b-id | b-number | /"(" b-expr /")" | b-not | b-func
|
||||
/b-func : b-id /"(" b-expr /")"
|
||||
b-not : /"!" b-value
|
||||
@b-id : ID
|
||||
@b-number : b-positive | b-negative
|
||||
@b-positive : INTEGER | DECIMAL
|
||||
b-negative : /"-" b-positive
|
@ -0,0 +1,8 @@
|
||||
(define (30) (rem print "'ignored'"))
|
||||
(define (35) (void))
|
||||
(define (50) (print "never gets here"))
|
||||
(define (40) (end))
|
||||
(define (60) (print "three") (print (+ 1.0 3)))
|
||||
(define (70) (goto (+ 11 18.5 0.5)))
|
||||
(define (10) (print "one"))
|
||||
(define (20) (print) (goto 60) (end))
|
@ -0,0 +1,23 @@
|
||||
#lang br
|
||||
(require "line.rkt" "structs.rkt")
|
||||
(provide run)
|
||||
|
||||
(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))
|
||||
(line-func #:error (format "line ~a not found" clsv))))])
|
||||
(line-func)
|
||||
(add1 line-idx)))))
|
@ -0,0 +1,8 @@
|
||||
#lang basic-demo-2
|
||||
10 rem all results should be 1
|
||||
20 a = 5
|
||||
30 b = 10
|
||||
40 print a > 4
|
||||
50 print b = 10
|
||||
60 print b < 11
|
||||
70 print ! (b = 100)
|
@ -0,0 +1,4 @@
|
||||
#lang basic-demo-2
|
||||
10 rem all results should be 1
|
||||
20 def f(x) = x * x
|
||||
30 print f((1+2)*3) = 81
|
@ -0,0 +1,8 @@
|
||||
#lang basic-demo-2
|
||||
10 for a = 1 to 3
|
||||
20 print a
|
||||
21 for b = 103 to 101 step -1
|
||||
22 print b
|
||||
23 next b
|
||||
30 next a
|
||||
40 print "yay"
|
@ -0,0 +1,10 @@
|
||||
#lang basic-demo-2
|
||||
10 gosub 41
|
||||
20 print "world"
|
||||
30 gosub 100
|
||||
31 print "hi"
|
||||
35 end
|
||||
40 return
|
||||
41 print "hello" : return
|
||||
100 print "third"
|
||||
110 goto 40
|
@ -0,0 +1,3 @@
|
||||
#lang br
|
||||
(require basic-demo-2/sample-var)
|
||||
(* a a)
|
@ -0,0 +1,4 @@
|
||||
#lang basic-demo-2
|
||||
5 print "enter your name: "
|
||||
10 input A$
|
||||
20 print "hello, " ; A$ ; "!"
|
@ -0,0 +1,9 @@
|
||||
#lang basic-demo-2
|
||||
10 rem all results should be 1
|
||||
20 print 1 - 2 * 3 + 4 * 5 - 6 = 9
|
||||
30 print (1 - 2) * (3 + 4) * (5 - 6) = 7
|
||||
40 print 1 / 4 = .25
|
||||
50 print 2 ^ 3 = 8
|
||||
60 print 9 ^ 0.5 = 3
|
||||
70 print 6 % 2 = 0
|
||||
80 print 5 % 2 = 1
|
@ -0,0 +1,8 @@
|
||||
#lang basic-demo-2
|
||||
10 a = 1 : a = 5
|
||||
20 gosub 150
|
||||
30 a = 25
|
||||
40 gosub 150
|
||||
50 end
|
||||
150 print a + a + a
|
||||
160 return
|
@ -0,0 +1,9 @@
|
||||
#lang basic-demo
|
||||
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
|
||||
10 print "one"
|
||||
20 print : goto 60.0 : end
|
@ -0,0 +1,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)
|
Loading…
Reference in New Issue