need separate namespace for dim vars
This commit is contained in:
Matthew Butterick
parent
7903287fa2
commit
3bbbf45358
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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
|
||||
7
beautiful-racket/br/demo/basic/dim.bas
Normal file
7
beautiful-racket/br/demo/basic/dim.bas
Normal file
|
|
@ -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)
|
||||
|
|
@ -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
|
||||
|
|
|
|||
2
beautiful-racket/br/demo/basic/importest.rkt
Normal file
2
beautiful-racket/br/demo/basic/importest.rkt
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
#lang racket
|
||||
(require "for.bas")
|
||||
11
beautiful-racket/br/demo/basic/on.bas
Normal file
11
beautiful-racket/br/demo/basic/on.bas
Normal file
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
@ -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))]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user