use the more tractable call/cc

2 files changed, 26 insertions, 15 deletions

diff --git a/README.md b/README.md
index 1f085b1..7db8e1a 100644
--- a/README.md
+++ b/README.md
@@ -1,8 +1,10 @@
 # Reverse Polish Scheme
 
-A continuation-passing-style stack-based programming language vaguely
-based off of FORTH but really just Scheme in disguise. With the exception
-of quotation (which is syntax), everything is RPN.
+A stack-based programming language vaguely based off of FORTH but
+really just Scheme in disguise. With the exception of quotation (which
+is syntax), everything is RPN. There are only jumps in this language:
+in order to return from a procedure, you need to capture the current
+continuation and pass it to the procedure.
 
 ## Core
 
@@ -13,7 +15,7 @@ is the name of a value, NOT the symbol `"nil"`!
 A linked list is a 2-vector whose second pair is either `#nil` or
 another linked list.
 
-A subroutine is a linked list whose first slot is unused and whose code
+A procedure is a linked list whose first slot is unused and whose code
 starts in the second slot.
 
 * `n alloc`: Allocate a memory region of `n` pointers.
@@ -21,17 +23,18 @@ starts in the second slot.
   is stored as a linked list.
 * `n v ref`: Get the nth element of `v`.
 * `value n v set!`: Set the nth element of `v`.
-* `sr jump`: Jump to a subroutine.
+* `sr jump`: Jump to a procedure.
 * `conditional on-false on-true if`: If `conditional` is truthy, jump
   to `on-true`. Otherwise jump to `on-false`.
-* `keep-bot keep-top push-cc`: Push the *continuation* of the call to
-  `push-cc`. The continuation object saves the last `keep-top` objects
-  on the stack along with the bottom `keep-bot` values on the stack. If
-  either is `#f`, then the entire stack is saved.
+* `proc keep-bot keep-top call/cc`: Jump to `proc` with the continuation
+  pushed to the stack. The continuation object saves the last `keep-top`
+  objects on the stack along with the bottom `keep-bot` values on the
+  stack. If either is `#f`, then the entire stack is saved.
 
   When `m cc jump` is called (where `cc` is the object returned by
-  `push-cc`), the `m` values currently on the stack are pushed to the top
-  of `n` values saved by `cc`, and control returns to the next location.
+  `call/cc`), the `m` values currently on the stack are pushed to the top
+  of `n` values saved by `cc`, and control returns to the next location
+  after `call/cc`.
 * `dir? n dig`: When `dir?` is false, move the `n`th value relative to the
   top of the stack to the top of the stack. When `dir?` is true, move the
   `n`th value relative to the bottom of the stack to the top of the stack.
@@ -39,3 +42,6 @@ starts in the second slot.
   the `n`th value relative to the top of the stack. When `dir?` is true,
   move the top of the stack to `n`th value relative to the bottom of
   the stack.
+* `dup`: Duplicate the top of the stack. This is a shallow copy.
+* `drop`: Drop the top of the stack.
+* `x y eqv?`: Compare two values on the top of the stack, returns a boolean.
diff --git a/RPS.scm b/RPS.scm
index 05568ca..14ffca5 100644
--- a/RPS.scm
+++ b/RPS.scm
@@ -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)))