From 3bbbf45358bd501f401a213a10610bb7147a3471 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 10 Jun 2016 12:49:46 -0700 Subject: [PATCH] need separate namespace for dim vars --- beautiful-racket/br/demo/basic/aceyducey.bas | 2 +- beautiful-racket/br/demo/basic/amazing.bas | 137 ++++++++++++++++++- beautiful-racket/br/demo/basic/dim.bas | 7 + beautiful-racket/br/demo/basic/expander.rkt | 77 +++++++++-- beautiful-racket/br/demo/basic/importest.rkt | 2 + beautiful-racket/br/demo/basic/on.bas | 11 ++ beautiful-racket/br/demo/basic/parser.rkt | 8 +- beautiful-racket/br/demo/basic/tokenizer.rkt | 2 +- 8 files changed, 222 insertions(+), 24 deletions(-) create mode 100644 beautiful-racket/br/demo/basic/dim.bas create mode 100644 beautiful-racket/br/demo/basic/importest.rkt create mode 100644 beautiful-racket/br/demo/basic/on.bas diff --git a/beautiful-racket/br/demo/basic/aceyducey.bas b/beautiful-racket/br/demo/basic/aceyducey.bas index c9a09fd..e0ffee9 100644 --- a/beautiful-racket/br/demo/basic/aceyducey.bas +++ b/beautiful-racket/br/demo/basic/aceyducey.bas @@ -11,7 +11,7 @@ 80 PRINT"IF YOU DO NOT WANT TO BET, INPUT A 0" 100 N=100 110 Q=100 -120 PRINT "YOU NOW HAVE ";Q;" DOLLARS." +120 PRINT "YOU NOW HAVE";Q;"DOLLARS." 130 PRINT 140 GOTO 260 210 Q=Q+M diff --git a/beautiful-racket/br/demo/basic/amazing.bas b/beautiful-racket/br/demo/basic/amazing.bas index a3b1efe..f67a15c 100644 --- a/beautiful-racket/br/demo/basic/amazing.bas +++ b/beautiful-racket/br/demo/basic/amazing.bas @@ -1,9 +1,138 @@ #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 +100 H = 10 : V = 10 +110 DIM W(H,V),V(H,V) +120 PRINT +130 PRINT +140 PRINT +150 PRINT +160 Q=0:Z=0:X=INT(0.5*H+1) +165 FOR I=1 TO H +170 IF I=X THEN 173 +171 PRINT ".--";:GOTO 180 +173 PRINT ". "; +180 NEXT I +190 PRINT "." +195 C=1:W(X,1)=C:C=C+1 +200 R=X:S=1:GOTO 260 +210 IF R<>H THEN 240 +215 IF S<>V THEN 230 +220 R=1:S=1:GOTO 250 +230 R=1:S=S+1:GOTO 250 +240 R=R+1 +250 IF W(R,S)=0 THEN 210 +260 IF R-1=0 THEN 530 +265 IF W(R-1,S)<>0 THEN 530 +270 IF S-1=0 THEN 390 +280 IF W(R,S-1)<>0 THEN 390 +290 IF R=H THEN 330 +300 IF W(R+1,S)<>0 THEN 330 +310 X=INT(0.5*3+1) +320 ON X GOTO 790,820,860 +330 IF S<>V THEN 340 +334 IF Z=1 THEN 370 +338 Q=1:GOTO 350 +340 IF W(R,S+1)<>0 THEN 370 +350 X=INT(0.5*3+1) +360 ON X GOTO 790,820,910 +370 X=INT(0.5*2+1) +380 ON X GOTO 790,820 +390 IF R=H THEN 470 +400 IF W(R+1,S)<>0 THEN 470 +405 IF S<>V THEN 420 +410 IF Z=1 THEN 450 +415 Q=1:GOTO 430 +420 print R ; S+1 : IF W(R,S+1)<>0 THEN 450 +430 X=INT(0.5*3+1) +440 ON X GOTO 790,860,910 +450 X=INT(0.5*2+1) +460 ON X GOTO 790,860 +470 IF S<>V THEN 490 +480 IF Z=1 THEN 520 +485 Q=1:GOTO 500 +490 print R ; S+1 : IF W(R,S+1)<>0 THEN 520 +500 X=INT(0.5*2+1) +510 ON X GOTO 790,910 +520 GOTO 790 +530 IF S-1=0 THEN 670 +540 IF W(R,S-1)<>0 THEN 670 +545 IF R=H THEN 610 +547 IF W(R+1,S)<>0 THEN 610 +550 IF S<>V THEN 560 +552 IF Z=1 THEN 590 +554 Q=1:GOTO 570 +560 IF W(R,S+1)<>0 THEN 590 +570 X=INT(0.5*3+1) +580 ON X GOTO 820,860,910 +590 X=INT(0.5*2+1) +600 ON X GOTO 820,860 +610 IF S<>V THEN 630 +620 IF Z=1 THEN 660 +625 Q=1:GOTO 640 +630 IF W(R,S+1)<>0 THEN 660 +640 X=INT(0.5*2+1) +650 ON X GOTO 820,910 +660 GOTO 820 +670 IF R=H THEN 740 +680 IF W(R+1,S)<>0 THEN 740 +685 IF S<>V THEN 700 +690 IF Z=1 THEN 730 +695 Q=1:GOTO 830 +700 IF W(R,S+1)<>0 THEN 730 +710 X=INT(0.5*2+1) +720 ON X GOTO 860,910 +730 GOTO 860 +740 IF S<>V THEN 760 +750 IF Z=1 THEN 780 +755 Q=1:GOTO 770 +760 IF W(R,S+1)<>0 THEN 780 +770 GOTO 910 +780 GOTO 1000 +790 W(R-1,S)=C +800 C=C+1:V(R-1,S)=2:R=R-1 +810 IF C=H*V+1 THEN 1010 +815 Q=0:GOTO 260 +820 W(R,S-1)=C +830 C=C+1 +840 V(R,S-1)=1:S=S-1:IF C=H*V+1 THEN 1010 +850 Q=0:GOTO 260 +860 W(R+1,S)=C +870 C=C+1:IF V(R,S)=0 THEN 880 +875 V(R,S)=3:GOTO 890 +880 V(R,S)=2 +890 R=R+1 +900 IF C=H*V+1 THEN 1010 +905 GOTO 530 +910 IF Q=1 THEN 960 +920 W(R,S+1)=C:C=C+1:IF V(R,S)=0 THEN 940 +930 V(R,S)=3:GOTO 950 +940 V(R,S)=1 +950 S=S+1:IF C=H*V+1 THEN 1010 +955 GOTO 260 +960 Z=1 +970 IF V(R,S)=0 THEN 980 +975 V(R,S)=3:Q=0:GOTO 1000 +980 V(R,S)=1:Q=0:R=1:S=1:GOTO 250 +1000 GOTO 210 +1010 FOR J=1 TO V +1011 PRINT "I"; +1012 FOR I=1 TO H +1013 IF V(I,J)<2 THEN 1030 +1020 PRINT " "; +1021 GOTO 1040 +1030 PRINT " I"; +1040 NEXT I +1041 PRINT +1043 FOR I=1 TO H +1045 IF V(I,J)=0 THEN 1060 +1050 IF V(I,J)=2 THEN 1060 +1051 PRINT ": "; +1052 GOTO 1070 +1060 PRINT ":--"; +1070 NEXT I +1071 PRINT "." +1072 NEXT J +1073 END \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/dim.bas b/beautiful-racket/br/demo/basic/dim.bas new file mode 100644 index 0000000..b6be6eb --- /dev/null +++ b/beautiful-racket/br/demo/basic/dim.bas @@ -0,0 +1,7 @@ +#lang br/demo/basic + +5 A=5 +10 DIM A(A) +20 PRINT A /* this should print 5 */ +30 PRINT A(0) +40 PRINT A(5) \ 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 fae0154..d4d80f1 100644 --- a/beautiful-racket/br/demo/basic/expander.rkt +++ b/beautiful-racket/br/demo/basic/expander.rkt @@ -18,6 +18,7 @@ (gather-unique-ids #'(PROGRAM-LINE ...)))]) #'(#%module-begin (define UNIQUE-ID 0) ... + (provide UNIQUE-ID ...) (run PROGRAM-LINE ... (line #f (statement "end")))))) ; #%app and #%datum have to be present to make #%top work @@ -66,18 +67,33 @@ (set! return-stack (cons return-k return-stack)) (basic:goto where))) +(define current-line (make-parameter #f)) (struct $line (number thunk)) (define-macro (line NUMBER . STATEMENTS) - #'($line NUMBER (λ () (with-handlers ([end-line-signal? (λ _ #f)]) - . STATEMENTS)))) + #'($line NUMBER (λ () + (current-line NUMBER) + (with-handlers ([end-line-signal? (λ _ #f)] + [end-program-signal? raise] + [exn:fail? (λ(exn) + (displayln (format "in line ~a" NUMBER)) + (raise exn))]) + . STATEMENTS)))) (define-macro statement - [(statement ID "=" EXPR) #'(set! ID EXPR)] + [(statement ID "=" EXPR) #'(basic:let ID EXPR)] [(statement PROC-NAME . ARGS) (with-pattern ([PROC-ID (prefix-id "basic:" #'PROC-NAME)]) #'(PROC-ID . ARGS))]) +(define-macro basic:let + [(_ (id-expr ID) EXPR) + #'(begin + #;(displayln (format "setting ~a = ~a in ~a" 'ID EXPR (current-line))) + (set! ID EXPR))] + [(_ (id-expr ID DIM-IDX ...) EXPR) + #'(array-set! ID DIM-IDX ... EXPR)]) + (define-macro basic:if [(_ COND-EXPR TRUE-EXPR FALSE-EXPR) #'(if (true? COND-EXPR) @@ -93,6 +109,16 @@ (define (basic:and . args) (cond->int (andmap true? args))) (define (basic:or . args) (cond->int (ormap true? args))) +(define-macro id-expr + [(_ ID) #'(cond + [(procedure? ID) (ID)] + [(array? ID) (array-ref ID (make-vector (array-rank ID) 0))] ; no subscript => zeroth element + [else ID])] + [(_ ID EXPR0 EXPR ...) #'(cond + [(procedure? ID) (ID EXPR0 EXPR ...)] + [(array? ID) (array-ref ID EXPR0 EXPR ...)] + [else (error 'id-expr-confused)])]) + (define-macro expr [(_ COMP-EXPR) #'COMP-EXPR] [(_ COMP-EXPR "and" SUBEXPR) #'(basic:and COMP-EXPR SUBEXPR)] @@ -132,22 +158,30 @@ ;; todo: make it work more like http://www.antonis.de/qbebooks/gwbasman/PRINT.html (define (basic:print [args #f]) + (define (println [x ""]) (displayln x) (set! current-print-position 0)) + (define (print x) (display x) (set! current-print-position (+ current-print-position (string-length x)))) + (match args - [#f (displayln "")] - [(list print-list-item ... ";" pl) (begin (for-each (λ(pli) - (let ([pli (if (number? pli) - (format "~a " pli) - pli)]) - (display pli))) print-list-item) - (basic:print pl))] - [(list print-list-item ... ";") (for-each display print-list-item)] - [(list print-list-item ...) (for-each displayln print-list-item)])) + [#f (println)] + [(list print-list-items ... ";" pl) + (begin + (for-each + (λ(pli) + (print (if (number? pli) + (format "~a " pli) + pli))) + print-list-items) + (basic:print pl))] + [(list print-list-items ... ";") (for-each print print-list-items)] + [(list print-list-items ...) + (for-each println print-list-items)])) ;; todo: make it work more like http://www.antonis.de/qbebooks/gwbasman/TAB.html ;; need to track current line position -(define (TAB num) (make-string num #\space)) -(define-macro (INT _ARG ...) #'(inexact->exact (truncate (expr _ARG ...)))) +(define current-print-position 0) +(define (TAB num) (make-string (max 0 (- num current-print-position)) #\space)) +(define (INT num) (inexact->exact (truncate num))) (define (SIN num) (sin num)) (define (ABS num) (inexact->exact (abs num))) (define (RND num) (* (random) num)) @@ -166,6 +200,13 @@ (define (basic:goto where) where) +(define-macro basic:on + [(_ TEST-EXPR "goto" OPTION ...) + #'(basic:goto (list-ref (list OPTION ...) (sub1 TEST-EXPR)))] + [(_ TEST-EXPR "gosub" OPTION ...) + #'(basic:gosub (list-ref (list OPTION ...) (sub1 TEST-EXPR)))]) + + (define (basic:return) (define return-k (car return-stack)) (set! return-stack (cdr return-stack)) @@ -174,6 +215,12 @@ (define (basic:stop) (basic:end)) (define (basic:end) (raise-end-program-signal)) +(require srfi/25) + +(define-macro (basic:dim (id-expr ID EXPR ...) ...) + #'(begin + (set! ID (make-array (apply shape (append (list 0 (add1 EXPR)) ...)))) ...)) + (define for-stack empty) (define (push-for-stack thunk) @@ -191,7 +238,7 @@ #'(basic:for VAR START-VALUE END-VALUE 1)] [(_ VAR START-VALUE END-VALUE STEP-VALUE) #'(begin - (statement VAR "=" START-VALUE) ; initialize the loop counter + (statement (id-expr VAR) "=" START-VALUE) ; initialize the loop counter (let/cc return-k ; create a return point (push-for-stack (cons 'VAR (λ () ; thunk that increments counter & teleports back to beginning of loop diff --git a/beautiful-racket/br/demo/basic/importest.rkt b/beautiful-racket/br/demo/basic/importest.rkt new file mode 100644 index 0000000..dff0c83 --- /dev/null +++ b/beautiful-racket/br/demo/basic/importest.rkt @@ -0,0 +1,2 @@ +#lang racket +(require "for.bas") \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/on.bas b/beautiful-racket/br/demo/basic/on.bas new file mode 100644 index 0000000..454a950 --- /dev/null +++ b/beautiful-racket/br/demo/basic/on.bas @@ -0,0 +1,11 @@ +#lang br/demo/basic +10 X = 3 +20 on X gosub 210, 220, 230 +21 print "yay" +22 end +210 print "one" +211 return +220 print "two" +221 return +230 print "three" +231 return \ No newline at end of file diff --git a/beautiful-racket/br/demo/basic/parser.rkt b/beautiful-racket/br/demo/basic/parser.rkt index c327c9f..92085f7 100644 --- a/beautiful-racket/br/demo/basic/parser.rkt +++ b/beautiful-racket/br/demo/basic/parser.rkt @@ -5,12 +5,14 @@ basic-program : line* line: NUMBER statement [/":" statement]* statement : "def" id /"(" id /")" /"=" expr +| "dim" id-expr [/"," id-expr]* | "end" | "stop" | "gosub" expr | "goto" expr +| "on" expr ("gosub" | "goto") expr [/"," expr]* | "if" expr /"then" (statement | expr) [/"else" (statement | expr)] | "input" [print-list /";"] id [/"," id]* -| [/"let"] id "=" expr +| [/"let"] id-expr "=" expr | "print" [print-list] | "return" | "for" id /"=" value /"to" value [/"step" value] @@ -32,10 +34,10 @@ product : [product ("*" | "/")] value | number | STRING -/id-expr : id [/"(" expr [/"," expr]* /")"] +id-expr : id [/"(" expr [/"," expr]* /")"] @id : ID -id-val : ["-"] id +id-val : ["-"] id-expr number : ["-"] NUMBER \ 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 33fba26..30c0f40 100644 --- a/beautiful-racket/br/demo/basic/tokenizer.rkt +++ b/beautiful-racket/br/demo/basic/tokenizer.rkt @@ -23,7 +23,7 @@ "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" "STOP" "stop" "LET" "let" "DEF" "def" + "AND" "and" "OR" "or" "STOP" "stop" "LET" "let" "DEF" "def" "DIM" "dim" "ON" "on" ";" "=" "(" ")" "+" "-" "*" "/" "<=" ">=" "<>" "<" ">" "=" ":" ",") (string-downcase lexeme)] [number (token 'NUMBER (string->number lexeme))]