finish for-next loops

beautiful-racket-lib/br/main.rkt

@@ -1,10 +1,10 @@
 #lang racket/base
 (require racket/provide racket/list racket/string racket/format racket/match racket/port
-         br/define br/syntax br/datum br/debug br/conditional
+         br/define br/syntax br/datum br/debug br/conditional racket/function
          (for-syntax racket/base racket/syntax br/syntax br/debug br/define))
 (provide (except-out (all-from-out racket/base) define)
          (all-from-out racket/list racket/string racket/format racket/match racket/port
-                       br/syntax br/datum br/debug br/conditional)
+                       br/syntax br/datum br/debug br/conditional racket/function)
          (for-syntax (all-from-out racket/base racket/syntax br/syntax br/debug))
          (for-syntax caller-stx shared-syntax with-shared-id with-calling-site-id) ; from br/define
          (filtered-out

beautiful-racket/br/demo/basic/3dplot.bas

@@ -0,0 +1,19 @@
+#lang br/demo/basic
+
+1 PRINT TAB(32);"3D PLOT"
+2 PRINT TAB(15);"CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"
+3 PRINT:PRINT:PRINT
+5 DEF FNA(Z)=30*EXP(-Z*Z/100)
+100 PRINT
+110 FOR X=-30 TO 30 STEP 1.5
+120 L=0
+130 Y1=5*INT(SQR(900-X*X)/5)
+140 FOR Y=Y1 TO -Y1 STEP -5
+150 Z=INT(25+FNA(SQR(X*X+Y*Y))-.7*Y)
+160 IF Z<=L THEN 190
+170 L=Z
+180 PRINT TAB(Z);"*";
+190 NEXT Y
+200 PRINT
+210 NEXT X
+300 END

beautiful-racket/br/demo/basic/amazing.bas

@@ -0,0 +1,9 @@
+#lang br/demo/basic
+1 REM http://www.vintage-basic.net/bcg/amazing.bas
+
+10 PRINT TAB(28);"AMAZING PROGRAM"
+20 PRINT TAB(15);"CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"
+30 PRINT:PRINT:PRINT:PRINT
+100 INPUT "WHAT ARE YOUR WIDTH AND LENGTH";H,V
+102 IF H<>1 AND V<>1 THEN 110
+104 PRINT "MEANINGLESS DIMENSIONS.  TRY AGAIN.":GOTO 100

beautiful-racket/br/demo/basic/expander.rkt

@@ -103,8 +103,8 @@
 
 (define-macro expr
   [(_ COMP-EXPR) #'COMP-EXPR]
-  [(_ COMP-EXPR "AND" SUBEXPR) #'(basic:and COMP-EXPR SUBEXPR)]
-  [(_ COMP-EXPR "OR" SUBEXPR) #'(basic:or COMP-EXPR SUBEXPR)])
+  [(_ COMP-EXPR "and" SUBEXPR) #'(basic:and COMP-EXPR SUBEXPR)]
+  [(_ COMP-EXPR "or" SUBEXPR) #'(basic:or COMP-EXPR SUBEXPR)])
 
 (define-macro comp-expr
   [(_ SUM) #'SUM]
@@ -144,18 +144,20 @@
 (define (RND num) (* (random) num))
 
 (define-macro basic:input
-  [(_ PRINT-LIST _ID)
+  [(_ (print-list . PL-ITEMS) ID ...)
    #'(begin
-       (basic:print (append PRINT-LIST (list ";")))
-       (basic:input _ID))]
-  [(_ ID) #'(set! ID (let* ([str (read-line)]
+       (basic:print (append (print-list . PL-ITEMS) (list ";")))
+       (basic:input ID) ...)]
+  [(_ ID ...) #'(begin
+                  (set! ID (let* ([str (read-line)]
                             [num (string->number str)])
-                       (or num str)))])
+                       (or num str))) ...)])
 
 (define (basic:goto where) where)
 
 (define (basic:return) (car return-stack))
 
+(define (basic:stop) (basic:end))
 (define (basic:end) (raise-program-end-error))
 
 (define for-stack empty)
@@ -179,21 +181,21 @@
          [else
           (statement VAR "=" START-VALUE)
           (call/cc (λ(for-k)
-                     (push-for-stack (λ ()
-                                       (define next-val (+ VAR STEP-VALUE))
-                                       (and (<= next-val END-VALUE)
-                                            (set! VAR next-val)
-                                            (for-k))))))
+                     (push-for-stack (cons 'VAR
+                                           (λ ()
+                                             (define next-val (+ VAR STEP-VALUE))
+                                             (and (<= next-val END-VALUE)
+                                                  (set! VAR next-val)
+                                                  (for-k)))))))
           (raise-line-end-error)]))])
 
