diff options
| author |  Peter McGoron
| 2025-06-08 00:23:18 -0400 |
|---|---|---|
| committer | Peter McGoron
| 2025-06-08 00:23:18 -0400 |
| commit | ce82d10487a0a3496c3257aa674da1782b0f3703 (patch) | |
| tree | c1c491134ad5bbb0175396ccb78202d420956dba /RPS.scm | |
| parent | RPS interpreter (diff) | |
use the more tractable call/cc
Diffstat (limited to '')
| -rw-r--r-- | RPS.scm | 13 |
1 files changed, 9 insertions, 4 deletions
@@ -77,16 +77,17 @@ (vector? (RPScar source))) (interpret (cons (RPScar source) stack) (RPScdr source))) - ((eq? (RPScar source) 'push-cc) + ((eq? (RPScar source) 'call/cc) (let ((save-from-top (car stack)) (save-from-bottom (cadr stack)) - (rest-of-stack (cddr stack))) + (procedure (caddr stack)) + (rest-of-stack (cdddr stack))) (interpret (cons (continuation-invoker save-from-top save-from-bottom rest-of-stack (RPScdr source)) rest-of-stack) - (RPScdr source)))) + (RPScdr procedure)))) ((eq? (RPScar source) 'alloc) (let ((size (car stack))) (interpret (cons (make-vector size #f) (cdr stack)) @@ -139,6 +140,10 @@ (interpret (cdr stack) (RPScdr source))) ((eq? (RPScar source) 'dup) (interpret (cons (car stack) stack) (RPScdr source))) + ((eq? (RPScar source) 'eqv?) + (let ((x (car stack)) + (y (cadr stack))) + (interpret (cons (eqv? x y) stack) (RPScdr source)))) (else (error "invalid source" stack source))))) @@ -150,4 +155,4 @@ (interpret '() source)))) (pp (interpret-datum - '(#f 0 0 push-cc #f 1 dig (() #t #t #f #f 3 dig jump) (() drop "call cc in FORTH!") if))) + '((() dup #f #f 1 dig 2 #f 1 dig jump) 0 0 call/cc (() #t 1 #f 2 dig jump) (() "call/cc in FORTH!") if))) |