consolidate

beautiful-racket-demo/basic-demo-2/elements.rkt

@@ -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")
+(require "line.rkt" "go.rkt" "if.rkt" "expr.rkt" "for.rkt" "misc.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"))
+(provide (all-from-out "line.rkt" "go.rkt" "if.rkt" "expr.rkt" "for.rkt" "misc.rkt"))

beautiful-racket-demo/basic-demo-2/end.rkt

@@ -1,5 +0,0 @@
-#lang br
-(require "structs.rkt")
-(provide b-end)
-(define (b-end)
-  (raise (end-program-signal)))

beautiful-racket-demo/basic-demo-2/expander-runtime-errors.rkt

@@ -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)))))

beautiful-racket-demo/basic-demo-2/for.rkt

@@ -1,5 +1,5 @@
 #lang br
-(require "let.rkt" "line.rkt")
+(require "misc.rkt" "line.rkt")
 (provide b-for b-next)
 
 (define thunk-table (make-hasheq))

beautiful-racket-demo/basic-demo-2/go.rkt

@@ -1,6 +1,9 @@
 #lang br
-(require "goto.rkt" "line.rkt")
+(require "structs.rkt" "line.rkt")
-(provide b-gosub b-return)
+(provide b-goto b-gosub b-return)
+
+(define (b-goto num-expr)
+  (raise (change-line-signal num-expr)))
 
 (define return-stack empty)
 

beautiful-racket-demo/basic-demo-2/goto.rkt

@@ -1,5 +0,0 @@
-#lang br
-(require "structs.rkt")
-(provide b-goto)
-(define (b-goto num-expr)
-  (raise (change-line-signal num-expr)))

beautiful-racket-demo/basic-demo-2/if.rkt

@@ -1,5 +1,5 @@
 #lang br
-(require "goto.rkt")
+(require "go.rkt")
 (provide b-if b-comp-expr b-logic-expr)
 
 ;; b-if : /"if" b-expr /"then" b-expr [/"else" b-expr]

beautiful-racket-demo/basic-demo-2/input.rkt

@@ -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))))

beautiful-racket-demo/basic-demo-2/let.rkt

@@ -1,3 +0,0 @@
-#lang br
-(provide b-let)
-(define-macro (b-let ID VAL) #'(set! ID VAL))

beautiful-racket-demo/basic-demo-2/lexer-test.rkt

@@ -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")))

beautiful-racket-demo/basic-demo-2/misc.rkt

@@ -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)))

beautiful-racket-demo/basic-demo-2/parse-only.rkt

@@ -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]))

beautiful-racket-demo/basic-demo-2/parse-stx.rkt

@@ -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)

beautiful-racket-demo/basic-demo-2/print.rkt

@@ -1,4 +0,0 @@
-#lang br
-(provide b-print)
-(define (b-print . vals)
-  (displayln (string-append* (map ~a vals))))

beautiful-racket-demo/basic-demo-2/rem.rkt

@@ -1,3 +0,0 @@
-#lang br
-(provide b-rem)
-(define (b-rem val) (void))

beautiful-racket-demo/basic-demo-2/test-parser.rkt

@@ -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))

beautiful-racket-demo/basic-demo-2/tokenize-only.rkt

@@ -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]))