consolidate
parent
696a73052b
commit
cc4b7d358c
@ -1,3 +1,3 @@
|
||||
#lang br
|
||||
(require "line.rkt" "goto.rkt" "end.rkt" "let.rkt" "rem.rkt" "print.rkt" "if.rkt" "expr.rkt" "input.rkt" "gosub.rkt" "for.rkt")
|
||||
(provide (all-from-out "line.rkt" "goto.rkt" "end.rkt" "let.rkt" "rem.rkt" "print.rkt" "if.rkt" "expr.rkt" "input.rkt" "gosub.rkt" "for.rkt"))
|
||||
(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"))
|
||||
@ -1,5 +0,0 @@
|
||||
#lang br
|
||||
(require "structs.rkt")
|
||||
(provide b-end)
|
||||
(define (b-end)
|
||||
(raise (end-program-signal)))
|
||||
@ -1,61 +0,0 @@
|
||||
#lang br/quicklang
|
||||
(provide (rename-out [b-module-begin #%module-begin])
|
||||
(matching-identifiers-out #rx"^b-" (all-defined-out)))
|
||||
|
||||
(define-macro (b-module-begin (b-program LINE ...))
|
||||
(with-pattern
|
||||
([(LINE-NUM ...)
|
||||
(filter-stx-prop 'b-line-number
|
||||
(stx-flatten #'(LINE ...)))]
|
||||
[(LINE-ID ...) (prefix-ids "line-" #'(LINE-NUM ...))])
|
||||
#'(#%module-begin
|
||||
LINE ...
|
||||
(define line-table
|
||||
(apply hasheqv (append (list LINE-NUM LINE-ID) ...)))
|
||||
(run line-table))))
|
||||
|
||||
(define-macro (b-line LINE-NUMBER STATEMENT ...)
|
||||
(with-pattern
|
||||
([LINE-NUMBER-ID (prefix-id "line-" #'LINE-NUMBER
|
||||
#:source #'LINE-NUMBER)]
|
||||
[ORIG-LOC caller-stx])
|
||||
(syntax/loc caller-stx
|
||||
(define (LINE-NUMBER-ID #:srcloc? [loc #f])
|
||||
(if loc
|
||||
(syntax-srcloc #'ORIG-LOC)
|
||||
(begin (void) STATEMENT ...))))))
|
||||
|
||||
(define b-rem void)
|
||||
(define (b-print [val ""]) (displayln val))
|
||||
(define (b-sum . nums) (apply + nums))
|
||||
(define (b-num-expr expr)
|
||||
(if (integer? expr) (inexact->exact expr) expr))
|
||||
|
||||
(struct $program-end-signal ())
|
||||
(define (b-end) (raise ($program-end-signal)))
|
||||
|
||||
(struct $change-line-signal (val))
|
||||
(define (b-goto expr) (raise ($change-line-signal expr)))
|
||||
|
||||
(define-exn line-not-found exn:fail)
|
||||
|
||||
(define (run line-table)
|
||||
(define line-vec
|
||||
(list->vector (sort (hash-keys line-table) <)))
|
||||
(with-handlers ([$program-end-signal? void])
|
||||
(for/fold ([line-idx 0])
|
||||
([i (in-naturals)])
|
||||
(unless (< line-idx (vector-length line-vec)) (b-end))
|
||||
(define line-num (vector-ref line-vec line-idx))
|
||||
(define line-proc (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))
|
||||
(raise-line-not-found
|
||||
(line-proc #:srcloc? #t))))])
|
||||
(line-proc)
|
||||
(add1 line-idx)))))
|
||||
@ -1,6 +1,9 @@
|
||||
#lang br
|
||||
(require "goto.rkt" "line.rkt")
|
||||
(provide b-gosub b-return)
|
||||
(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)
|
||||
|
||||
@ -1,5 +0,0 @@
|
||||
#lang br
|
||||
(require "structs.rkt")
|
||||
(provide b-goto)
|
||||
(define (b-goto num-expr)
|
||||
(raise (change-line-signal num-expr)))
|
||||
@ -1,7 +0,0 @@
|
||||
#lang br
|
||||
(provide b-input)
|
||||
|
||||
(define-macro (b-input ID)
|
||||
#'(set! ID (let* ([str (read-line)]
|
||||
[num (string->number (string-trim str))])
|
||||
(or num str))))
|
||||
@ -1,3 +0,0 @@
|
||||
#lang br
|
||||
(provide b-let)
|
||||
(define-macro (b-let ID VAL) #'(set! ID VAL))
|
||||
@ -1,58 +0,0 @@
|
||||
#lang br
|
||||
(require "lexer.rkt" brag/support rackunit)
|
||||
|
||||
(define (lex str)
|
||||
(apply-lexer basic-lexer str))
|
||||
|
||||
(check-equal? (lex "") empty)
|
||||
(check-equal?
|
||||
(lex " ")
|
||||
(list (srcloc-token (token " " #:skip? #t)
|
||||
(srcloc 'string #f #f 1 1))))
|
||||
(check-equal?
|
||||
(lex "rem ignored\n")
|
||||
(list (srcloc-token (token 'REM "rem ignored")
|
||||
(srcloc 'string #f #f 1 11))
|
||||
(srcloc-token (token 'NEWLINE "\n")
|
||||
(srcloc 'string #f #f 12 1))))
|
||||
(check-equal?
|
||||
(lex "print")
|
||||
(list (srcloc-token "print"
|
||||
(srcloc 'string #f #f 1 5))))
|
||||
(check-equal?
|
||||
(lex "goto")
|
||||
(list (srcloc-token "goto"
|
||||
(srcloc 'string #f #f 1 4))))
|
||||
(check-equal?
|
||||
(lex "end")
|
||||
(list (srcloc-token "end"
|
||||
(srcloc 'string #f #f 1 3))))
|
||||
(check-equal?
|
||||
(lex "+")
|
||||
(list (srcloc-token "+"
|
||||
(srcloc 'string #f #f 1 1))))
|
||||
(check-equal?
|
||||
(lex "12")
|
||||
(list (srcloc-token (token 'INTEGER 12)
|
||||
(srcloc 'string #f #f 1 2))))
|
||||
(check-equal?
|
||||
(lex "1.2")
|
||||
(list (srcloc-token (token 'DECIMAL 1.2)
|
||||
(srcloc 'string #f #f 1 3))))
|
||||
(check-equal?
|
||||
(lex "12.")
|
||||
(list (srcloc-token (token 'DECIMAL 12.)
|
||||
(srcloc 'string #f #f 1 3))))
|
||||
(check-equal?
|
||||
(lex ".12")
|
||||
(list (srcloc-token (token 'DECIMAL .12)
|
||||
(srcloc 'string #f #f 1 3))))
|
||||
(check-equal?
|
||||
(lex "\"foo\"")
|
||||
(list (srcloc-token (token 'STRING "foo")
|
||||
(srcloc 'string #f #f 1 5))))
|
||||
(check-equal?
|
||||
(lex "'foo'")
|
||||
(list (srcloc-token (token 'STRING "foo")
|
||||
(srcloc 'string #f #f 1 5))))
|
||||
(check-exn exn:fail:read? (lambda () (lex "x")))
|
||||
@ -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)
|
||||
#'(set! ID (let* ([str (read-line)]
|
||||
[num (string->number (string-trim str))])
|
||||
(or num str))))
|
||||
|
||||
(define (b-end) (raise (end-program-signal)))
|
||||
@ -1,14 +0,0 @@
|
||||
#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/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,15 +0,0 @@
|
||||
#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/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,4 +0,0 @@
|
||||
#lang br
|
||||
(provide b-print)
|
||||
(define (b-print . vals)
|
||||
(displayln (string-append* (map ~a vals))))
|
||||
@ -1,3 +0,0 @@
|
||||
#lang br
|
||||
(provide b-rem)
|
||||
(define (b-rem val) (void))
|
||||
@ -1,11 +0,0 @@
|
||||
#lang br
|
||||
(require "tokenizer.rkt" "parser.rkt" brag/support)
|
||||
|
||||
(define str #<<here
|
||||
10 rem print
|
||||
20 end
|
||||
|
||||
here
|
||||
)
|
||||
|
||||
(parse-to-datum (apply-tokenizer-maker make-tokenizer str))
|
||||
@ -1,14 +0,0 @@
|
||||
#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-demo/tokenize-only
|
||||
#,@tokens)))
|
||||
(module+ reader (provide read-syntax))
|
||||
|
||||
(define-macro (parser-only-mb TOKEN ...)
|
||||
#'(#%module-begin
|
||||
(list TOKEN ...)))
|
||||
(provide (rename-out [parser-only-mb #%module-begin]))
|
||||
Loading…
Reference in New Issue