From 481cbab336a5ce967d2624f7e247eba93df4fa35 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 31 May 2016 12:50:43 -0700 Subject: [PATCH] finish for-next loops --- beautiful-racket-lib/br/main.rkt | 4 +- beautiful-racket/br/demo/basic/3dplot.bas | 19 ++++++++ beautiful-racket/br/demo/basic/amazing.bas | 9 ++++ beautiful-racket/br/demo/basic/expander.rkt | 46 ++++++++++---------- beautiful-racket/br/demo/basic/parser.rkt | 12 ++--- beautiful-racket/br/demo/basic/sinewave.bas | 21 +++++++-- beautiful-racket/br/demo/basic/tokenizer.rkt | 6 +-- 7 files changed, 80 insertions(+), 37 deletions(-) create mode 100644 beautiful-racket/br/demo/basic/3dplot.bas create mode 100644 beautiful-racket/br/demo/basic/amazing.bas diff --git a/beautiful-racket-lib/br/main.rkt b/beautiful-racket-lib/br/main.rkt index 723edfb..5ed358d 100644 --- a/beautiful-racket-lib/br/main.rkt +++ b/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 diff --git a/beautiful-racket/br/demo/basic/3dplot.bas b/beautiful-racket/br/demo/basic/3dplot.bas new file mode 100644 index 0000000..85f0331 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/amazing.bas b/beautiful-racket/br/demo/basic/amazing.bas new file mode 100644 index 0000000..a3b1efe --- /dev/null +++ b/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 \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/expander.rkt b/beautiful-racket/br/demo/basic/expander.rkt index 5623581..8d49f05 100644 --- a/beautiful-racket/br/demo/basic/expander.rkt +++ b/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 diff --git a/beautiful-racket/br/demo/basic/parser.rkt b/beautiful-racket/br/demo/basic/parser.rkt index aa9cdad..de99f9c 100644 --- a/beautiful-racket/br/demo/basic/parser.rkt +++ b/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]* /")"] \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/sinewave.bas b/beautiful-racket/br/demo/basic/sinewave.bas index 9a1201e..cc6b23d 100644 --- a/beautiful-racket/br/demo/basic/sinewave.bas +++ b/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$ \ No newline at end of file +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 \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/tokenizer.rkt b/beautiful-racket/br/demo/basic/tokenizer.rkt index 46ff2bd..186e415 100644 --- a/beautiful-racket/br/demo/basic/tokenizer.rkt +++ b/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))]