+(define (handle-next [stack-selector-proc car])
+  (unless (pair? for-stack)
+    (error 'next "for-stack is empty"))
+  (let ([for-thunk (cdr (stack-selector-proc for-stack))])
+    (unless (for-thunk)
+      (pop-for-stack))))
+
 (define-macro basic:next
-  [(_ VAR)
-   ;; todo: named `next` means find var in stack
-   #'()]
-  [(_)
-   ;; plain `next` implies var on top of stack
-   #'(if (pair? for-stack)
-         (let ([for-thunk (car for-stack)])
-           (unless (for-thunk)
-             (pop-for-stack)))
-         (error 'next "for-stack is empty"))])
+  [(_ VAR) #'(handle-next (λ(stack) (assq 'VAR stack)))] ; named `next` means find var in stack
+  [(_) #'(handle-next)]) ; plain `next` implies var on top of stack

beautiful-racket/br/demo/basic/parser.rkt

@@ -4,20 +4,20 @@ basic-program : line*
 
 line: NUMBER statement [/":" statement]*
 
-statement : "end"
+statement : "end" | "stop"
 | "gosub" expr
 | "goto" expr
 | "if" expr /"then" (statement | expr) [/"else" (statement | expr)]
-| "input" [print-list /";"] ID
-| ID "=" expr
+| "input" [print-list /";"] ID [/"," ID]*
+| [/"let"] ID "=" expr
 | "print" [print-list]
 | "return"
 | "for" ID /"=" value /"to" value [/"step" value]
 | "next" [ID]
 
-print-list : expr [";" [print-list]]
+print-list : expr [[";"] [print-list]]
 
-expr : comp-expr [("AND" | "OR") expr]
+expr : comp-expr [("and" | "or") expr]
 
 comp-expr : sum [("=" | ">" | ">=" | "<" | "<=" | "<>") comp-expr]
 
@@ -28,7 +28,7 @@ product : [product ("*" | "/")] value
 @value : ID
 | id-expr
 | /"(" expr /")"
-| STRING
 | NUMBER
+| STRING
 
 /id-expr : ID [/"(" expr [/"," expr]* /")"]

beautiful-racket/br/demo/basic/sinewave.bas

@@ -1,6 +1,19 @@
 #lang br/demo/basic
 
-1 A = 2
-10 PRINT A < 2
-12 C$ = "string thing"
-15 PRINT A;: PRINT C$
+10 PRINT TAB(30);"SINE WAVE"
+20 PRINT TAB(15);"CREATIVE COMPUTING  MORRISTOWN, NEW JERSEY"
+30 PRINT: PRINT: PRINT: PRINT: PRINT
+40 REMARKABLE PROGRAM BY DAVID AHL
+50 B=0
+100 REM  START LONG LOOP
+110 FOR T=0 TO 40 STEP .25
+120 A=INT(26+25*SIN(T))
+130 PRINT TAB(A);
+140 IF B=1 THEN 180
+150 PRINT "CREATIVE"
+160 B=1
+170 GOTO 200
+180 PRINT "COMPUTING"
+190 B=0
+200 NEXT T
+999 END

beautiful-racket/br/demo/basic/tokenizer.rkt

@@ -16,14 +16,14 @@
       (lexer-src-pos
        [(eof) eof]
        [(union #\tab #\space #\newline
-               (seq number " REM" (repetition 1 +inf.0 (char-complement #\newline)) #\newline)) (get-token input-port)]
+               (seq number " REM" (repetition 0 +inf.0 (char-complement #\newline)) #\newline)) (get-token input-port)]
        [(union "PRINT" "print" "FOR" "for" "TO" "to" "STEP" "step" "IF" "if"
                "GOTO" "goto" "INPUT" "input" "LET" "let" "NEXT" "next"
                "RETURN" "return" "CLEAR" "clear" "LIST" "list" "RUN" "run"
                "END" "end" "THEN" "then" "ELSE" "else" "GOSUB" "gosub"
-               "AND" "and" "OR" "or"
+               "AND" "and" "OR" "or" "STOP" "stop" "LET" "let"
                ";" "=" "(" ")" "+" "-" "*" "/"
-               "<=" ">=" "<>" "<" ">" "=" ":") (string-downcase lexeme)]
+               "<=" ">=" "<>" "<" ">" "=" ":" ",") (string-downcase lexeme)]
        [(union ",") (get-token input-port)]
        [number (token 'NUMBER (string->number lexeme))]
        [(seq (repetition 1 +inf.0 upper-case) (? "$")) (token 'ID (string->symbol lexeme))]