diff --git a/Library.hs b/Library.hs
--- a/Library.hs
+++ b/Library.hs
@@ -19,7 +19,7 @@
 along with haskeem; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-$Id: library.hs,v 1.33 2009-07-04 02:48:29 uwe Exp $ -}
+$Id: library.hs,v 1.37 2009-07-27 02:01:04 uwe Exp $ -}
 
 module Library (primitiveBindings, delayCounter, symbolCounter, loadFile, eqv)
   where
@@ -38,6 +38,7 @@
 import System.Time
 import System.CPUTime
 import System.Random
+import System.Process
 import qualified Data.IntMap as DIM
 import Network
 
@@ -160,6 +161,10 @@
   if n < 0 then return lispTrue else return lispFalse
 isNegative _ = return lispFalse
 
+isPromise :: [LispVal] -> ThrowsError LispVal
+isPromise [Delay _ _ _] = return lispTrue
+isPromise _ = return lispFalse
+
 -- The treatment of Inf and NaN is not quite according to R6RS here.  they say
 -- (/ 1 0) causes an exception, but I can't find what happens if the parser
 -- sees the number 1/0. I think it ought to be Inf, or perhaps RatInf. So I'm
@@ -662,6 +667,14 @@
 symb2str [Symbol s] = return (String s)
 symb2str badArgList = genericBadArg badArgList "symbol->string" "string" 1
 
+str2symb :: [LispVal] -> ThrowsError LispVal
+str2symb [String []] = genericBadArg [String ""] "string->symbol" "string" 1
+str2symb [String s] = return (Symbol (sanitize s))
+  where sanitize (c:cs) = schar isAlpha c : map (schar isAlphaNum) cs
+        schar pred c =
+          if (pred c) || (c `elem` specialSymbolChars) then c else '_'
+str2symb badArgList = genericBadArg badArgList "string->symbol" "string" 1
+
 readNum :: [LispVal] -> ThrowsError LispVal
 readNum [String s] = readNumber s
 readNum badArgList = genericBadArg badArgList "string->number" "string" 1
@@ -977,6 +990,7 @@
               ("null?", isNull),
               ("port?", isPort),
               ("procedure?", isProcedure),
+              ("promise?", isPromise),
               ("vector?", isVector),
               ("even?", lispIsEven),
               ("odd?", lispIsOdd),
@@ -1003,6 +1017,7 @@
               ("string->number", readNum),
               ("number->string", writeNum),
               ("symbol->string", symb2str),
+              ("string->symbol", str2symb),
               ("char-alphabetic?", charIs isAlpha),
               ("char-numeric?", charIs isDigit),
               ("char-oct-digit?", charIs isOctDigit),
@@ -1143,7 +1158,7 @@
 lispPutStr :: [LispVal] -> IOThrowsError LispVal
 lispPutStr [] = return lispFalse
 lispPutStr ((Port port):rest) =
-  mapM outStr rest >> return lispTrue
+  mapM_ outStr rest >> return lispTrue
   where outStr (String s) = doIOAction (hPutStr port s) dropToBool allErrs
         outStr (Char c) = doIOAction (hPutChar port c) dropToBool allErrs
         outStr notS = genericIOBadArg [notS] "write-string" "string" 1
@@ -1512,6 +1527,52 @@
 lispSetNoBuf badArgList =
   genericIOBadArg badArgList "set-no-buffering!" "port" 1
 
+-- Old version that was just one argument, no optional working directory
+-- lispRunCmd :: [LispVal] -> IOThrowsError LispVal
+-- lispRunCmd [String cmd] =
+--   doIOAction (system cmd) getStatus allErrs
+--   where getStatus (ExitSuccess) = IntNumber 0
+--         getStatus (ExitFailure n) = IntNumber (fromIntegral n)
+-- lispRunCmd badArgList =
+--   genericIOBadArg badArgList "run-command" "command" 1
+
+lispRunCmd :: [LispVal] -> IOThrowsError LispVal
+lispRunCmd [String cmd] = lispRunCmd [String cmd, String ""]
+lispRunCmd [String cmd, String dir] =
+  do ret <- liftIO (try (createProcess (shell cmd)
+                           { cwd = if dir /= "" then Just dir else Nothing }))
+     case ret of
+          Left err -> throwError (Default (show err))
+          Right _ -> return lispTrue
+lispRunCmd badArgList =
+  genericIOBadArg badArgList "run-command" "command+dir" 2
+
+lispReadCmd :: [LispVal] -> IOThrowsError LispVal
+lispReadCmd [String cmd] = lispReadCmd [String cmd, String ""]
+lispReadCmd [String cmd, String dir] =
+  do ret <- liftIO (try (createProcess (shell cmd)
+                           { cwd = if dir /= "" then Just dir else Nothing,
+                             std_out = CreatePipe }))
+     case ret of
+          Left err -> throwError (Default (show err))
+          Right val -> return (Port (val2 val))
+  where val2 (_, Just hout, _, _) = hout
+lispReadCmd badArgList =
+  genericIOBadArg badArgList "run-read-command" "command+dir" 2
+
+lispWriteCmd :: [LispVal] -> IOThrowsError LispVal
+lispWriteCmd [String cmd] = lispWriteCmd [String cmd, String ""]
+lispWriteCmd [String cmd, String dir] =
+  do ret <- liftIO (try (createProcess (shell cmd)
+                           { cwd = if dir /= "" then Just dir else Nothing,
+                             std_in = CreatePipe }))
+     case ret of
+          Left err -> throwError (Default (show err))
+          Right val -> return (Port (val1 val))
+  where val1 (Just hin, _, _, _) = hin
+lispWriteCmd badArgList =
+  genericIOBadArg badArgList "run-write-command" "command+dir" 2
+
 ioPrimitives :: [(String, [LispVal] -> IOThrowsError LispVal)]
 ioPrimitives = [("open-input-file", makePort ReadMode),
                 ("open-output-file", makePort WriteMode),
@@ -1563,7 +1624,10 @@
                 ("set-no-buffering!", lispSetNoBuf),
                 ("connect-to", lispConnectTo),
                 ("listen-on", lispListenOn),
-                ("accept", lispAccept)]
+                ("accept", lispAccept),
+                ("run-command", lispRunCmd),
+                ("run-read-command", lispReadCmd),
+                ("run-write-command", lispWriteCmd)]
 
 -- A couple of predefined data values
 
