start demo 3
parent
bfbdee9f79
commit
841f12e09a
@ -1,22 +1,32 @@
|
||||
#lang br
|
||||
(require "lexer.rkt" brag/support)
|
||||
(provide color-basic)
|
||||
(provide basic-colorer)
|
||||
|
||||
(define (color-basic port)
|
||||
(define srcloc-tok (basic-lexer port))
|
||||
(define (basic-colorer port)
|
||||
(define (handle-lexer-error excn)
|
||||
(define excn-srclocs (exn:fail:read-srclocs excn))
|
||||
(srcloc-token (token 'ERROR) (car excn-srclocs)))
|
||||
(define srcloc-tok
|
||||
(with-handlers ([exn:fail:read? handle-lexer-error])
|
||||
(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)])])]))
|
||||
[else
|
||||
(match-define
|
||||
(srcloc-token
|
||||
(token-struct type val _ _ _ _ _)
|
||||
(srcloc _ _ _ posn span)) srcloc-tok)
|
||||
(define start posn)
|
||||
(define end (+ start span))
|
||||
(match-define (list cat paren)
|
||||
(match type
|
||||
['STRING '(string #f)]
|
||||
['REM '(comment #f)]
|
||||
['ERROR '(error #f)]
|
||||
[else (match val
|
||||
[(? number?)'(constant #f)]
|
||||
[(? symbol?) '(symbol #f)]
|
||||
["(" '(parenthesis |(|)]
|
||||
[")" '(parenthesis |)|)]
|
||||
[else '(no-color #f)])]))
|
||||
(values val cat paren start end)]))
|
||||
@ -0,0 +1,41 @@
|
||||
#lang br
|
||||
(require "go.rkt")
|
||||
(provide b-if b-or-expr b-and-expr b-not-expr b-comp-expr)
|
||||
|
||||
(define (bool->int val) (if val 1 0))
|
||||
(define nonzero? (compose1 not zero?))
|
||||
|
||||
(define-macro-cases b-or-expr
|
||||
[(_ VAL) #'VAL]
|
||||
[(_ LEFT "or" RIGHT)
|
||||
#'(bool->int (or (nonzero? LEFT) (nonzero? RIGHT)))])
|
||||
|
||||
(define-macro-cases b-and-expr
|
||||
[(_ VAL) #'VAL]
|
||||
[(_ LEFT "and" RIGHT)
|
||||
#'(bool->int (and (nonzero? LEFT) (nonzero? RIGHT)))])
|
||||
|
||||
(define-macro-cases b-not-expr
|
||||
[(_ VAL) #'VAL]
|
||||
[(_ "not" VAL) #'(if (nonzero? VAL) 0 1)])
|
||||
|
||||
(define b= (compose1 bool->int =))
|
||||
(define b< (compose1 bool->int <))
|
||||
(define b> (compose1 bool->int >))
|
||||
(define b<> (compose1 bool->int not =))
|
||||
|
||||
(define-macro-cases b-comp-expr
|
||||
[(_ VAL) #'VAL]
|
||||
[(_ LEFT "=" RIGHT) #'(b= LEFT RIGHT)]
|
||||
[(_ LEFT "<" RIGHT) #'(b< LEFT RIGHT)]
|
||||
[(_ LEFT ">" RIGHT) #'(b> LEFT RIGHT)]
|
||||
[(_ LEFT "<>" RIGHT) #'(b<> LEFT RIGHT)])
|
||||
|
||||
(define-macro-cases b-if
|
||||
[(_ COND-EXPR THEN-EXPR) #'(b-if COND-EXPR THEN-EXPR (void))]
|
||||
[(_ COND-EXPR THEN-EXPR ELSE-EXPR)
|
||||
#'(let ([result (if (nonzero? COND-EXPR)
|
||||
THEN-EXPR
|
||||
ELSE-EXPR)])
|
||||
(when (exact-positive-integer? result)
|
||||
(b-goto result)))])
|
||||
@ -1,3 +1,6 @@
|
||||
#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"))
|
||||
(require "line.rkt" "go.rkt"
|
||||
"expr.rkt" "misc.rkt" "cond.rkt")
|
||||
(provide
|
||||
(all-from-out "line.rkt" "go.rkt"
|
||||
"expr.rkt" "misc.rkt" "cond.rkt"))
|
||||
@ -1,26 +1,24 @@
|
||||
#lang br
|
||||
(provide (all-defined-out))
|
||||
(provide b-expr b-sum b-product b-neg b-expt)
|
||||
|
||||
(define (b-expr expr)
|
||||
(if (integer? expr) (inexact->exact expr) expr))
|
||||
|
||||
;; 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)])
|
||||
[(_ VAL) #'VAL]
|
||||
[(_ LEFT "+" RIGHT) #'(+ LEFT RIGHT)]
|
||||
[(_ LEFT "-" RIGHT) #'(- LEFT RIGHT)])
|
||||
|
||||
;; 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))
|
||||
[(_ LEFT "mod" RIGHT) #'(modulo LEFT RIGHT)])
|
||||
|
||||
(define (b-not expr) (if (zero? expr) 1 0))
|
||||
(define-macro-cases b-neg
|
||||
[(_ VAL) #'VAL]
|
||||
[(_ "-" VAL) #'(- VAL)])
|
||||
|
||||
(define-macro (b-def ID VAR EXPR)
|
||||
#'(set! ID (λ (VAR) EXPR)))
|
||||
(define-macro-cases b-expt
|
||||
[(_ VAL) #'VAL]
|
||||
[(_ LEFT "^" RIGHT) #'(expt LEFT RIGHT)])
|
||||
@ -1,19 +1,52 @@
|
||||
#lang br
|
||||
(require "structs.rkt" "line.rkt")
|
||||
(provide b-goto b-gosub b-return)
|
||||
(require "struct.rkt" "line.rkt" "misc.rkt")
|
||||
(provide b-end b-goto b-gosub b-return b-for b-next)
|
||||
|
||||
(define (b-end) (raise (end-program-signal)))
|
||||
|
||||
(define (b-goto num-expr)
|
||||
(raise (change-line-signal num-expr)))
|
||||
|
||||
(define return-stack empty)
|
||||
(define return-ccs empty)
|
||||
|
||||
(define (b-gosub num-expr)
|
||||
(let/cc return-cc
|
||||
(push! return-stack return-cc)
|
||||
(let/cc this-cc
|
||||
(push! return-ccs this-cc)
|
||||
(b-goto num-expr)))
|
||||
|
||||
(define (b-return)
|
||||
(unless (pair? return-stack)
|
||||
(unless (not (empty? return-ccs))
|
||||
(raise-line-error "return without gosub"))
|
||||
(define top-return-k (pop! return-stack))
|
||||
(top-return-k))
|
||||
(define top-cc (pop! return-ccs))
|
||||
(top-cc (void)))
|
||||
|
||||
(define next-funcs (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! next-funcs
|
||||
'LOOP-ID
|
||||
(λ ()
|
||||
(define next-val
|
||||
(+ LOOP-ID STEP))
|
||||
(if (next-val
|
||||
. in-closed-interval? .
|
||||
START END)
|
||||
(loop-cc next-val)
|
||||
(hash-remove! next-funcs
|
||||
'LOOP-ID))))
|
||||
START))])
|
||||
|
||||
(define (in-closed-interval? x start end)
|
||||
((if (< start end) <= >=) start x end))
|
||||
|
||||
(define-macro (b-next LOOP-ID)
|
||||
#'(begin
|
||||
(unless (hash-has-key? next-funcs 'LOOP-ID)
|
||||
(raise-line-error
|
||||
(format "`next ~a` without for" 'LOOP-ID)))
|
||||
(define func (hash-ref next-funcs 'LOOP-ID))
|
||||
(func)))
|
||||
@ -1,17 +1,22 @@
|
||||
#lang br
|
||||
(require "structs.rkt")
|
||||
(provide (all-defined-out))
|
||||
(require "struct.rkt")
|
||||
(provide b-line raise-line-error)
|
||||
|
||||
(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))])
|
||||
(with-handlers
|
||||
([line-error?
|
||||
(λ (le) (handle-line-error NUM le))])
|
||||
(when msg (raise-line-error msg))
|
||||
STATEMENT ...)))))
|
||||
|
||||
(define (raise-line-error error-msg)
|
||||
(raise (line-error error-msg)))
|
||||
|
||||
(define (handle-line-error num le)
|
||||
(error (format "error in line ~a: ~a" num (line-error-msg 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,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-demo-3/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]))
|
||||
@ -0,0 +1,15 @@
|
||||
#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-demo-3/parse-stx
|
||||
#'#,parse-tree)))
|
||||
(module+ reader (provide read-syntax))
|
||||
|
||||
(define-macro (parser-only-mb PARSE-STX)
|
||||
#'(#%module-begin
|
||||
PARSE-STX))
|
||||
(provide (rename-out [parser-only-mb #%module-begin]))
|
||||
(provide syntax)
|
||||
@ -1,37 +1,33 @@
|
||||
#lang brag
|
||||
;; program & lines
|
||||
b-program : [b-line] (/NEWLINE [b-line])*
|
||||
b-line : b-line-num [b-statement] (/":" [b-statement])*
|
||||
b-line : b-line-num [b-statement] (/":" [b-statement])* [b-rem]
|
||||
@b-line-num : 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-statement : b-end | b-print | b-goto
|
||||
| b-let | b-input | b-if
|
||||
| b-gosub | b-return | b-for | b-next
|
||||
b-end : /"end"
|
||||
b-print : /"print" [STRING | b-expr] (/";" [STRING | b-expr])*
|
||||
b-print : /"print" [b-printable] (/";" [b-printable])*
|
||||
@b-printable : STRING | b-expr
|
||||
b-goto : /"goto" b-expr
|
||||
b-if : /"if" b-expr /"then" b-expr [/"else" b-expr]
|
||||
b-let : [/"let"] b-id /"=" (STRING | b-expr)
|
||||
b-if : /"if" b-expr /"then" (b-statement | b-expr)
|
||||
[/"else" (b-statement | b-expr)]
|
||||
b-input : /"input" b-id
|
||||
@b-id : ID
|
||||
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-next : /"next" b-id
|
||||
b-expr : b-or-expr
|
||||
b-or-expr : [b-or-expr "or"] b-and-expr
|
||||
b-and-expr : [b-and-expr "and"] b-not-expr
|
||||
b-not-expr : ["not"] 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
|
||||
b-product : [b-product ("*"|"/"|"mod")] b-neg
|
||||
b-neg : ["-"] b-expt
|
||||
b-expt : [b-expt ("^")] b-value
|
||||
@b-value : b-number | b-id | /"(" b-expr /")"
|
||||
@b-number : INTEGER | DECIMAL
|
||||
@ -1,4 +1,4 @@
|
||||
#lang basic-demo-2
|
||||
#lang basic-demo-3
|
||||
10 rem all results should be 1
|
||||
20 def f(x) = x * x
|
||||
30 print f((1+2)*3) = 81
|
||||
@ -1,4 +1,4 @@
|
||||
#lang basic-demo-2
|
||||
#lang basic-demo-3
|
||||
10 a = 1 : a = 5
|
||||
20 gosub 150
|
||||
30 a = 25
|
||||
@ -1,8 +1,6 @@
|
||||
#lang basic-demo-2
|
||||
#lang basic-demo-3
|
||||
10 for a = 1 to 3
|
||||
20 print a
|
||||
21 for b = 103 to 101 step -1
|
||||
22 print b
|
||||
21 for b = 9 to 7 step -1
|
||||
22 print a ; b
|
||||
23 next b
|
||||
30 next a
|
||||
40 print "yay"
|
||||
30 next a
|
||||
@ -1,3 +1,3 @@
|
||||
#lang br
|
||||
(require basic-demo-2/sample-var)
|
||||
(require basic-demo-3/sample-var)
|
||||
(* a a)
|
||||
@ -1,4 +1,4 @@
|
||||
#lang basic-demo-2
|
||||
#lang basic-demo-3
|
||||
5 print "enter your name: "
|
||||
10 input A$
|
||||
20 print "hello, " ; A$ ; "!"
|
||||
@ -1,9 +1,9 @@
|
||||
#lang basic-demo-2
|
||||
#lang basic-demo-3
|
||||
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
|
||||
70 print 6 mod 2 = 0
|
||||
80 print 5 mod 2 = 1
|
||||
|
||||
@ -1,9 +1,9 @@
|
||||
#lang basic-demo
|
||||
#lang basic-demo-3
|
||||
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"
|
||||
70 goto 11. + 18.5 + .5 rem ignored
|
||||
10 print "o" ; "n" ; "e"
|
||||
20 print : goto 60.0 : end
|
||||
@ -0,0 +1,8 @@
|
||||
#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))
|
||||
Loading…
Reference in New Issue