resume in gosub
This commit is contained in:
Matthew Butterick
parent
510c7b2071
commit
64a3265ef0
101
beautiful-racket/br/demo/basic/aceyducey.bas
Normal file
101
beautiful-racket/br/demo/basic/aceyducey.bas
Normal file
|
|
@ -0,0 +1,101 @@
|
|||
#lang br/demo/basic
|
||||
10 PRINT TAB(26);"ACEY DUCEY CARD GAME"
|
||||
20 PRINT TAB(15);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY"
|
||||
21 PRINT
|
||||
22 PRINT
|
||||
30 PRINT"ACEY-DUCEY IS PLAYED IN THE FOLLOWING MANNER "
|
||||
40 PRINT"THE DEALER (COMPUTER) DEALS TWO CARDS FACE UP"
|
||||
50 PRINT"YOU HAVE AN OPTION TO BET OR NOT BET DEPENDING"
|
||||
60 PRINT"ON WHETHER OR NOT YOU FEEL THE CARD WILL HAVE"
|
||||
70 PRINT"A VALUE BETWEEN THE FIRST TWO."
|
||||
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."
|
||||
130 PRINT
|
||||
140 GOTO 260
|
||||
210 Q=Q+M
|
||||
220 GOTO 120
|
||||
240 Q=Q-M
|
||||
250 GOTO 120
|
||||
260 PRINT"HERE ARE YOUR NEXT TWO CARDS: "
|
||||
270 A=INT(14*RND(1))+2
|
||||
280 IF A<2 THEN 270
|
||||
290 IF A>14 THEN 270
|
||||
300 B=INT(14*RND(1))+2
|
||||
310 IF B<2 THEN 300
|
||||
320 IF B>14 THEN 300
|
||||
330 IF A>=B THEN 270
|
||||
350 IF A<11 THEN 400
|
||||
360 IF A=11 THEN 420
|
||||
370 IF A=12 THEN 440
|
||||
380 IF A=13 THEN 460
|
||||
390 IF A=14 THEN 480
|
||||
400 PRINT A
|
||||
410 GOTO 500
|
||||
420 PRINT"JACK"
|
||||
430 GOTO 500
|
||||
440 PRINT"QUEEN"
|
||||
450 GOTO 500
|
||||
460 PRINT"KING"
|
||||
470 GOTO 500
|
||||
480 PRINT"ACE"
|
||||
500 IF B<11 THEN 550
|
||||
510 IF B=11 THEN 570
|
||||
520 IF B=12 THEN 590
|
||||
530 IF B=13 THEN 610
|
||||
540 IF B=14 THEN 630
|
||||
550 PRINT B
|
||||
560 GOTO 650
|
||||
570 PRINT"JACK"
|
||||
580 GOTO 650
|
||||
590 PRINT"QUEEN"
|
||||
600 GOTO 650
|
||||
610 PRINT"KING"
|
||||
620 GOTO 650
|
||||
630 PRINT"ACE"
|
||||
640 PRINT
|
||||
650 PRINT
|
||||
660 INPUT"WHAT IS YOUR BET";M
|
||||
670 IF M<>0 THEN 680
|
||||
675 PRINT"CHICKEN!!"
|
||||
676 PRINT
|
||||
677 GOTO 260
|
||||
680 IF M<=Q THEN 730
|
||||
690 PRINT"SORRY, MY FRIEND, BUT YOU BET TOO MUCH."
|
||||
700 PRINT"YOU HAVE ONLY ";Q;" DOLLARS TO BET."
|
||||
710 GOTO 650
|
||||
730 C=INT(14*RND(1))+2
|
||||
740 IF C<2 THEN 730
|
||||
750 IF C>14 THEN 730
|
||||
760 IF C<11 THEN 810
|
||||
770 IF C=11 THEN 830
|
||||
780 IF C=12 THEN 850
|
||||
790 IF C=13 THEN 870
|
||||
800 IF C=14 THEN 890
|
||||
810 PRINT C
|
||||
820 GOTO 910
|
||||
830 PRINT"JACK"
|
||||
840 GOTO 910
|
||||
850 PRINT"QUEEN"
|
||||
860 GOTO 910
|
||||
870 PRINT"KING"
|
||||
880 GOTO 910
|
||||
890 PRINT "ACE"
|
||||
900 PRINT
|
||||
910 IF C>A THEN 930
|
||||
920 GOTO 970
|
||||
930 IF C>=B THEN 970
|
||||
950 PRINT"YOU WIN!!!"
|
||||
960 GOTO 210
|
||||
970 PRINT"SORRY, YOU LOSE"
|
||||
980 IF M<Q THEN 240
|
||||
990 PRINT
|
||||
1000 PRINT
|
||||
1010 PRINT"SORRY, FRIEND, BUT YOU BLEW YOUR WAD."
|
||||
1015 PRINT:PRINT
|
||||
1020 INPUT"TRY AGAIN (YES OR NO)";A$
|
||||
1025 PRINT:PRINT
|
||||
1030 IF A$="YES" THEN 110
|
||||
1040 PRINT"O.K., HOPE YOU HAD FUN!"
|
||||
1050 END
|
||||
|
|
@ -1,3 +1,4 @@
|
|||
#lang br/demo/basic
|
||||
2 PRINT TAB(33);"CHANGE"
|
||||
4 PRINT TAB(15);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY"
|
||||
5 PRINT:PRINT:PRINT
|
||||
|
|
|
|||
29
beautiful-racket/br/demo/basic/chemist.bas
Normal file
29
beautiful-racket/br/demo/basic/chemist.bas
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
#lang br/demo/basic
|
||||
|
||||
3 PRINT TAB(33);"CHEMIST"
|
||||
6 PRINT TAB(15);"CREATIVE COMPUTING MORRISTOWN, NEW JERSEY"
|
||||
8 PRINT:PRINT:PRINT
|
||||
10 PRINT "THE FICTITIOUS CHECMICAL KRYPTOCYANIC ACID CAN ONLY BE"
|
||||
20 PRINT "DILUTED BY THE RATIO OF 7 PARTS WATER TO 3 PARTS ACID."
|
||||
30 PRINT "IF ANY OTHER RATIO IS ATTEMPTED, THE ACID BECOMES UNSTABLE"
|
||||
40 PRINT "AND SOON EXPLODES. GIVEN THE AMOUNT OF ACID, YOU MUST"
|
||||
50 PRINT "DECIDE WHO MUCH WATER TO ADD FOR DILUTION. IF YOU MISS"
|
||||
60 PRINT "YOU FACE THE CONSEQUENCES."
|
||||
100 A=INT(RND(1)*50)
|
||||
110 W=7*A/3
|
||||
120 PRINT A;"LITERS OF KRYPTOCYANIC ACID. HOW MUCH WATER";
|
||||
130 INPUT R
|
||||
140 D=ABS(W-R)
|
||||
150 IF D>W/20 THEN 200
|
||||
160 PRINT " GOOD JOB! YOU MAY BREATHE NOW, BUT DON'T INHALE THE FUMES!"
|
||||
170 PRINT
|
||||
180 GOTO 100
|
||||
200 PRINT " SIZZLE! YOU HAVE JUST BEEN DESALINATED INTO A BLOB"
|
||||
210 PRINT " OF QUIVERING PROTOPLASM!"
|
||||
220 T=T+1
|
||||
230 IF T=9 THEN 260
|
||||
240 PRINT " HOWEVER, YOU MAY TRY AGAIN WITH ANOTHER LIFE."
|
||||
250 GOTO 100
|
||||
260 PRINT " YOUR 9 LIVES ARE USED, BUT YOU WILL BE LONG REMEMBERED FOR"
|
||||
270 PRINT " YOUR CONTRIBUTIONS TO THE FIELD OF COMIC BOOK CHEMISTRY."
|
||||
280 END
|
||||
|
|
@ -10,8 +10,8 @@
|
|||
(define #'(basic-module-begin PARSE-TREE ...)
|
||||
#'(#%module-begin
|
||||
(inject-language-variables (A B C D E F G H I J K L M N O P Q R S T U V W X Y Z A$ B$ C$ D$ E$ F$ G$ H$ I$ J$ K$ L$ M$ N$ O$ P$ Q$ R$ S$ T$ U$ V$ W$ X$ Y$ Z$)
|
||||
(println (quote PARSE-TREE ...))
|
||||
PARSE-TREE ...)))
|
||||
(println (quote PARSE-TREE ...))
|
||||
PARSE-TREE ...)))
|
||||
|
||||
; #%app and #%datum have to be present to make #%top work
|
||||
(define #'(basic-top . id)
|
||||
|
|
@ -23,40 +23,66 @@
|
|||
|
||||
(define (run lines)
|
||||
(define program-lines (list->vector (filter (λ(ln) (not (equal? ln "cr"))) lines)))
|
||||
(void (for/fold ([line-idx 0])
|
||||
([i (in-naturals)]
|
||||
#:break (= line-idx (vector-length program-lines)))
|
||||
(match-define (cons line-number proc)
|
||||
(vector-ref program-lines line-idx))
|
||||
(define maybe-jump-number (and proc (proc)))
|
||||
(if (number? maybe-jump-number)
|
||||
(let ([jump-number maybe-jump-number])
|
||||
(for/or ([idx (in-range (vector-length program-lines))])
|
||||
(and (= (car (vector-ref program-lines idx)) jump-number)
|
||||
idx)))
|
||||
(add1 line-idx)))))
|
||||
(void (with-handlers ([exn:program-end? (λ (exn) (void))])
|
||||
(for/fold ([program-counter 0])
|
||||
([i (in-naturals)]
|
||||
#:break (= program-counter (vector-length program-lines)))
|
||||
(match-define (cons line-number proc)
|
||||
(vector-ref program-lines program-counter))
|
||||
(define maybe-jump-number (and proc (proc)))
|
||||
(if (number? maybe-jump-number)
|
||||
(let ([jump-number maybe-jump-number])
|
||||
(for/or ([idx (in-range (vector-length program-lines))])
|
||||
(and (= (car (vector-ref program-lines idx)) jump-number)
|
||||
idx)))
|
||||
(add1 program-counter))))))
|
||||
|
||||
(define #'(cr-line ARG ...) #'(begin ARG ...))
|
||||
|
||||
(define #'(line NUMBER STATEMENT ...)
|
||||
#'(cons NUMBER (λ _ STATEMENT ...)))
|
||||
|
||||
(define current-return-stack (make-parameter empty))
|
||||
|
||||
(define-cases #'line
|
||||
[#'(_ NUMBER (STATEMENT "GOSUB" WHERE)) #'(cons NUMBER
|
||||
(λ _
|
||||
(current-return-stack (cons NUMBER (current-return-stack)))
|
||||
(GOTO WHERE)))]
|
||||
[#'(_ NUMBER STATEMENT ...) #'(cons NUMBER (λ _ STATEMENT ...))])
|
||||
|
||||
(define vars (make-hasheq))
|
||||
|
||||
(define-cases #'statement
|
||||
[#'(statement ID "=" EXPR) #'(set! ID EXPR)]
|
||||
[#'(statement PROC ARG ...) #'(PROC ARG ...)])
|
||||
|
||||
(define-cases #'IF
|
||||
[#'(_ COND "THEN" TRUE-RESULT "ELSE" FALSE-RESULT)
|
||||
#'(if (true? COND)
|
||||
TRUE-RESULT
|
||||
FALSE-RESULT)]
|
||||
[#'(_ COND "THEN" TRUE-RESULT)
|
||||
#'(when (true? COND)
|
||||
TRUE-RESULT)])
|
||||
|
||||
(define-cases #'value
|
||||
[#'(value "(" EXPR ")") #'EXPR]
|
||||
[#'(value ID "(" ARG ... ")") #'(ID ARG ...)]
|
||||
[#'(value ID-OR-DATUM) #'ID-OR-DATUM])
|
||||
|
||||
(define-cases expr
|
||||
[(_ lexpr op rexpr) (if (op lexpr rexpr) 1 0)]
|
||||
[(_ expr) expr])
|
||||
(provide < > <= >=)
|
||||
(define true? (compose1 not zero?))
|
||||
|
||||
(define-cases #'expr
|
||||
[#'(_ LEXPR "AND" REXPR)
|
||||
#'(if (and (true? LEXPR) (true? REXPR)) 1 0)]
|
||||
[#'(_ LEXPR "OR" REXPR)
|
||||
#'(if (or (true? LEXPR) (true? REXPR)) 1 0)]
|
||||
[#'(_ EXPR) #'EXPR])
|
||||
|
||||
(define-cases #'comp-expr
|
||||
[#'(_ lexpr "=" rexpr) #'(comp-expr lexpr equal? rexpr)] ; special case because = is overloaded
|
||||
[#'(_ lexpr op rexpr) #'(if (op lexpr rexpr) 1 0)]
|
||||
[#'(_ expr) #'expr])
|
||||
(define (<> lexpr rexpr) (not (equal? lexpr rexpr)))
|
||||
(provide < > <= >= <>)
|
||||
|
||||
(define-cases sum
|
||||
[(_ term op sum) (op term sum)]
|
||||
|
|
@ -73,21 +99,46 @@
|
|||
(define (PRINT args)
|
||||
(match args
|
||||
[(list) (displayln "")]
|
||||
[(list print-list-item ... ";" pl) (begin (for-each display print-list-item) (PRINT pl))]
|
||||
[(list print-list-item ... ";") (for-each display print-list-item)]
|
||||
[(list print-list-item ... ";" pl) (begin (for-each display print-list-item)
|
||||
(display " ")
|
||||
(PRINT pl))]
|
||||
[(list print-list-item ... ";") (begin
|
||||
(for-each display print-list-item)
|
||||
(display " "))]
|
||||
[(list print-list-item ...) (for-each displayln print-list-item)]))
|
||||
|
||||
(define (TAB num) (make-string num #\space))
|
||||
(define (INT num) (inexact->exact (round num)))
|
||||
(define #'(INT EXPR ...) #'(inexact->exact (round (expr EXPR ...))))
|
||||
(define (SIN num) (sin num))
|
||||
(define (ABS num) (inexact->exact (abs num)))
|
||||
(define (RND num) (* (random) num))
|
||||
|
||||
(define #'(INPUT PRINT-LIST ";" ID)
|
||||
#'(begin
|
||||
(PRINT (append PRINT-LIST (list ";")))
|
||||
(set! ID (read-line))))
|
||||
(define-cases #'INPUT
|
||||
[#'(_ PRINT-LIST ";" ID)
|
||||
#'(begin
|
||||
(PRINT (append PRINT-LIST (list ";")))
|
||||
(INPUT ID))]
|
||||
[#'(_ ID) #'(set! ID (let* ([str (read-line)]
|
||||
[num (string->number str)])
|
||||
(if num num str)))])
|
||||
|
||||
(define (GOTO where)
|
||||
where)
|
||||
|
||||
(define (GOSUB where)
|
||||
where)
|
||||
|
||||
(define (RETURN)
|
||||
(define where (car (current-return-stack)))
|
||||
(current-return-stack (cdr (current-return-stack)))
|
||||
where)
|
||||
|
||||
|
||||
(struct exn:program-end exn:fail ())
|
||||
(define (END)
|
||||
(raise
|
||||
(exn:program-end
|
||||
"program ended"
|
||||
(current-continuation-marks))))
|
||||
|
||||
(define (comment . args) void)
|
||||
|
|
|
|||
5
beautiful-racket/br/demo/basic/gosub.bas
Normal file
5
beautiful-racket/br/demo/basic/gosub.bas
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
#lang br/demo/basic
|
||||
10 GOSUB 40
|
||||
11 END
|
||||
20 PRINT "YAY"
|
||||
25 RETURN
|
||||
|
|
@ -6,24 +6,30 @@ program : [line [CR line]*]
|
|||
line: INTEGER statement+
|
||||
|
||||
statement : "END"
|
||||
| "FOR" ID "=" expr "TO" expr ["STEP" expr]
|
||||
| "FOR" ID "=" expr "TO" expr ["STEP" expr]
|
||||
| "GOSUB" INTEGER
|
||||
| "GOTO" expr
|
||||
| "IF" expr "THEN" (statement | expr) ; change: add expr
|
||||
| "INPUT" print-list ";" ID
|
||||
| "IF" expr "THEN" (statement | expr) ["ELSE" (statement | expr)]; change: add expr
|
||||
| "INPUT" [print-list ";"] ID
|
||||
| ["LET"] ID "=" expr ; change: make "LET" opt
|
||||
| "NEXT" ID+
|
||||
| "PRINT" print-list
|
||||
| "RETURN"
|
||||
| REM-COMMENT
|
||||
|
||||
print-list : [expr [";" [print-list]]]
|
||||
|
||||
expr : sum [("=" | ">" | ">=" | "<" | "<=" | "<>") expr]
|
||||
expr : comp-expr [("AND" | "OR") expr]
|
||||
|
||||
comp-expr : sum [("=" | ">" | ">=" | "<" | "<=" | "<>") comp-expr]
|
||||
|
||||
sum : product [("+" | "-") sum]
|
||||
|
||||
product : value [("*" | "/") product]
|
||||
|
||||
value : ID ["(" expr* ")"]
|
||||
value : "(" expr ")"
|
||||
| ID
|
||||
| PROC "(" expr* ")"
|
||||
| INTEGER
|
||||
| STRING
|
||||
| REAL
|
||||
|
|
|
|||
|
|
@ -12,9 +12,10 @@
|
|||
[(:seq "REM" (repetition 1 +inf.0 (char-complement "\n")))
|
||||
(token 'REM-COMMENT (format-datum '(comment "~v") lexeme))]
|
||||
[(repetition 1 +inf.0 "\n") (token 'CR "cr")]
|
||||
[(union "PRINT" "FOR" "TO" "STEP" "IF" "THEN" "GOTO"
|
||||
"INPUT" "LET" "NEXT" "GOSUB" "RETURN"
|
||||
[(union "PRINT" "FOR" "TO" "STEP" "IF" "GOTO"
|
||||
"INPUT" "LET" "NEXT" "RETURN"
|
||||
"CLEAR" "LIST" "RUN" "END") (string->symbol lexeme)]
|
||||
[(union "THEN" "ELSE" "GOSUB") lexeme]
|
||||
|
||||
;; this only matches integers
|
||||
[(repetition 1 +inf.0 numeric) (token 'INTEGER (string->number lexeme))]
|
||||
|
|
@ -27,6 +28,7 @@
|
|||
[(union ";" "=" "(" ")") lexeme]
|
||||
[(union "+" "-" "*" "/"
|
||||
"<=" ">=" "<>" "><" "<" ">" "=" ) (string->symbol lexeme)]
|
||||
[(union "RND" "INT" "TAB" "SIN" "ABS") (token 'PROC (string->symbol lexeme))]
|
||||
[(:seq (repetition 1 +inf.0 upper-case) (:? "$")) (token 'ID (string->symbol lexeme))]
|
||||
[upper-case (token 'UPPERCASE (string->symbol lexeme))]
|
||||
[whitespace (token 'WHITESPACE lexeme #:skip? #t)]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user