diff --git a/Parser.hs b/Parser.hs
--- a/Parser.hs
+++ b/Parser.hs
@@ -19,9 +19,9 @@
 along with haskeem; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-$Id: parser.hs,v 1.14 2009-06-27 20:31:52 uwe Exp $ -}
+$Id: parser.hs,v 1.15 2009-07-27 02:01:04 uwe Exp $ -}
 
-module Parser (readExpr, readExprList, readNumber) where
+module Parser (readExpr, readExprList, readNumber, specialSymbolChars) where
 import Prelude
 import Data.Char
 import Data.Ratio
@@ -56,8 +56,10 @@
 
 -- This is not quite R6RS-compliant: R6RS allows '.'
 
+specialSymbolChars = "!$%&*+-/:<=>?@^_~"
+
 symbol :: Parser Char
-symbol = oneOf "!$%&*+-/:<=>?@^_~"
+symbol = oneOf specialSymbolChars
 
 -- This is a small extension to R6RS
 
diff --git a/callcc.scm b/callcc.scm
new file mode 100644
--- /dev/null
+++ b/callcc.scm
@@ -0,0 +1,36 @@
+; Copyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>
+; $Id: callcc.scm,v 1.2 2009-07-11 03:59:28 uwe Exp $
+; BSD3
+
+; "poor man's" continuations: one-shot, limited lifespan, and while they
+; are nestable, if you activate an outer one, any inner ones get consumed
+
+(define (call/cc1 func)
+  (let* ((sym (gensym))
+	 (cont (lambda (ret) (raise (cons sym ret)))))
+    (guard
+     (err ((and (pair? err) (eqv? sym (car err)))
+	   (cdr err)))
+     (func cont))))
+
+(defmacro (let/cc1 k . body)
+  `(call/cc1 (lambda (,k) ,@body)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; some tests
+
+(define (f1 n)
+  (+ 10 (* 5 (/ 1 n))))
+
+(define (f2 n)
+  (+ 10 (* 5 (call/cc1
+	      (lambda (k)
+		(/ 1 (if (zero? n)
+			 (k 1)
+			 n)))))))
+
+(define (f3 n)
+  (+ 10 (* 5 (let/cc1 k
+		      (/ 1 (if (zero? n)
+			       (k 1)
+			       n))))))
diff --git a/choice.scm b/choice.scm
new file mode 100644
--- /dev/null
+++ b/choice.scm
@@ -0,0 +1,80 @@
+; Copyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>
+; $Id: choice.scm,v 1.2 2009-07-11 04:32:54 uwe Exp $
+; BSD3
+
+; Non-deterministic programming: my version of (amb) with slightly different
+; names, except this is more limited in that I can't call (fail) arbitrarily
+; far into the future.
+
+; Still TODO: make it work with streams as well as lists: that means that in
+; the call to (,loop (cdr ,chs)) near the bottom of the macro, we might need
+; to force a promise. ----> TODO^2: need to be able to query if something is
+; a promise: write (promise?) primitive
+
+; With streams, there is the issue that an infinite stream locks in all the
+; previous choices, since this stuff does things in order from innermost to
+; outermost: if an inner set of alternatives is infinite, it'll take infinite
+; time to explore it all.
+
+; Stack of escapers for the different choices
+
+(define *choice-stack* (make-stack))
+(define *choice-fail* (gensym))
+
+; This function rejects the current set of choices: it pops the top
+; escaper off the stack, then calls it with the failure symbol as its
+; arg.  The failure symbol is gensym'ed, so it can't be generated by
+; the user; so there is no worry about collisions with something the
+; user might want to return.
+
+(define (bad-choice)
+  (if (*choice-stack* 'empty?)
+      (raise "All out of choices!")
+      ((*choice-stack* 'pop) *choice-fail*)))
+
+; This macro does the binding of the variable sym to one of the choices given,
+; then executes the body. If the body calls (bad-choice), this loops to the
+; next choice. If the current set of choices is exhausted, the next-lower
+; choice gets reset, and so on, until we run out of choices, in which case
+; the (bad-choice) function raises an(other) exception.
+
+(defmacro (let-choice sym choices . body)
+  (let ((ret (gensym))
+	(cont (gensym))
+	(chs (gensym))
+	(loop (gensym)))
+    `(letrec* ((,loop (lambda (,chs)
+			(if (null? ,chs)
+			    (bad-choice)
+			    (let* ((,sym (car ,chs))
+				   (,ret (let/cc1 ,cont
+					   (*choice-stack* 'push ,cont)
+					   ,@body)))
+			      (if (eqv? ,ret *choice-fail*)
+				  (,loop (cdr ,chs))
+				  (begin (*choice-stack* 'pop)
+					 ,ret)))))))
+	      (,loop ,choices))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; Some simple examples
+
+(define (require pred?) (if (not pred?) (bad-choice)))
+
+(define (parlor-trick n)
+  (let-choice j '(1 2 3 4 5)
+    (let-choice i '(1 2 3 4 5)
+      (require (= (+ i j) n))
+      (list i j))))
+
+(display (parlor-trick 4))
+(newline)
+
+(display (parlor-trick 6))
+(newline)
+
+(display (parlor-trick 10))
+(newline)
+
+(display (parlor-trick 11))
+(newline)
diff --git a/delcont.scm b/delcont.scm
new file mode 100644
--- /dev/null
+++ b/delcont.scm
@@ -0,0 +1,116 @@
+; Copyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>
+; $Id: delcont.scm,v 1.14 2009-08-02 03:18:24 uwe Exp $
+; BSD3
+
+; Delimited continuations: these look simpler than call/cc, just a fairly
+; simple code transformation. This code implements that code transformation,
+; however it's not quite full-strength: in real code, the (shift) could be
+; hidden inside a function, and in that case this version would not work. But
+; for reset/shift that's all visible in one s-expr, I think this does pretty
+; much the right thing.
+
+; From CC Shan, "Shift to Control"
+
+; M[(reset V)] -> M[V]
+
+; M[(reset C [(shift f E)])] -> M[(reset E')]
+; where E' = E{f -> (lambda (x) (reset C[x]))}
+
+; M[(reset C [(control f E)])] -> M[(reset E')]
+; where E' = E{f -> (lambda (x) C[x])}
+
+; M[(reset C [(shift0 f E)])] -> M[E']
+; where E' = E{f -> (lambda (x) (reset C[x]))}
+
+; M[(reset C [(control0 f E)])] -> M[E']
+; where E' = E{f -> (lambda (x) C[x])}
+
+; TODO: the multiple-expressions handling in reset and int-s/c is
+; seriously hacky: reset just wraps its args in a '(begin ...) if
+; there are multiple args... gotta be a better way to do that?
+; Still, this works and allows testing.
+
+(define *delcont-list* '())
+
+(defmacro (reset . expr)
+  (letrec* ((id (gensym))
+	    (ret (gensym))
+	    (err (gensym))
+	    (flag #f)
+	    (elist (cond ((null? expr) '())
+			 ((null? (cdr expr)) (car expr))
+			 (else (cons 'begin expr))))
+	    (r-aux (lambda (ex)
+		     (cond ((not (list? ex)) ex)
+			   ((null? ex) ex)
+			   ((or (eqv? 'shift (car ex))
+				(eqv? 'shift0 (car ex))
+				(eqv? 'control (car ex))
+				(eqv? 'control0 (car ex)))
+			    (let ((f1 (or (eqv? 'shift (car ex))
+					  (eqv? 'shift0 (car ex))))
+				  (f2 (or (eqv? 'shift (car ex))
+					  (eqv? 'control (car ex)))))
+			      (set! flag #t)
+			      (if (and (> (length ex) 2)
+				       (symbol? (cadr ex)))
+				  (append (list 'int-s/c id (gensym) f1 f2)
+					  (r-aux (cdr ex)))
+				  (raise
+				   "malformed shift/control expression!" ex))))
+			   ((eqv? 'int-s/c (car ex))
+			    (set! flag #t)
+			    (append (list 'int-s/c id) (cddr ex)))
+			   (else (map r-aux ex)))))
+	    (ex (r-aux elist)))
+    (if flag
+	(begin
+	  (set! *delcont-list* (cons ex *delcont-list*))
+	  `(let ((,ret (guard
+			(,err ((and (pair? ,err) (eqv? ',id (car ,err)))
+			       (cadr ,err)))
+			,ex)))
+	     (set! *delcont-list* (cdr *delcont-list*))
+	     ,ret))
+	elist)))
+
+(defmacro (int-s/c mark id f1 f2 name . expr)
+  (letrec* ((var (gensym))
+	    (s-aux (lambda (ex)
+		     (cond ((not (list? ex)) ex)
+			   ((null? ex) ex)
+			   ((eqv? 'int-s/c (car ex))
+			    (if (eqv? id (caddr ex))
+				var
+				ex))
+			   (else (map s-aux ex)))))
+	    (subst-expr (lambda (ex)
+			  (let ((body (s-aux ex)))
+			    (if f1
+				`(lambda (,var) (reset ,body))
+				`(lambda (,var) ,body)))))
+	    (lam-ex (subst-expr (car *delcont-list*))))
+    (if f2
+	`(raise ',mark (let ((,name ,lam-ex)) (reset ,@expr)))
+	`(raise ',mark (let ((,name ,lam-ex)) ,@expr)))))
+
+; aliases -- in this macro-based approach, they should be just sugar
+
+(define reset0 reset)
+(define prompt reset)
+(define prompt0 reset)
+
+; stupid-catchers
+
+(defmacro (shift sym expr)
+  (raise "oops, naked delcont form" 'shift sym expr))
+
+(defmacro (shift0 sym expr)
+  (raise "oops, naked delcont form" 'shift0 sym expr))
+
+(defmacro (control sym expr)
+  (raise "oops, naked delcont form" 'control sym expr))
+
+(defmacro (control0 sym expr)
+  (raise "oops, naked delcont form" 'control0 sym expr))
+
diff --git a/deltest.scm b/deltest.scm
new file mode 100644
--- /dev/null
+++ b/deltest.scm
@@ -0,0 +1,582 @@
+; (load "delcont.scm")
+
+(defmacro (sandbox . expr)
+  (let ((err (gensym)))
+    `(guard
+      (,err ((begin (write-string "caught exception '")
+		    (display ,err)
+		    (write-string "'\n")
+		    #t)))
+      ,@expr)))
+
+; for mzscheme, replace the above definition of sandbox with
+;	(define (sandbox . expr) #t)
+; it won't catch exceptions, but then mzscheme doesn't produce
+; any, except for the intentional syntax error at the end
+
+(write-string "all answers are checked against mzscheme\n")
+
+(write-string "examples from community.schemewiki.org\n")
+
+(write-string "should be 6\t\t")
+(display (+ 1 (reset (+ 2 3))))
+(newline)
+
+(write-string "should be (1 2)\t\t")
+(display (cons 1 (reset (cons 2 '()))))
+(newline)
+
+(write-string "should be 4\t\t")
+(display (+ 1 (reset (+ 2 (shift k 3)))))
+(newline)
+
+(write-string "should be (1 3)\t\t")
+(display (cons 1 (reset (cons 2 (shift k (cons 3 '()))))))
+(newline)
+
+(write-string "should be 10\t\t")
+(display (+ 1 (reset (+ 2 (shift k (+ 3 (k 4)))))))
+(newline)
+
+(write-string "should be 14\t\t")
+(display (+ 1 (reset (+ 2 (shift k (+ 3 (k 5) (k 1)))))))
+(newline)
+
+(write-string "should be (1 3 2 4)\t")
+(display (cons 1 (reset (cons 2 (shift k (cons 3 (k (cons 4 '()))))))))
+(newline)
+
+(write-string "should be (1 3 2 2 4)\t")
+(display (cons 1 (reset (cons 2 (shift k (cons 3 (k (k (cons 4 '())))))))))
+(newline)
+
+(write-string "multiple shifts\n")
+
+(write-string "should be 2\t\t")
+(reset (display (begin (shift k1 (k1 1)) (shift k2 (k2 2)))))
+(newline)
+
+; haskeem fails this -- restart issue
+(write-string "should be 12\t\t")
+(reset (begin (display (shift k1 (k1 1))) (display (shift k2 (k2 2)))))
+(newline)
+
+(write-string "should be 12\t\t")
+(reset (display (shift k1 (k1 1))) (display (shift k2 (k2 2))))
+(newline)
+
+(write-string "should be 134234\t")
+(reset0 (begin (shift0 k1 (begin (k1 (display 1)) (k1 (display 2))))
+	       (shift0 k2 (begin (k2 (display 3)) (k2 (display 4))))))
+(newline)
+
+(write-string "should be 134234\t")
+(reset0 (begin (shift0 k1 (k1 (display 1)) (k1 (display 2)))
+	       (shift0 k2 (k2 (display 3)) (k2 (display 4)))))
+(newline)
+
+(write-string "should be 134234\t")
+(reset0 (shift0 k1 (k1 (display 1)) (k1 (display 2)))
+	(shift0 k2 (k2 (display 3)) (k2 (display 4))))
+(newline)
+
+(write-string "should be 13564562356456\n\t  ")
+(reset0 (begin (shift0 k1 (begin (k1 (display 1)) (k1 (display 2))))
+	       (shift0 k2 (begin (k2 (display 3)) (k2 (display 4))))
+	       (shift0 k3 (begin (k3 (display 5)) (k3 (display 6))))))
+(write-string "\n\t  ")
+(reset0 (begin (shift0 k1 (k1 (display 1)) (k1 (display 2)))
+	       (shift0 k2 (k2 (display 3)) (k2 (display 4)))
+	       (shift0 k3 (k3 (display 5)) (k3 (display 6)))))
+(write-string "\n\t  ")
+(reset0 (shift0 k1 (k1 (display 1)) (k1 (display 2)))
+	(shift0 k2 (k2 (display 3)) (k2 (display 4)))
+	(shift0 k3 (k3 (display 5)) (k3 (display 6))))
+(newline)
+
+(write-string "should be 57\t\t")
+(display (+ 1 (reset (+ 2 (shift k1 (+ 3
+				       (k1 5)
+				       (k1 1)
+				       (reset (* 10 (shift k2 (+ 3 (k2 4)))))
+				       ))))))
+(newline)
+
+(write-string "should be 59\t\t")
+(display (+ 1 (reset (+ 2 (shift k1 (+ 3
+				       (k1 5)
+				       (k1 1)
+				       (reset (* 10 (shift k2 (+ (k1 3)
+								 (k2 4)))))
+				       ))))))
+(newline)
+
+; haskeem fails the following nine -- restart issue
+
+(write-string "should be 1 3 2\t\t")
+(reset (begin (write-string "1 ")
+	      (shift c (begin (c 'ignore)
+			      (write-string "2 ")))
+	      (write-string "3 ")))
+(newline)
+(write-string "should be 1 3 2\t\t")
+(reset (begin (write-string "1 ")
+	      (shift c (c 'ignore) (write-string "2 "))
+	      (write-string "3 ")))
+(newline)
+(write-string "should be 1 3 2\t\t")
+(reset (write-string "1 ")
+       (shift c (c 'ignore) (write-string "2 "))
+       (write-string "3 "))
+(newline)
+
+(write-string "should be 1 2 3\t\t")
+(reset (begin (write-string "1 ")
+	      (shift c (begin (write-string "2 ")
+			      (c 'ignore)))
+	      (write-string "3 ")))
+(newline)
+(write-string "should be 1 2 3\t\t")
+(reset (begin (write-string "1 ")
+	      (shift c (write-string "2 ") (c 'ignore))
+	      (write-string "3 ")))
+(newline)
+(write-string "should be 1 2 3\t\t")
+(reset (write-string "1 ")
+       (shift c (write-string "2 ") (c 'ignore))
+       (write-string "3 "))
+(newline)
+
+(write-string "should be 1 3 2 3\t")
+(reset (begin (write-string "1 ")
+	      (shift c (begin (c 'ignore)
+			      (write-string "2 ")
+			      (c 'ignore)))
+	      (write-string "3 ")))
+(newline)
+(write-string "should be 1 3 2 3\t")
+(reset (begin (write-string "1 ")
+	      (shift c (c 'ignore) (write-string "2 ") (c 'ignore))
+	      (write-string "3 ")))
+(newline)
+(write-string "should be 1 3 2 3\t")
+(reset (write-string "1 ")
+       (shift c (c 'ignore) (write-string "2 ") (c 'ignore))
+       (write-string "3 "))
+(newline)
+
+(write-string "from Shan, \"Shift to Control\"\n")
+
+(write-string "should be (a)\t\t")
+(display (reset (cons 'a (reset (shift f (shift g '()))))))
+(newline)
+
+(write-string "should be ()\t\t")
+(display (reset0 (cons 'a (reset0 (shift0 f (shift0 g '()))))))
+(newline)
+
+(write-string "should be (a)\t\t")
+(display (reset (let ((y (shift f (cons 'a (f '()))))) (shift g y))))
+(newline)
+
+(write-string "should be ()\t\t")
+(display (prompt (let ((y (control f (cons 'a (f '()))))) (control g y))))
+(newline)
+
+; Shan sez this is an infinite loop... Kiselyov turns this into a printing
+; loop by adding (display) somewhere, have to see if I can replicate that.
+; I dunno if the name has to be 'f' in both control parts
+
+;(prompt (begin (control f (begin (f 0) (f 0)))
+;	       (control f (begin (f 0) (f 0)))))
+
+;;;(write-string "should be 132342344234442344442344444234444442344...\n\t  ")
+;;; with reset2 it /is/ an infinite loop, just not the desired one...
+;;; it produces 1313131313... instead
+;;; I think this is actually the same partially-evaluated-thunk issue
+;;; as with the other tests which are failing
+;;;(prompt (begin (control f (begin (f (display 1)) (f (display 2))))
+;;;	      (control f (begin (f (display 3)) (f (display 4))))))
+;;;(newline)
+
+(write-string "should be (a)\t\t")
+(display (reset (let ((y (shift f (cons 'a (f '()))))) (shift g y))))
+(newline)
+
+(write-string "should be (a)\t\t")
+(display (reset0 (let ((y (shift0 f (cons 'a (f '()))))) (shift0 g y))))
+(newline)
+
+(write-string "should be ()\t\t")
+(display (prompt (let ((y (control f (cons 'a (f '()))))) (control g y))))
+(newline)
+
+(write-string "should be ()\t\t")
+(display
+ (reset (prompt0 (let ((y (control0 f (cons 'a (f '()))))) (control0 g y)))))
+(newline)
+
+(write-string "should be (a b)\t\t")
+(display
+ (reset
+  (reset (cons 'a (reset
+		   (let ((y (shift f (shift g (cons 'b (f '()))))))
+		     (shift h y)))))))
+(newline)
+
+(write-string "should be (a)\t\t")
+(display
+ (prompt
+  (prompt (cons 'a (prompt
+		    (let ((y (control f (control g (cons 'b (f '()))))))
+		      (control h y)))))))
+(newline)
+
+(write-string "should be (b)\t\t")
+(display
+ (reset0
+  (reset0 (cons 'a (reset0
+		    (let ((y (shift0 f (shift0 g (cons 'b (f '()))))))
+		      (shift0 h y)))))))
+(newline)
+
+; haskeem fails this -- UNKNOWN ISSUE! TODO: investigate!
+
+(write-string "should be ()\t\t")
+(display
+ (prompt0
+  (prompt0 (cons 'a (prompt0
+		     (let ((y (control0 f (control0 g (cons 'b (f '()))))))
+		       (control0 h y)))))))
+(newline)
+
+(write-string "two-armed tests\n")
+(write-string "test 1: non-trivial shift only in false arm of if\n")
+(define (doit1 flag)
+  (if flag
+      (write-string "should be (1 3)\t\t")
+      (write-string "should be (1 4 2 5)\t"))
+  (display
+   (cons 1 (reset (cons 2 (if flag
+			      (shift k1 (cons 3 '()))
+			      (shift k2 (cons 4 (k2 (cons 5 '())))))))))
+  (newline))
+
+(doit1 #f)
+(doit1 #t)
+
+(write-string "test 2: reverse of previous\n")
+(define (doit2 flag)
+  (if flag
+      (write-string "should be (1 4 2 5)\t")
+      (write-string "should be (1 3)\t\t"))
+  (display
+   (cons 1 (reset (cons 2 (if flag
+			      (shift k2 (cons 4 (k2 (cons 5 '()))))
+			      (shift k1 (cons 3 '())))))))
+  (newline))
+
+(doit2 #f)
+(doit2 #t)
+
+(write-string "test 3: wrong? expansion of test 1\n")
+
+(define (doit3 flag)
+  (write-string "should be (1 4 3)\t")	; independent of flag
+  (display
+   (cons 1
+	 (let ((k2 (lambda (v2)
+		     (let ((k1 (lambda (v1)
+				 (reset (cons 2 (if flag v1 v2))))))
+		       (cons 3 '()))
+		     )))
+	   (reset (cons 4 (k2 (cons 5 '())))))))
+  (newline))
+
+(doit3 #f)
+(doit3 #t)
+
+(write-string "test 4: expansion of test 2\n")
+(define (doit4 flag)
+  (if flag
+      (write-string "should be (1 4 2 3)\t")
+      (write-string "should be (1 4 2 5)\t"))
+  (display
+   (cons 1
+	 (let ((k2 (lambda (v2)
+		     (reset (cons 2 (if flag (cons 3 '()) v2))))))
+	   (reset (cons 4 (k2 (cons 5 '())))))
+	 ))
+  (newline))
+
+(doit4 #f)
+(doit4 #t)
+
+(write-string "test 5: modified version, with (shift) in both arms of (if)\n")
+(define (doit5 flag)
+  (if flag
+      (write-string "should be (1 3 2 4)\t")
+      (write-string "should be (1 5 2 6)\t"))
+  (display
+   (cons 1
+	 (reset (cons 2 (if flag
+			    (shift k1 (cons 3 (k1 (cons 4 '()))))
+			    (shift k2 (cons 5 (k2 (cons 6 '())))))))))
+  (newline))
+
+(doit5 #f)
+(doit5 #t)
+
+; This one seems to be right either way... had to lift the (if flag)
+; outside the (reset), which seems both intuitive and counter-intuitive.
+; :-/
+
+(write-string
+ "test 6: modified version of test 5, with (if) lifted out of (reset)\n")
+
+(define (doit6 flag)
+  (if flag
+      (write-string "should be (1 3 2 4)\t")
+      (write-string "should be (1 5 2 6)\t"))
+  (display
+   (cons 1
+	 (if flag
+	     (reset (cons 2 (shift k1 (cons 3 (k1 (cons 4 '()))))))
+	     (reset (cons 2 (shift k2 (cons 5 (k2 (cons 6 '())))))))))
+  (newline))
+
+(doit6 #f)
+(doit6 #t)
+
+(write-string "examples from Queinnec, augmented to test all versions\n")
+
+(write-string "prompt/control examples\n")
+(write-string "should be 3\t\t")
+(display (prompt (* 2 (control f 3))))
+(newline)
+
+(write-string "should be 30\t\t")
+(display (prompt (* 2 (control f (* 5 (f 3))))))
+(newline)
+
+(write-string "should be 12\t\t")
+(display (prompt (* 2 (control f (f (f 3))))))
+(newline)
+
+(write-string "should be 6\t\t")
+(display ((prompt (* 2 (control f f))) 3))
+(newline)
+
+(write-string "should be 35\t\t")
+(display (prompt (* 5
+		    (prompt (* 2
+			       (control f2 (* 3 (control f3 7))))))))
+(newline)
+
+; haskeem quasi-fails this: because it's a (lambda () ...), it escapes,
+; and so at the end there's an uncaught exception which however carries
+; along the correct value as its payload. So I think haskeem would handle
+; this correctly if there were an implicit top-level catcher
+
+(write-string "should be 7\t\t")
+(sandbox
+ (display (prompt (* 5 (
+			(prompt (* 2
+				   (control f2 (lambda ()
+						 (* 3 (control f3 7))))))))))
+ (newline))
+
+(write-string "should be 21\t\t")
+(display (prompt (* 5
+		    ((lambda (x) (control f1 x))
+		     (* 3 (control f2 (* 2 (f2 7))))))))
+(newline)
+
+(write-string "prompt0/control0 examples\n")
+(write-string "should be 3\t\t")
+(display (prompt0 (* 2 (control0 f 3))))
+(newline)
+
+(write-string "should be 30\t\t")
+(display (prompt0 (* 2 (control0 f (* 5 (f 3))))))
+(newline)
+
+(write-string "should be 12\t\t")
+(display (prompt0 (* 2 (control0 f (f (f 3))))))
+(newline)
+
+(write-string "should be 6\t\t")
+(display ((prompt0 (* 2 (control0 f f))) 3))
+(newline)
+
+(write-string "should be 7\t\t")
+(display (prompt0 (* 5
+		    (prompt0 (* 2
+			       (control0 f2 (* 3 (control0 f3 7))))))))
+(newline)
+
+(write-string "should be 7\t\t")
+(sandbox
+ (display (prompt0 (* 5 (
+			(prompt0 (* 2
+				   (control0 f2 (lambda ()
+						 (* 3 (control0 f3 7))))))))))
+ (newline))
+
+; There's something odd with this test: in mzscheme, it prints the
+; result 21, then the whole rest of the test vanishes; apparently
+; enough of the surrounding context is sucked up that the rest of the
+; world just vanishes. If I surround this with a (reset ...), the
+; test continues, but this doesn't print anything. Hmmm!
+
+(write-string "should be 21\t\t")
+(sandbox
+ (display (prompt0 (* 5
+		      ((lambda (x) (control0 f1 x))
+		       (* 3 (control0 f2 (* 2 (f2 7))))))))
+ (newline))
+
+(write-string "reset/shift examples\n")
+(write-string "should be 3\t\t")
+(display (reset (* 2 (shift f 3))))
+(newline)
+
+(write-string "should be 30\t\t")
+(display (reset (* 2 (shift f (* 5 (f 3))))))
+(newline)
+
+(write-string "should be 12\t\t")
+(display (reset (* 2 (shift f (f (f 3))))))
+(newline)
+
+(write-string "should be 6\t\t")
+(display ((reset (* 2 (shift f f))) 3))
+(newline)
+
+(write-string "should be 35\t\t")
+(display (reset (* 5
+		   (reset (* 2
+			     (shift f2 (* 3 (shift f3 7))))))))
+(newline)
+
+; haskeem quasi-fails this: because it's a (lambda () ...), it escapes,
+; and so at the end there's an uncaught exception which however carries
+; along the correct value as its payload. So I think haskeem would handle
+; this correctly if there were an implicit top-level catcher
+
+(write-string "should be 7\t\t")
+(sandbox
+ (display (reset (* 5 (
+		       (reset (* 2
+				 (shift f2 (lambda ()
+					     (* 3 (shift f3 7))))))))))
+ (newline))
+
+(write-string "should be 42\t\t")
+(display (reset (* 5
+		   ((lambda (x) (shift f1 x))
+		    (* 3 (shift f2 (* 2 (f2 7))))))))
+(newline)
+
+(write-string "reset0/shift0 examples\n")
+(write-string "should be 3\t\t")
+(display (reset0 (* 2 (shift0 f 3))))
+(newline)
+
+(write-string "should be 30\t\t")
+(display (reset0 (* 2 (shift0 f (* 5 (f 3))))))
+(newline)
+
+(write-string "should be 12\t\t")
+(display (reset0 (* 2 (shift0 f (f (f 3))))))
+(newline)
+
+(write-string "should be 6\t\t")
+(display ((reset0 (* 2 (shift0 f f))) 3))
+(newline)
+
+(write-string "should be 7\t\t")
+(display (reset0 (* 5
+		   (reset0 (* 2
+			     (shift0 f2 (* 3 (shift0 f3 7))))))))
+(newline)
+
+(write-string "should be 7\t\t")
+(sandbox
+ (display (reset0 (* 5 (
+		       (reset0 (* 2
+				 (shift0 f2 (lambda ()
+					     (* 3 (shift0 f3 7))))))))))
+ (newline))
+
+(write-string "should be 42\t\t")
+(display (reset0 (* 5
+		   ((lambda (x) (shift0 f1 x))
+		    (* 3 (shift0 f2 (* 2 (f2 7))))))))
+(newline)
+
+(write-string "something actually useful! a small table of factorials\n")
+
+; Eventually we want to be able to use code like this:
+
+; (defmacro (range from step to)
+;   (let ((f (gensym))
+;	(i (gensym)))
+;     `(shift ,f
+;	    (do ((,i ,from (+ ,i ,step)))
+;		((> ,i ,to) #f)
+;	      (,f ,i)))))
+;
+; (reset (begin (display (my-fact (range 1 3 16))) (newline)))
+
+; Just to show I've got nothing up my sleeve, here is a perfectly cromulent
+; function; we could equally well use the built-in (factorial) function
+
+(define (my-fact n)
+  (if (<= n 0)
+      1
+      (* n (my-fact (- n 1)))))
+
+(define from 1)
+(define to 21)
+(define step 3)
+
+(reset (display (my-fact 
+		 (shift f
+			(do ((i from (+ i step)))
+			    ((> i to) #f)
+			  (write-string (number->string i))
+			  (write-string "! =\t")
+			  (f i)))))
+       (newline))
+
+; This one is specific to haskeem, because the macro reset doesn't start
+; the thunk in the middle, but rather at the beginning; that makes the
+; ping-pong possible
+
+(write-string
+ "These rely on the reset thunk being re-evaluated from the beginning,\n")
+(write-string
+ "so strictly speaking both are wrong. So I don't know what the answers\n")
+(write-string
+ "\"should be\"... but they look plausible\n")
+(define (doit7 flag)
+  (display
+   (cons 1
+	 (reset (cons 2 (if flag
+			    (shift k1 (set! flag (not flag))
+				   (cons 3 (k1 (cons 4 '()))))
+			    (shift k2 (set! flag (not flag))
+				   (cons 5 (k2 (cons 6 '())))))))))
+  (newline))
+
+; it's hard to say if these are right... both rely on a wrong implementation
+; of the thunk stuff
+
+(doit7 #f)	; (1 5 3 2 6) -- mzscheme sez (1 5 2 6)
+(doit7 #t)	; (1 3 5 2 4) -- mzscheme sez (1 3 2 4)
+
+(write-string
+ "syntax error coming up! should be an error... this'll kill mzscheme\n")
+
+(sandbox (display (+ 1 (reset (+ 2 (shift (+ k 1) 3))))))
diff --git a/haskeem.cabal b/haskeem.cabal
--- a/haskeem.cabal
+++ b/haskeem.cabal
@@ -1,11 +1,13 @@
 Name:             haskeem
-Version:          0.7.7
+Version:          0.7.9
 Homepage:         http://www.korgwal.com/haskeem/
 Author:           Uwe Hollerbach <uh@alumni.caltech.edu>
 Maintainer:       Uwe Hollerbach <uh@alumni.caltech.edu>
 Synopsis:         A small scheme interpreter
 Description:      This is a moderately complete small scheme interpreter.
                   It implements most of R6RS, with the exception of call/cc.
+                  It is however starting to have a set of delimited
+                  continuations (implemented as macros, so not quite "native").
                   It has a macro system, although not R6RS hygienic macros.
                   It is also not necessarily fully tail-recursive; so it's
                   not industrial-strength. For playing with or learning
@@ -17,7 +19,7 @@
 Category:         Compilers/Interpreters
 
 Executable        haskeem
-  Build-Depends:  base >= 4 && < 5, network, containers, mtl, parsec,
+  Build-Depends:  base >= 4 && < 5, network, containers, mtl, parsec, process,
                   haskell98, random, old-time, unix, directory, haskeline
   Main-is:        haskeem.hs
   Other-Modules:  LispData
diff --git a/haskeem.doc b/haskeem.doc
--- a/haskeem.doc
+++ b/haskeem.doc
@@ -15,7 +15,7 @@
 ; along with haskeem; if not, write to the Free Software
 ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-; $Id: haskeem.doc,v 1.39 2009-07-03 23:17:00 uwe Exp $
+; $Id: haskeem.doc,v 1.40 2009-07-10 05:15:38 uwe Exp $
 
 ; Input to documentation generator for haskeem. The intent is that this
 ; does NOT have to be globally ordered, it is possible to just add new
@@ -441,3 +441,9 @@
 
 ((function make-stack) (args . values) (return function))
 ((macro fluid-let) (args (vars params) . body))
+
+((primitive run-command) (args command) (return exit-status))
+((primitive run-read-command) (args command) (return port))
+((primitive run-read-command) (args command working-directory) (return port))
+((primitive run-write-command) (args command) (return port))
+((primitive run-write-command) (args command working-directory) (return port))
diff --git a/haskeem.hs b/haskeem.hs
--- a/haskeem.hs
+++ b/haskeem.hs
@@ -19,7 +19,7 @@
 along with haskeem; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-$Id: haskeem.hs,v 1.36 2009-07-04 19:07:00 uwe Exp $ -}
+$Id: haskeem.hs,v 1.38 2009-07-27 04:46:22 uwe Exp $ -}
 
 module Main where
 import Prelude
@@ -43,7 +43,7 @@
 -- haskeem version
 
 version :: String
-version = "0.7.7"
+version = "0.7.9"
 
 -- a variable under which any command-line arguments to a script are
 -- made available; empty for interactive mode
diff --git a/haskeem_readline.hs b/haskeem_readline.hs
--- a/haskeem_readline.hs
+++ b/haskeem_readline.hs
@@ -43,7 +43,7 @@
 -- haskeem version
 
 version :: String
-version = "0.7.7"
+version = "0.7.9"
 
 -- a variable under which any command-line arguments to a script are
 -- made available; empty for interactive mode
diff --git a/selftest.scm b/selftest.scm
--- a/selftest.scm
+++ b/selftest.scm
@@ -15,7 +15,7 @@
 ; along with haskeem; if not, write to the Free Software
 ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-; $Id: selftest.scm,v 1.45 2009-07-04 01:29:53 uwe Exp $
+; $Id: selftest.scm,v 1.46 2009-07-19 02:36:21 uwe Exp $
 
 (define start (epochtime))
 
@@ -2406,7 +2406,8 @@
   (catch-exceptions (chk-run #t '(set-current-directory test-dir1)))
   (catch-exceptions (chk-query "test directory" '(get-current-directory)))
   (catch-exceptions (chk-run #t '(set-current-directory "..")))
-  (catch-exceptions (chk-run #t '(remove-directory test-dir1))))
+  (catch-exceptions (chk-run #t '(remove-directory test-dir1)))
+  (run-command (string-join-by " " "/bin/rm -rf" test-dir1)))
 
 (if (directory-exists? test-dir1)
     (write-string "\nSkipping file and directory I/O tests,\n"
@@ -2596,25 +2597,26 @@
 (chk-run 1243 '(ilog (expt 2 1243)))
 
 (define mynum 1.2345)
+; If this is true, we'll see 1.235 with rounding in two places below,
+; and 1.2345000000000002e0 without rounding
+(define mynumtest? (< 12345 (* mynum 10000)))
 
-(write-string "The following two tests might fail, "
-	      "returning \"1.2345000000000002e0\" instead\n")
-(chk-run "1.2345e0" '(number->string mynum))
-(chk-run "1.2345e0" '(number->string mynum 10))
+(chk-run (if mynumtest? "1.2345000000000002e0" "1.2345e0")
+	 '(number->string mynum))
+(chk-run (if mynumtest? "1.2345000000000002e0" "1.2345e0")
+	 '(number->string mynum 10))
 (chk-run "1.2345" '(number->string mynum 10 4))
 (chk-run "1.23450" '(number->string mynum 10 5))
 (chk-run "1.234500" '(number->string mynum 10 6))
 
-(write-string "This test might fail, returning \"1.235\" instead\n")
-(chk-run "1.234" '(number->string mynum 10 3))
+(chk-run (if mynumtest? "1.235" "1.234") '(number->string mynum 10 3))
 (chk-run "1.23" '(number->string mynum 10 2))
 (chk-run "1.2" '(number->string mynum 10 1))
 (chk-run "1." '(number->string mynum 10 0))
 (chk-run "1.2e0" '(number->string mynum 10 -1))
 (chk-run "1.23e0" '(number->string mynum 10 -2))
 
-(write-string "This test might fail, returning \"1.235e0\" instead\n")
-(chk-run "1.234e0" '(number->string mynum 10 -3))
+(chk-run (if mynumtest? "1.235e0" "1.234e0") '(number->string mynum 10 -3))
 (chk-run "1.2345e0" '(number->string mynum 10 -4))
 (chk-run "1.2345e0" '(number->string 12345e-4 10 -4))
 (chk-run "1.2345" '(number->string 12345/10000 10 4))
diff --git a/stdlib.scm b/stdlib.scm
--- a/stdlib.scm
+++ b/stdlib.scm
@@ -111,7 +111,12 @@
 
 (define (compose f g) (lambda args (apply f (apply g args))))
 
-(define fcdr (compose force cdr))
+;;; (define fcdr (compose force cdr))
+(define (fcdr x)
+  (let ((cx (cdr x)))
+    (if (promise? cx)
+	(force cx)
+	cx)))
 
 (define (cycle lst)
   (letrec ((next (lambda (cur)