diff --git a/Environment.hs b/Environment.hs
--- a/Environment.hs
+++ b/Environment.hs
@@ -1,8 +1,7 @@
 {- Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>
 Portions of this were derived from Jonathan Tang's haskell
 tutorial "Write yourself a scheme in 48 hours" and are thus
-Copyright Jonathan Tang
-(but I can't easily tell anymore who originally wrote what)
+Copyright Jonathan Tang (but there isn't much of his stuff left).
 
 This file is part of haskeem.
 haskeem is free software; you can redistribute it and/or modify
@@ -19,7 +18,7 @@
 along with haskeem; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-$Id: environment.hs,v 1.11 2009-06-27 20:31:51 uwe Exp $ -}
+$Id: environment.hs,v 1.12 2009-08-06 05:05:15 uwe Exp $ -}
 
 module Environment (isBound, getVar, setVar,
                     defineVar, bindVars, dumpEnv) where
diff --git a/Evaluator.hs b/Evaluator.hs
--- a/Evaluator.hs
+++ b/Evaluator.hs
@@ -1,8 +1,7 @@
 {- Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>
 Portions of this were derived from Jonathan Tang's haskell
 tutorial "Write yourself a scheme in 48 hours" and are thus
-Copyright Jonathan Tang
-(but I can't easily tell anymore who originally wrote what)
+Copyright Jonathan Tang (but there isn't much of his stuff left).
 
 This file is part of haskeem.
 haskeem is free software; you can redistribute it and/or modify
@@ -19,9 +18,9 @@
 along with haskeem; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-$Id: evaluator.hs,v 1.35 2009-07-04 07:47:22 uwe Exp $ -}
+$Id: evaluator.hs,v 1.40 2009-08-08 05:08:59 uwe Exp $ -}
 
-module Evaluator (evalLisp) where
+module Evaluator (evalLisp, evalPP) where
 import Prelude
 import IO
 import Control.Exception as CE()
@@ -102,8 +101,9 @@
 -- omnipotent thing that does all the work
 
 doApply :: Bool -> String -> [String] -> (Maybe String) -> [LispVal]
-           -> Env -> Integer -> [LispVal] -> IOThrowsError LispVal
-doApply trace name params varargs body closure ql args =
+           -> Env -> [[LispVal]] -> Integer -> [LispVal]
+           -> IOThrowsError LispVal
+doApply trace name params varargs body closure dcs ql args =
   if num params /= num args && varargs == Nothing
      then errNumArgs (show body) (num params) args
      else prtTrace >>
@@ -111,7 +111,7 @@
                 bindVarArgs varargs >>= evalBody
   where remainingArgs = drop (length params) args
         num = toInteger . length
-        evalBody env = mapML (evalLisp env ql) body
+        evalBody env = mapML (evalLisp env dcs ql) body
         bindVarArgs arg env =
           case arg of
                Just argName ->
@@ -123,14 +123,15 @@
                   return True
              else return False
 
-apply :: Integer -> LispVal -> [LispVal] -> IOThrowsError LispVal
-apply _ (Prim func) args = liftThrows (func args)
-apply _ (IOPrim func) args = func args
-apply ql (Func params varargs body closure Nothing _) args =
-  doApply False "" params varargs body closure ql args
-apply ql (Func params varargs body closure (Just name) _) args =
-  doApply True name params varargs body closure ql args
-apply _ func _ = throwError (NotFunction "apply got non-function" func)
+apply :: [[LispVal]] -> Integer -> LispVal -> [LispVal]
+         -> IOThrowsError LispVal
+apply _ _ (Prim func) args = liftThrows (func args)
+apply _ _ (IOPrim func) args = func args
+apply dcs ql (Func params varargs body closure Nothing _) args =
+  doApply False "" params varargs body closure dcs ql args
+apply dcs ql (Func params varargs body closure (Just name) _) args =
+  doApply True name params varargs body closure dcs ql args
+apply _ _ func _ = throwError (NotFunction "apply got non-function" func)
 
 makeFunc varargs env params body =
   return (Func (map show params) varargs body env Nothing False)
@@ -147,7 +148,8 @@
                 "guard", "if", "lambda", "let", "let*", "letrec",
                 "letrec*", "load", "or", "quasiquote", "quote", "set!",
                 "unquote", "unquote-splicing", "vector-fill!",
-                "vector-set!", "trace", "dump-bindings"]
+                "vector-set!", "ext cont", "int cont",
+                "trace", "dump-bindings"]
 
 isSpecialForm (Symbol s) = seek s specialForms
   where seek _ [] = False
@@ -214,30 +216,30 @@
 -- or an unquote-splicing at the right quote level; these it evaluates via
 -- evalLisp and patches into the tree
 
-evalQQ :: Env -> Integer -> LispVal -> IOThrowsError LispVal
+evalQQ :: Env -> [[LispVal]] -> Integer -> LispVal -> IOThrowsError LispVal
 
 -- "quasiquote", "unquote", and "unquote-splicing" might get evaluated,
 -- depending on quote level
 
-evalQQ env ql (List [Symbol "quasiquote", arg]) =
-  do val <- evalQQ env (ql + 1) arg >>= liftSUnq
+evalQQ env dcs ql (List [Symbol "quasiquote", arg]) =
+  do val <- evalQQ env dcs (ql + 1) arg >>= liftSUnq
      return (List [Symbol "quasiquote", val])
 
-evalQQ env ql (List (Symbol "unquote" : args)) =
+evalQQ env dcs ql (List (Symbol "unquote" : args)) =
   if ql == 1
-     then do vals <- mapM (evalLisp env 0) args
+     then do vals <- mapM (evalLisp env dcs 0) args
              return (List ((Symbol unq):vals))
-     else do vals <- mapM (evalQQ env (ql - 1)) args
+     else do vals <- mapM (evalQQ env dcs (ql - 1)) args
              return (List ((Symbol "unquote") : (liftLUnq vals)))
 
-evalQQ env ql (List (Symbol "unquote-splicing" : args)) =
+evalQQ env dcs ql (List (Symbol "unquote-splicing" : args)) =
   if ql == 1
-     then do vals <- mapM (evalLisp env 0) args
+     then do vals <- mapM (evalLisp env dcs 0) args
              if isLL vals
                 then return (List ((Symbol unq):(peel vals)))
                 else throwError (Default ("bad unquote-splicing form: " ++
                                 (show args)))
-     else do vals <- mapM (evalQQ env (ql - 1)) args
+     else do vals <- mapM (evalQQ env dcs (ql - 1)) args
              return (List ((Symbol "unquote-splicing") : (liftLUnq vals)))
   where isLL [] = True
         isLL ((List _):ls) = isLL ls
@@ -247,12 +249,12 @@
 
 -- lists, dotted-lists, and vectors get traversed
 
-evalQQ env ql (List con) =
-  mapM (evalQQ env ql) con >>= return . List . liftLUnq
+evalQQ env dcs ql (List con) =
+  mapM (evalQQ env dcs ql) con >>= return . List . liftLUnq
 
-evalQQ env ql (DottedList con cab) =
-  do vals <- mapM (evalQQ env ql) con
-     vcab <- evalQQ env ql cab >>= liftSUnq
+evalQQ env dcs ql (DottedList con cab) =
+  do vals <- mapM (evalQQ env dcs ql) con
+     vcab <- evalQQ env dcs ql cab >>= liftSUnq
      let head = liftLUnq vals
      if isList vcab
         then return (List (head ++ (getList vcab)))
@@ -260,8 +262,8 @@
                 then return (DottedList (head ++ (getDLh vcab)) (getDLt vcab))
                 else return (DottedList head vcab)
 
-evalQQ env ql (Vector _ con) =
-  do vals <- mapM (evalQQ env ql) (remkey (DIM.toAscList con))
+evalQQ env dcs ql (Vector _ con) =
+  do vals <- mapM (evalQQ env dcs ql) (remkey (DIM.toAscList con))
      let new = DIM.fromAscList (addkey 0 (liftLUnq vals))
      return (Vector (toInteger (DIM.size new)) new)
   where remkey [] = []
@@ -271,22 +273,69 @@
 
 -- anything else gets returned unchanged
 
-evalQQ _ _ val@_ = return val
+evalQQ _ _ _ val@_ = return val
 
+-- evalPP is another specialized version of evalLisp: it also walks
+-- the tree and turns the del-cont operators into their internal form,
+-- which has a unique identifier and possibly two flags attached. The
+-- unique identifier is to be able to identify which is the current
+-- hole in an expression if there are several interior operators
+-- enclosed within the scope of an exterior operator. The flags are to
+-- determine whether or not to attach the two new reset operators
+-- during the transformation.
+
+-- TODO: check shift etc operators for syntactic correctness here?
+-- ie, check that the first arg is a symbol and not something else?
+-- probably a good idea...
+
+-- TODO: temporarily make this code deal with ALL-CAPS versions of
+-- reset et al; otherwise, we break all of the delcont/deltest stuff
+
+evalPP :: Env -> LispVal -> IOThrowsError LispVal
+
+evalPP env (List ((Symbol sym):arg)) =
+  do argn <- mapM (evalPP env) arg
+     if sym == "RESET"  || sym == "PROMPT"  ||
+        sym == "RESET0" || sym == "PROMPT0" ||
+        sym == "SHIFT"  || sym == "CONTROL" ||
+        sym == "SHIFT0" || sym == "CONTROL0"
+        then do newsym <- transmogrify
+                return (List (newsym ++ argn))
+        else return (List ((Symbol sym) : argn))
+  where transmogrify =
+          do cval <- getVar env contCounter
+             let count = getInt cval
+                 csym = " cont." ++ (show count)
+                 f0 = (sym == "RESET"  || sym == "PROMPT" ||
+                       sym == "RESET0" || sym == "PROMPT0")
+                 f1 = (sym == "SHIFT" || sym == "SHIFT0")
+                 f2 = (sym == "SHIFT" || sym == "CONTROL")
+             do setVar env contCounter (IntNumber (count + 1))
+                return (if f0
+                           then [Symbol "ext cont", Symbol csym]
+                           else [Symbol "int cont", Symbol csym,
+                                 Boolean f1, Boolean f2])
+
+evalPP env (List args) = mapM (evalPP env) args >>= return . List
+
+-- everything else gets returned unchanged
+
+evalPP env val = return val
+
 -- This is the main evaluator
 
-evalLisp :: Env -> Integer -> LispVal -> IOThrowsError LispVal
+evalLisp :: Env -> [[LispVal]] -> Integer -> LispVal -> IOThrowsError LispVal
 
 -- various simple things which evaluate to themselves
 
-evalLisp _ _ val@(String _) = return val
-evalLisp _ _ val@(IntNumber _) = return val
-evalLisp _ _ val@(RatNumber _) = return val
-evalLisp _ _ val@(FltNumber _) = return val
-evalLisp _ _ val@(Boolean _) = return val
-evalLisp _ _ val@(Char _) = return val
-evalLisp _ _ (List []) = return (List [])
-evalLisp env _ (Symbol id) = getVar env id
+evalLisp _ _ _ val@(String _) = return val
+evalLisp _ _ _ val@(IntNumber _) = return val
+evalLisp _ _ _ val@(RatNumber _) = return val
+evalLisp _ _ _ val@(FltNumber _) = return val
+evalLisp _ _ _ val@(Boolean _) = return val
+evalLisp _ _ _ val@(Char _) = return val
+evalLisp _ _ _ (List []) = return (List [])
+evalLisp env _ _ (Symbol id) = getVar env id
 
 -- Special forms must go here, before the generic (function : args) stuff
 
@@ -296,12 +345,12 @@
 -- convenient to have it here; otherwise, we have to do all sorts of
 -- twisting to make it all work.
 
-evalLisp env ql (List (Symbol "apply" : function : args)) =
-  do func <- evalLisp env ql function
-     argVals <- mapM (evalLisp env ql) args
-     appp ql (func:argVals)
-  where appp ql [func, List args] = apply ql func args
-        appp ql (func : args) = apply ql func args
+evalLisp env dcs ql (List (Symbol "apply" : function : args)) =
+  do func <- evalLisp env dcs ql function
+     argVals <- mapM (evalLisp env dcs ql) args
+     appp (func:argVals)
+  where appp [func, List args] = apply dcs ql func args
+        appp (func : args) = apply dcs ql func args
 
 -- TODO: this is not a special form according to R6RS; the only reason
 -- I put it here is because evalLisp wants an environment, and that's
@@ -314,8 +363,10 @@
 -- move this into the libraries... I'd just have to provide access to
 -- the (or a) top-level environment.
 
-evalLisp env ql (List (Symbol "eval" : args)) =
-  mapM (evalLisp env ql) args >>= mapML (evalLisp env ql)
+evalLisp env dcs ql (List (Symbol "eval" : args)) =
+  mapM (evalPP env) args >>=
+  mapM (evalLisp env dcs ql) >>=
+  mapML (evalLisp env dcs ql)
 
 -- TODO: This is also not a special form according to R6RS; I think I
 -- could also make it a regular function, but it has the same issues
@@ -324,50 +375,50 @@
 -- wants to (or should be able to) call (load) from within some
 -- function and modify the environment seen within that function.
 
-evalLisp env ql (List [Symbol "load", String filename]) =
-  loadFile filename >>= mapML (evalLisp env ql)
-evalLisp env ql (List [Symbol "load", arg]) =
-  do fname <- evalLisp env ql arg
+evalLisp env dcs ql (List [Symbol "load", arg]) =
+  do fname <- evalLisp env dcs ql arg
      if isStr fname
-        then loadFile (getStr fname) >>= mapML (evalLisp env ql)
+        then loadFile (getStr fname) >>=
+             mapM (evalPP env) >>=
+             mapML (evalLisp env dcs ql)
         else throwError (Default ("bad load form: " ++
                                   (show fname) ++ " is not a string"))
 
-evalLisp env ql (List (Symbol "begin" : args)) =
-  mapML (evalLisp env ql) args
+evalLisp env dcs ql (List (Symbol "begin" : args)) =
+  mapML (evalLisp env dcs ql) args
 
-evalLisp _ _ (List [Symbol "quote", val]) = return val
+evalLisp _ _ _ (List [Symbol "quote", val]) = return val
 
-evalLisp env ql (List [Symbol "quasiquote", val]) =
-  evalQQ env (ql + 1) val >>= liftSUnq
+evalLisp env dcs ql (List [Symbol "quasiquote", val]) =
+  evalQQ env dcs (ql + 1) val >>= liftSUnq
 
-evalLisp _ _ (List (Symbol "unquote" : args)) =
+evalLisp _ _ _ (List (Symbol "unquote" : args)) =
   throwError (Default ("naked unquote form: " ++ (show args)))
 
-evalLisp _ _ (List (Symbol "unquote-splicing" : args)) =
+evalLisp _ _ _ (List (Symbol "unquote-splicing" : args)) =
   throwError (Default ("naked unquote-splicing form: " ++ (show args)))
 
-evalLisp env ql (List [Symbol "set!", Symbol var, val]) =
-  evalLisp env ql val >>= setVar env var
+evalLisp env dcs ql (List [Symbol "set!", Symbol var, val]) =
+  evalLisp env dcs ql val >>= setVar env var
 
-evalLisp env ql (List [Symbol "vector-set!", Symbol var, indx, obj]) =
-  do vec <- evalLisp env ql (Symbol var)
+evalLisp env dcs ql (List [Symbol "vector-set!", Symbol var, indx, obj]) =
+  do vec <- evalLisp env dcs ql (Symbol var)
      if isVec vec
-        then do lk <- evalLisp env ql indx
+        then do lk <- evalLisp env dcs ql indx
                 let l = getVecL vec
                     k = getInt lk
                 if ((isInt lk) && k >= 0 && k < l)
-                   then do val <- evalLisp env ql obj
+                   then do val <- evalLisp env dcs ql obj
                            setVar env var (Vector l
                              (DIM.insert (fromInteger k) val (getVecV vec)))
                    else throwError (VectorBounds l lk)
         else throwError (Default ("bad vector-set! form: " ++
                                   (show var) ++ " is not a vector"))
 
-evalLisp env ql (List [Symbol "vector-fill!", Symbol var, obj]) =
-  do vec <- evalLisp env ql (Symbol var)
+evalLisp env dcs ql (List [Symbol "vector-fill!", Symbol var, obj]) =
+  do vec <- evalLisp env dcs ql (Symbol var)
      if isVec vec
-        then do val <- evalLisp env ql obj
+        then do val <- evalLisp env dcs ql obj
                 let n = getVecL vec
                 setVar env var (Vector n (DIM.fromAscList
                   (addkey val (fromInteger n))))
@@ -376,10 +427,10 @@
   where addkey _ 0 = []
         addkey v n = ((n-1), v):(addkey v (n-1))
 
-evalLisp env ql (List [Symbol "vector-resize!", Symbol var, obj]) =
-  do vec <- evalLisp env ql (Symbol var)
+evalLisp env dcs ql (List [Symbol "vector-resize!", Symbol var, obj]) =
+  do vec <- evalLisp env dcs ql (Symbol var)
      if isVec vec
-        then do lk <- evalLisp env ql obj
+        then do lk <- evalLisp env dcs ql obj
                 let l = getVecL vec
                     k = getInt lk
                 if (isInt lk) && (k > 0)
@@ -400,75 +451,78 @@
              then vec
              else add (DIM.insert (fromInteger l) lispFalse vec) h (l + 1)
 
-evalLisp env ql (List [Symbol "define", Symbol var, val]) =
+evalLisp env dcs ql (List [Symbol "define", Symbol var, val]) =
   do defineVar env var lispFalse
-     evalLisp env ql val >>= setVar env var
-evalLisp env _ (List [Symbol "define", Symbol var]) =
+     evalLisp env dcs ql val >>= setVar env var
+evalLisp env _ _ (List [Symbol "define", Symbol var]) =
   defineVar env var lispFalse
-evalLisp env _ (List (Symbol "define" : List (Symbol var : params) : body)) =
+evalLisp env dcs _
+    (List (Symbol "define" : List (Symbol var : params) : body)) =
   if paramsCheck params
      then do defineVar env var lispFalse
              makeNormalFunc env params body >>= setVar env var
      else errBadForm "define" params
-evalLisp env _ (List (Symbol "define" :
-              DottedList (Symbol var : params) varargs : body)) =
+evalLisp env dcs _ (List (Symbol "define" :
+    DottedList (Symbol var : params) varargs : body)) =
   if paramsCheck (params ++ [varargs])
      then do defineVar env var lispFalse
              makeVarargsFunc varargs env params body >>= setVar env var
      else errBadForm "define" [DottedList params varargs]
 
-evalLisp env _ (List (Symbol "defmacro" : List (Symbol var : params) : body)) =
+evalLisp env dcs _
+    (List (Symbol "defmacro" : List (Symbol var : params) : body)) =
   if paramsCheck params
      then do defineVar env var lispFalse
              makeNormalMacro env params body >>= setVar env var
      else errBadForm "defmacro" params
-evalLisp env _ (List (Symbol "defmacro" :
-              DottedList (Symbol var : params) varargs : body)) =
+evalLisp env dcs _ (List (Symbol "defmacro" :
+    DottedList (Symbol var : params) varargs : body)) =
   if paramsCheck (params ++ [varargs])
      then do defineVar env var lispFalse
              makeVarargsMacro varargs env params body >>= setVar env var
      else errBadForm "defmacro" [DottedList params varargs]
 
-evalLisp env _ (List (Symbol "lambda" : List params : body)) =
+evalLisp env dcs _ (List (Symbol "lambda" : List params : body)) =
   if paramsCheck params
      then makeNormalFunc env params body
      else errBadForm "lambda" params
-evalLisp env _ (List (Symbol "lambda" : DottedList params varargs : body)) =
+evalLisp env dcs _
+    (List (Symbol "lambda" : DottedList params varargs : body)) =
   if paramsCheck (params ++ [varargs])
      then makeVarargsFunc varargs env params body
      else errBadForm "lambda" [DottedList params varargs]
-evalLisp env _ (List (Symbol "lambda" : varargs@(Symbol _) : body)) =
+evalLisp env dcs _ (List (Symbol "lambda" : varargs@(Symbol _) : body)) =
   makeVarargsFunc varargs env [] body
 
-evalLisp env ql (List [Symbol "if", pred, tcase, fcase]) =
-  do result <- evalLisp env ql pred
+evalLisp env dcs ql (List [Symbol "if", pred, tcase, fcase]) =
+  do result <- evalLisp env dcs ql pred
      case result of
-          Boolean False -> evalLisp env ql fcase
-          _ -> evalLisp env ql tcase
-evalLisp env ql (List [Symbol "if", pred, tcase]) =
-  do result <- evalLisp env ql pred
+          Boolean False -> evalLisp env dcs ql fcase
+          _ -> evalLisp env dcs ql tcase
+evalLisp env dcs ql (List [Symbol "if", pred, tcase]) =
+  do result <- evalLisp env dcs ql pred
      case result of
           Boolean False -> return lispFalse
-          _ -> evalLisp env ql tcase
+          _ -> evalLisp env dcs ql tcase
 
-evalLisp env ql (List (Symbol "and" : args)) = eva env args lispTrue
+evalLisp env dcs ql (List (Symbol "and" : args)) = eva env args lispTrue
   where eva _ [] ret = return ret
         eva env (t:ts) _ =
-          do result <- evalLisp env ql t
+          do result <- evalLisp env dcs ql t
              case result of
                   Boolean False -> return lispFalse
                   _ -> eva env ts result
 
-evalLisp env ql (List (Symbol "or" : args)) = evo env args lispFalse
+evalLisp env dcs ql (List (Symbol "or" : args)) = evo env args lispFalse
   where evo _ [] ret = return ret
         evo env (t:ts) _ =
-          do result <- evalLisp env ql t
+          do result <- evalLisp env dcs ql t
              case result of
                   Boolean False -> evo env ts result
                   _ -> return result
 
-evalLisp _ _ (List [Symbol "cond"]) = return lispFalse
-evalLisp env ql (List (Symbol "cond" : args)) =
+evalLisp _ _ _ (List [Symbol "cond"]) = return lispFalse
+evalLisp env dcs ql (List (Symbol "cond" : args)) =
   if foldl1 (&&) (map isList args) == False
      then errTypeMismatch "cond" "cond-clauses" (String (show args))
      else evc env args
@@ -476,70 +530,71 @@
         evc env (cl:cls) = do (tst,val) <- evc_clause env cl
                               if tst then return val else evc env cls
         evc_clause env (List (Symbol "else" : args)) =
-          do ret <- mapML (evalLisp env ql) args
+          do ret <- mapML (evalLisp env dcs ql) args
              return (True, ret)
         evc_clause env (List (pred : args)) =
-          do tst <- evalLisp env ql pred
+          do tst <- evalLisp env dcs ql pred
              case tst of
                   Boolean False -> return (False, lispFalse)
                   _ -> do ret <- if isArrow args
                                     then evcArrow env args tst
-                                    else mapML (evalLisp env ql) args
+                                    else mapML (evalLisp env dcs ql) args
                           return (True, ret)
         evc_clause _ _ = return (False, lispFalse)
         isArrow [Symbol "=>", _] = True
         isArrow _ = False
         evcArrow env [Symbol "=>", proc] val =
-          evalLisp env ql proc >>= (flip (apply ql)) [val]
+          evalLisp env dcs ql proc >>= (flip (apply dcs ql)) [val]
 
-evalLisp env ql (List (Symbol "let" : List params : body)) =
+evalLisp env dcs ql (List (Symbol "let" : List params : body)) =
   if letCheck True params
      then do func <- makeNormalFunc env (map exn params) body
-             argVals <- mapM (evalLisp env ql) (map exv params)
-             apply ql func argVals
+             argVals <- mapM (evalLisp env dcs ql) (map exv params)
+             apply dcs ql func argVals
      else errBadForm "let" params
     where exn (List [Symbol var, _]) = Symbol var
           exv (List [Symbol _, val]) = val
 
-evalLisp env ql (List (Symbol "let" : Symbol lname : List params : body)) =
+evalLisp env dcs ql
+    (List (Symbol "let" : Symbol lname : List params : body)) =
   if letCheck True params
      then do envn <- liftIO (bindVars env [(lname, lispFalse)])
              func <- makeNormalFunc envn (map exn params) body
              setVar envn lname func
-             argVals <- mapM (evalLisp env ql) (map exv params)
-             apply ql func argVals
+             argVals <- mapM (evalLisp env dcs ql) (map exv params)
+             apply dcs ql func argVals
      else errBadForm "named-let" params
     where exn (List [Symbol var, _]) = Symbol var
           exv (List [Symbol _, val]) = val
 
-evalLisp env ql (List (Symbol "let*" : List params : body)) =
+evalLisp env dcs ql (List (Symbol "let*" : List params : body)) =
   if letCheck False params
      then dols params body env
      else errBadForm "let*" params
-  where dols [] body env = mapML (evalLisp env ql) body
+  where dols [] body env = mapML (evalLisp env dcs ql) body
         dols (p:ps) body env =
-             do val <- evalLisp env ql (exv p)
+             do val <- evalLisp env dcs ql (exv p)
                 (liftIO (bindVars env [(exn p, val)])) >>= (dols ps body)
         exn (List [Symbol var, _]) = var
         exv (List [Symbol _, val]) = val
 
-evalLisp env ql (List (Symbol "letrec" : List params : body)) =
+evalLisp env dcs ql (List (Symbol "letrec" : List params : body)) =
   if letCheck True params
      then dolr params body env
      else errBadForm "letrec" params
   where dolr params body env =
           do let varn = map exn params
              envn <- liftIO (bindVars env varn)
-             varv <- mapM (evalLisp envn ql) (map exv params)
+             varv <- mapM (evalLisp envn dcs ql) (map exv params)
              mapM (doSet envn) (repl varn varv) >>
-                  mapML (evalLisp envn ql) body
+                  mapML (evalLisp envn dcs ql) body
         exn (List [Symbol var, _]) = (var, lispFalse)
         exv (List [Symbol _, val]) = val
         repl [] [] = []
         repl ((n, lispFalse):ns) (v:vs) = (n, v):(repl ns vs)
         doSet env (n,v) = setVar env n v
 
-evalLisp env ql (List (Symbol "letrec*" : List params : body)) =
+evalLisp env dcs ql (List (Symbol "letrec*" : List params : body)) =
   if letCheck False params
      then dolr params body env
      else errBadForm "letrec*" params
@@ -547,16 +602,16 @@
           do let varn = map exn params
              envn <- liftIO (bindVars env varn)
              mapM (evSet envn) params >>
-                  mapML (evalLisp envn ql) body
+                  mapML (evalLisp envn dcs ql) body
         exn (List [Symbol var, _]) = (var, lispFalse)
         evSet env (List [Symbol var, val]) =
-              evalLisp env ql val >>= setVar env var
+              evalLisp env dcs ql val >>= setVar env var
 
-evalLisp _ _ (List [Symbol "case"]) = return lispFalse
-evalLisp env ql (List (Symbol "case" : key : args)) =
+evalLisp _ _ _ (List [Symbol "case"]) = return lispFalse
+evalLisp env dcs ql (List (Symbol "case" : key : args)) =
   if (isNull args) || (foldl1 (&&) (map isLL args) == False)
      then errTypeMismatch "case" "case-clauses" (String (show args))
-     else evalLisp env ql key >>= evc env args
+     else evalLisp env dcs ql key >>= evc env args
   where isNull [] = True
         isNull _ = False
         isLL (List (List _ : _)) = True
@@ -566,11 +621,11 @@
         evc env (cl:cls) key = do (tst,val) <- evc_clause env cl key
                                   if tst then return val else evc env cls key
         evc_clause env (List (Symbol "else" : args)) _ =
-          do ret <- mapML (evalLisp env ql) args
+          do ret <- mapML (evalLisp env dcs ql) args
              return (True, ret)
         evc_clause env (List (List vals : args)) key =
           if valMatch key vals
-             then do ret <- mapML (evalLisp env ql) args
+             then do ret <- mapML (evalLisp env dcs ql) args
                      return (True, ret)
              else return (False, lispFalse)
         evc_clause _ _ _ = return (False, lispFalse)
@@ -579,10 +634,11 @@
                                  else (valMatch key vs)
         valMatch _ [] = False
 
-evalLisp env ql (List (Symbol "guard" : List (Symbol var : clauses) : body)) =
+evalLisp env dcs ql
+    (List (Symbol "guard" : List (Symbol var : clauses) : body)) =
   if foldl (&&) True (map isList clauses) == False
      then errTypeMismatch "guard" "error-clauses" (String (show clauses))
-     else catchError (mapML (evalLisp env ql) body)
+     else catchError (mapML (evalLisp env dcs ql) body)
                      (\err -> do let errval = unpackErr err
                                  liftIO (bindVars env [(var, errval)]) >>=
                                    evc err clauses)
@@ -592,21 +648,21 @@
         evc err (cl:cls) env = do (tst,val) <- evc_clause env cl
                                   if tst then return val else evc err cls env
         evc_clause env (List (Symbol "else" : args)) =
-          do ret <- mapML (evalLisp env ql) args
+          do ret <- mapML (evalLisp env dcs ql) args
              return (True, ret)
         evc_clause env (List (pred : args)) =
-          do tst <- evalLisp env ql pred
+          do tst <- evalLisp env dcs ql pred
              case tst of
                   Boolean False -> return (False, lispFalse)
                   _ -> do ret <- if isArrow args
                                     then evcArrow env args tst
-                                    else mapML (evalLisp env ql) args
+                                    else mapML (evalLisp env dcs ql) args
                           return (True, ret)
         evc_clause _ _ = return (False, lispFalse)
         isArrow [Symbol "=>", _] = True
         isArrow _ = False
         evcArrow env [Symbol "=>", proc] val =
-          evalLisp env ql proc >>= (flip (apply ql)) [val]
+          evalLisp env dcs ql proc >>= (flip (apply dcs ql)) [val]
 
 -- This creates an internal variable for each delay object where its value
 -- will be stored once it is forced. We avoid collisions with any symbols
@@ -614,14 +670,14 @@
 -- space: the parser won't let such strings through as symbols, so we are
 -- never in the situation where something might clash.
 
-evalLisp env _ (List [Symbol "delay", val]) =
+evalLisp env _ _ (List [Symbol "delay", val]) =
   do dval <- getVar env delayCounter
      let count = getInt dval
      do setVar env delayCounter (IntNumber (count + 1))
         return (Delay val env (" delay." ++ (show count)))
 
-evalLisp envc ql (List [Symbol "force", val]) =
-  do vali <- evalLisp envc ql val
+evalLisp envc dcs ql (List [Symbol "force", val]) =
+  do vali <- evalLisp envc dcs ql val
      if isDelay vali
         then do let (env, tag) = getTag vali
                 alreadyDef <- liftIO (isBound env tag)
@@ -632,13 +688,13 @@
   where isDelay (Delay _ _ _) = True
         isDelay _ = False
         getTag (Delay _ env tag) = (env, tag)
-        forceEval (Delay obj env _) = evalLisp env ql obj
+        forceEval (Delay obj env _) = evalLisp env dcs ql obj
 
-evalLisp env ql (List (Symbol "do" : List params : List test : body)) =
+evalLisp env dcs ql (List (Symbol "do" : List params : List test : body)) =
   if doCheck params
      then do let names = map exn params
                  steps = map exs params
-             inits <- mapM (evalLisp env ql) (map exi params)
+             inits <- mapM (evalLisp env dcs ql) (map exi params)
              envn <- liftIO (bindVars env (zip names inits))
              doloop envn names test steps
      else errBadForm "do" params
@@ -650,23 +706,67 @@
         exs (List [Symbol _, _, step]) = step
         doSet env (n,v) = setVar env n v
         doloop env names (test:rets) steps =
-          do tval <- evalLisp env ql test
+          do tval <- evalLisp env dcs ql test
              if isTrue tval
-                then mapML (evalLisp env ql) rets
-                else do mapM (evalLisp env ql) body
-                        svals <- mapM (evalLisp env ql) steps
+                then mapML (evalLisp env dcs ql) rets
+                else do mapM (evalLisp env dcs ql) body
+                        svals <- mapM (evalLisp env dcs ql) steps
                         mapM (doSet env) (zip names svals)
                         doloop env names (test:rets) steps
 
 -- This creates a new guaranteed-never-before-used symbol (and one which
 -- the user can't enter, so guaranteed no past present or future clashes).
 
-evalLisp env _ (List [Symbol "gensym"]) =
+evalLisp env _ _ (List [Symbol "gensym"]) =
   do sval <- getVar env symbolCounter
      let count = getInt sval
      do setVar env symbolCounter (IntNumber (count + 1))
         return (Symbol (" symbol." ++ (show count)))
 
+-- Delimited continuations -- two new special forms:
+-- (ext cont id expr ...) which is the translation of reset etc
+-- (int cont id flag1 flag2 expr ...) which is the translation of shift etc
+-- NOTE! 'int cont' and 'ext cont' are each a single symbol, with a
+-- space in the middle: this prevents the user from entering these directly
+-- ... well, not really, but it makes it enough harder that it has to be
+-- done intentionally: take an expression apart, rebuild it with a macro,
+-- and attempt to process that. If you do that, you deserve what you get.
+
+-- TODO: we may need to add individual ids to the DelCont... this is part
+-- of delcont.scm, although I don't quite understand it
+
+evalLisp env dcs ql (List ((Symbol "ext cont"):(Symbol id):args)) =
+  catchError (mapML (evalLisp env (args:dcs) ql) args)
+             (\val -> getVal val)
+  where getVal (DelCont val) = return val
+        getVal err = throwError err
+
+evalLisp env [] ql a@(List ((Symbol "int cont"):
+        (Symbol id):(Boolean f1):(Boolean f2):(Symbol fn):args)) =
+  throwError (BadSpecial "naked internal delcont form" a)
+
+-- TODO: does the isCont test need to be made more discriminating?
+-- check if it could perhaps fail with nested or multiple calls to the
+-- continuation function
+
+-- TODO: look into why some of the reset0/prompt/prompt0 examples are failing
+
+evalLisp env dcs ql (List ((Symbol "int cont"):
+        (Symbol id):(Boolean f1):(Boolean f2):(Symbol fn):args)) =
+  do isCont <- liftIO (isBound env id)
+     if isCont
+        then (getVar env id) >>= return
+        else do cbody <- wrapit f1 (head dcs)
+                func <- makeNormalFunc env [Symbol id] cbody
+                envn <- liftIO (bindVars env [(fn, func)])
+                ebody <- wrapit f2 args
+                mapML (evalLisp envn dcs ql) ebody >>= throwError . DelCont
+  where wrapit flag exs =
+          if flag
+             then do wrap <- evalPP env (List ((Symbol "RESET"):[lispFalse]))
+                     return [List ((take 2 (getList wrap)) ++ exs)]
+             else return exs
+
 -- This is not an R6RS special form, but it is a haskeem one: it needs
 -- to be, because we don't want to evaluate the function name, and we
 -- do want to be able to do stuff in the current environment, so that
@@ -680,11 +780,11 @@
 -- expression which evaluates to the symbol to trace, because we want
 -- to have a name: var is what gets used. Consider relaxing this?
 
-evalLisp env ql (List [Symbol "trace", Symbol var, sw]) =
+evalLisp env dcs ql (List [Symbol "trace", Symbol var, sw]) =
   if isSpecialForm (Symbol var)
      then throwError (Default "can't trace special forms")
-     else do val <- evalLisp env ql (Symbol var)
-             swval <- evalLisp env ql sw
+     else do val <- evalLisp env dcs ql (Symbol var)
+             swval <- evalLisp env dcs ql sw
              if isPr val
                 then throwError (Default "can't trace primitives")
                 else if (isF val)
@@ -713,9 +813,9 @@
 -- to be, because we want the ability to show the current environment
 -- rather than just the top-level one
 
-evalLisp env _ (List [Symbol "dump-bindings"]) = dumpEnv env stderr
-evalLisp env ql (List [Symbol "dump-bindings", val]) =
-  do vali <- evalLisp env ql val
+evalLisp env _ _ (List [Symbol "dump-bindings"]) = dumpEnv env stderr
+evalLisp env dcs ql (List [Symbol "dump-bindings", val]) =
+  do vali <- evalLisp env dcs ql val
      if isPort vali
         then dumpEnv env (getPort vali)
         else errBadForm "dump-bindings" [val]
@@ -726,18 +826,19 @@
 
 -- The generic (function : args) stuff; also macro expansion stuff
 -- For macro expansion, we evaluate once to get syntax back from the
--- macro, that's the "evalLisp env ql function", but then we change
+-- macro, that's the "evalLisp env dcs ql function", but then we change
 -- the environment to evaluate that syntax in the caller's environment.
 
-evalLisp env ql (List (function : args)) =
+evalLisp env dcs ql (List (function : args)) =
   if isSpecialForm function
      then throwError (BadSpecial "bad syntax for special form" function)
-     else do func <- evalLisp env ql function
+     else do func <- evalLisp env dcs ql function
              if isM func
-                then apply ql (chEnv func env) args >>=
+                then apply dcs ql (chEnv func env) args >>=
                      prtTrace (isT func) >>=
-                     evalLisp env ql
-                else mapM (evalLisp env ql) args >>= apply ql func
+                     evalPP env >>=
+                     evalLisp env dcs ql
+                else mapM (evalLisp env dcs ql) args >>= apply dcs ql func
   where isM (Func _ _ _ _ _ mac) = mac
         isM _ = False
         isT (Func _ _ _ _ (Just _) _) = True
@@ -749,5 +850,5 @@
              then remark ("   ->  " ++ (show vals)) >> return vals
              else return vals
 
-evalLisp _ _ badForm =
+evalLisp _ _ _ badForm =
   throwError (BadSpecial "Unrecognized special form" badForm)
diff --git a/Library.hs b/Library.hs
--- a/Library.hs
+++ b/Library.hs
@@ -1,8 +1,7 @@
 {- Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>
 Portions of this were derived from Jonathan Tang's haskell
 tutorial "Write yourself a scheme in 48 hours" and are thus
-Copyright Jonathan Tang
-(but I can't easily tell anymore who originally wrote what)
+Copyright Jonathan Tang (but there isn't much of his stuff left).
 
 This file is part of haskeem.
 haskeem is free software; you can redistribute it and/or modify
@@ -19,9 +18,10 @@
 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.37 2009-07-27 02:01:04 uwe Exp $ -}
+$Id: library.hs,v 1.39 2009-08-06 05:05:15 uwe Exp $ -}
 
-module Library (primitiveBindings, delayCounter, symbolCounter, loadFile, eqv)
+module Library (primitiveBindings, delayCounter, symbolCounter, contCounter,
+                loadFile, eqv)
   where
 import Prelude
 import IO
@@ -1643,6 +1643,8 @@
 -- is stored in the environment. It contains spaces, so that it is
 -- impossible for the user to enter this as a valid symbol. Ditto
 -- for symbolCounter: this is for generating new internal symbols.
+-- contCounter is for counting continuations operators; this could
+-- equally well be done by symbolCounter.
 
 delayCounter :: String
 delayCounter = " delay "
@@ -1650,9 +1652,13 @@
 symbolCounter :: String
 symbolCounter = " symbol "
 
+contCounter :: String
+contCounter = " continuation "
+
 internals :: [(String, LispVal)]
 internals = [(delayCounter, (IntNumber 0)),
-             (symbolCounter, (IntNumber 0))]
+             (symbolCounter, (IntNumber 0)),
+             (contCounter, (IntNumber 0))]
 
 primitiveBindings :: IO Env
 primitiveBindings = newIORef [] >>=
diff --git a/LispData.hs b/LispData.hs
--- a/LispData.hs
+++ b/LispData.hs
@@ -1,8 +1,7 @@
 {- Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>
 Portions of this were derived from Jonathan Tang's haskell
 tutorial "Write yourself a scheme in 48 hours" and are thus
-Copyright Jonathan Tang
-(but I can't easily tell anymore who originally wrote what)
+Copyright Jonathan Tang (but there isn't much of his stuff left).
 
 This file is part of haskeem.
 haskeem is free software; you can redistribute it and/or modify
@@ -19,14 +18,15 @@
 along with haskeem; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-$Id: lispdata.hs,v 1.15 2009-06-29 00:23:01 uwe Exp $ -}
+$Id: lispdata.hs,v 1.17 2009-08-06 05:05:15 uwe Exp $ -}
 
 module LispData
     (LispVal(Symbol, Boolean, Char, Delay, DottedList, IntNumber,
              RatNumber, FltNumber, Func, IOPrim, List, Port, Prim,
              Socket, String, Vector),
      LispError(NumArgs, TypeMismatch, Parser, BadSpecial, NotFunction,
-               UnboundVar, Default, OutOfRange, VectorBounds, UserException),
+               UnboundVar, Default, OutOfRange, VectorBounds, UserException,
+               DelCont),
      ThrowsError, Env, IOThrowsError, liftThrows,
      myRatPInf, myRatNInf, myRatNaN, myFltPInf, myFltNInf, myFltNaN,
      lispTrue, lispFalse) where
@@ -144,7 +144,8 @@
 lispTrue = Boolean True
 lispFalse = Boolean False
 
--- A lisp error: these get processed when an error of some kind occurs
+-- A lisp error: these get processed when an error of some kind occurs;
+-- a DelCont isn't an error, but it is an unusual condition...
 
 data LispError = NumArgs String Integer [LispVal]
                | TypeMismatch String String LispVal
@@ -156,6 +157,7 @@
                | OutOfRange String Double
                | VectorBounds Integer LispVal
                | UserException LispVal
+               | DelCont LispVal
 
 instance Show LispError where show = showError
 
@@ -179,6 +181,7 @@
   "vector index out of bounds: " ++ (show n) ++
   " not in [0.." ++ (show (len - 1)) ++ "]"
 showError (UserException val) = "user exception " ++ (show val)
+showError (DelCont val) = "delcont value " ++ (show val)
 
 type ThrowsError = Either LispError
 
diff --git a/Parser.hs b/Parser.hs
--- a/Parser.hs
+++ b/Parser.hs
@@ -1,8 +1,7 @@
 {- Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>
 Portions of this were derived from Jonathan Tang's haskell
 tutorial "Write yourself a scheme in 48 hours" and are thus
-Copyright Jonathan Tang
-(but I can't easily tell anymore who originally wrote what)
+Copyright Jonathan Tang (but there isn't much of his stuff left).
 
 This file is part of haskeem.
 haskeem is free software; you can redistribute it and/or modify
@@ -19,7 +18,7 @@
 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.15 2009-07-27 02:01:04 uwe Exp $ -}
+$Id: parser.hs,v 1.16 2009-08-06 05:05:15 uwe Exp $ -}
 
 module Parser (readExpr, readExprList, readNumber, specialSymbolChars) where
 import Prelude
diff --git a/WriteNumber.hs b/WriteNumber.hs
--- a/WriteNumber.hs
+++ b/WriteNumber.hs
@@ -1,8 +1,7 @@
 {- Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>
 Portions of this were derived from Jonathan Tang's haskell
 tutorial "Write yourself a scheme in 48 hours" and are thus
-Copyright Jonathan Tang
-(but I can't easily tell anymore who originally wrote what)
+Copyright Jonathan Tang (but there isn't much of his stuff left).
 
 This file is part of haskeem.
 haskeem is free software; you can redistribute it and/or modify
@@ -19,7 +18,7 @@
 along with haskeem; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-$Id: writenumber.hs,v 1.14 2009-05-31 01:41:08 uwe Exp $ -}
+$Id: writenumber.hs,v 1.15 2009-08-06 05:05:15 uwe Exp $ -}
 
 module WriteNumber (writeNum, ilogb) where
 import Prelude
diff --git a/callcc.scm b/callcc.scm
--- a/callcc.scm
+++ b/callcc.scm
@@ -1,5 +1,5 @@
 ; Copyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>
-; $Id: callcc.scm,v 1.2 2009-07-11 03:59:28 uwe Exp $
+; $Id: callcc.scm,v 1.4 2009-08-06 04:19:18 uwe Exp $
 ; BSD3
 
 ; "poor man's" continuations: one-shot, limited lifespan, and while they
@@ -15,6 +15,44 @@
 
 (defmacro (let/cc1 k . body)
   `(call/cc1 (lambda (,k) ,@body)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+; From Queinnec, "A Library of Continuations":
+; call/cc via delimited continuations
+; This obviously requires that reset/shift or prompt/control
+; can handle the whole enchilada, not just within a single s-expr
+
+; call/cc expressed via prompt/control: given a program P which
+; does not use prompt/control, provide call/cc as
+
+; I think this uses different syntax than my version...
+; (control (lambda (pc) ...)) -> (control pc ...) in mine;
+; more like the reset/shift version below
+
+;;(let ()
+;;  (define (call/cc f)
+;;    (control (lambda (pc)
+;;	       (pc (f (lambda (v)
+;;			(control (lambda (ignore-pc) (pc v)))))))))
+;;  (prompt P))
+
+; translated into my version... I think
+
+;;(let ()
+;;  (define (call/cc f)
+;;    (control pc (pc (f (lambda (v)
+;;			 (control ignore-pc (pc v)))))))
+;;  (prompt P))
+
+; call/cc expressed via reset/shift: given a program P which
+; does not use reset/shift, provide call/cc as
+
+;;(let ()
+;;  (define (call/cc f)
+;;    (shift pc (pc (f (lambda (v)
+;;		       (shift ignore-pc (pc v)))))))
+;;  (reset P))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; some tests
diff --git a/delTEST.scm b/delTEST.scm
new file mode 100644
--- /dev/null
+++ b/delTEST.scm
@@ -0,0 +1,642 @@
+; (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 "r  should be 6\t\t")
+(sandbox
+ (display (+ 1 (RESET (+ 2 3))))
+ (newline))
+
+(write-string "r  should be (1 2)\t")
+(sandbox
+ (display (cons 1 (RESET (cons 2 '()))))
+ (newline))
+
+(write-string "r  should be 4\t\t")
+(sandbox
+ (display (+ 1 (RESET (+ 2 (SHIFT k 3)))))
+ (newline))
+
+(write-string "r  should be (1 3)\t")
+(sandbox
+ (display (cons 1 (RESET (cons 2 (SHIFT k (cons 3 '()))))))
+ (newline))
+
+(write-string "r  should be 10\t\t")
+(sandbox
+ (display (+ 1 (RESET (+ 2 (SHIFT k (+ 3 (k 4)))))))
+ (newline))
+
+(write-string "r  should be 14\t\t")
+(sandbox
+ (display (+ 1 (RESET (+ 2 (SHIFT k (+ 3 (k 5) (k 1)))))))
+ (newline))
+
+(write-string "r  should be (1 3 2 4)\t")
+(sandbox
+ (display (cons 1 (RESET (cons 2 (SHIFT k (cons 3 (k (cons 4 '()))))))))
+ (newline))
+
+(write-string "r  should be (1 3 2 2 4)\t")
+(sandbox
+ (display (cons 1 (RESET (cons 2 (SHIFT k (cons 3 (k (k (cons 4 '())))))))))
+ (newline))
+
+(write-string "multiple SHIFTs\n")
+
+(write-string "r  should be 2\t\t")
+(sandbox
+ (RESET (display (begin (SHIFT k1 (k1 1)) (SHIFT k2 (k2 2)))))
+ (newline))
+
+; haskeem fails this -- restart issue
+(write-string "r  should be 12\t\t")
+(sandbox
+ (RESET (begin (display (SHIFT k1 (k1 1))) (display (SHIFT k2 (k2 2)))))
+ (newline))
+
+(write-string "r  should be 12\t\t")
+(sandbox
+ (RESET (display (SHIFT k1 (k1 1))) (display (SHIFT k2 (k2 2))))
+ (newline))
+
+(write-string "r0 should be 134234\t")
+(sandbox
+ (RESET0 (begin (SHIFT0 k1 (begin (k1 (display 1)) (k1 (display 2))))
+		(SHIFT0 k2 (begin (k2 (display 3)) (k2 (display 4))))))
+ (newline))
+
+(write-string "r0 should be 134234\t")
+(sandbox
+ (RESET0 (begin (SHIFT0 k1 (k1 (display 1)) (k1 (display 2)))
+		(SHIFT0 k2 (k2 (display 3)) (k2 (display 4)))))
+ (newline))
+
+(write-string "r0 should be 134234\t")
+(sandbox
+ (RESET0 (SHIFT0 k1 (k1 (display 1)) (k1 (display 2)))
+	 (SHIFT0 k2 (k2 (display 3)) (k2 (display 4))))
+ (newline))
+
+(write-string "r0 should be 13564562356456\n\t     ")
+(sandbox
+ (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 "r  should be 57\t\t")
+(sandbox
+ (display (+ 1 (RESET (+ 2 (SHIFT k1 (+ 3
+					(k1 5)
+					(k1 1)
+					(RESET (* 10 (SHIFT k2 (+ 3 (k2 4)))))
+					))))))
+ (newline))
+
+(write-string "r  should be 59\t\t")
+(sandbox
+ (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 "r  should be 1 3 2\t")
+(sandbox
+ (RESET (begin (write-string "1 ")
+	       (SHIFT c (begin (c 'ignore)
+			       (write-string "2 ")))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 3 2\t")
+(sandbox
+ (RESET (begin (write-string "1 ")
+	       (SHIFT c (c 'ignore) (write-string "2 "))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 3 2\t")
+(sandbox
+ (RESET (write-string "1 ")
+	(SHIFT c (c 'ignore) (write-string "2 "))
+	(write-string "3 "))
+ (newline))
+
+(write-string "r  should be 1 2 3\t")
+(sandbox
+ (RESET (begin (write-string "1 ")
+	       (SHIFT c (begin (write-string "2 ")
+			       (c 'ignore)))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 2 3\t")
+(sandbox
+ (RESET (begin (write-string "1 ")
+	       (SHIFT c (write-string "2 ") (c 'ignore))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 2 3\t")
+(sandbox
+ (RESET (write-string "1 ")
+	(SHIFT c (write-string "2 ") (c 'ignore))
+	(write-string "3 "))
+ (newline))
+
+(write-string "r  should be 1 3 2 3\t")
+(sandbox
+ (RESET (begin (write-string "1 ")
+	       (SHIFT c (begin (c 'ignore)
+			       (write-string "2 ")
+			       (c 'ignore)))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 3 2 3\t")
+(sandbox
+ (RESET (begin (write-string "1 ")
+	       (SHIFT c (c 'ignore) (write-string "2 ") (c 'ignore))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 3 2 3\t")
+(sandbox
+ (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 "r  should be (a)\t")
+(sandbox
+ (display (RESET (cons 'a (RESET (SHIFT f (SHIFT g '()))))))
+ (newline))
+
+(write-string "r0 should be ()\t\t")
+(sandbox
+ (display (RESET0 (cons 'a (RESET0 (SHIFT0 f (SHIFT0 g '()))))))
+ (newline))
+
+(write-string "r  should be (a)\t")
+(sandbox
+ (display (RESET (let ((y (SHIFT f (cons 'a (f '()))))) (SHIFT g y))))
+ (newline))
+
+(write-string "p  should be ()\t\t")
+(sandbox
+ (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 "r  should be (a)\t")
+(sandbox
+ (display (RESET (let ((y (SHIFT f (cons 'a (f '()))))) (SHIFT g y))))
+ (newline))
+
+(write-string "r0 should be (a)\t")
+(sandbox
+ (display (RESET0 (let ((y (SHIFT0 f (cons 'a (f '()))))) (SHIFT0 g y))))
+ (newline))
+
+(write-string "p  should be ()\t\t")
+(sandbox
+ (display (PROMPT (let ((y (CONTROL f (cons 'a (f '()))))) (CONTROL g y))))
+ (newline))
+
+(write-string "p0 should be ()\t\t")
+(sandbox
+ (display
+  (RESET (PROMPT0 (let ((y (CONTROL0 f (cons 'a (f '()))))) (CONTROL0 g y)))))
+ (newline))
+
+(write-string "r  should be (a b)\t")
+(sandbox
+ (display
+  (RESET
+   (RESET (cons 'a (RESET
+		    (let ((y (SHIFT f (SHIFT g (cons 'b (f '()))))))
+		      (SHIFT h y)))))))
+ (newline))
+
+(write-string "p  should be (a)\t")
+(sandbox
+ (display
+  (PROMPT
+   (PROMPT (cons 'a (PROMPT
+		     (let ((y (CONTROL f (CONTROL g (cons 'b (f '()))))))
+		       (CONTROL h y)))))))
+ (newline))
+
+(write-string "r0 should be (b)\t")
+(sandbox
+ (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 "p0 should be ()\t\t")
+(sandbox
+ (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 "r  should be (1 3)\t")
+      (write-string "r  should be (1 4 2 5)\t"))
+  (sandbox
+   (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 "r  should be (1 4 2 5)\t")
+      (write-string "r  should be (1 3)\t"))
+  (sandbox
+   (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 "r  should be (1 4 3)\t")	; independent of flag
+  (sandbox
+   (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 "r  should be (1 4 2 3)\t")
+      (write-string "r  should be (1 4 2 5)\t"))
+  (sandbox
+   (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 "r  should be (1 3 2 4)\t")
+      (write-string "r  should be (1 5 2 6)\t"))
+  (sandbox
+   (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)
+
+(write-string
+ "test 6: modified version of test 5, with (if) lifted out of (RESET)\n")
+
+(define (doit6 flag)
+  (if flag
+      (write-string "r  should be (1 3 2 4)\t")
+      (write-string "r  should be (1 5 2 6)\t"))
+  (sandbox
+   (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")
+(sandbox
+ (display (PROMPT (* 2 (CONTROL f 3))))
+ (newline))
+
+(write-string "should be 30\t\t")
+(sandbox
+ (display (PROMPT (* 2 (CONTROL f (* 5 (f 3))))))
+ (newline))
+
+(write-string "should be 12\t\t")
+(sandbox
+ (display (PROMPT (* 2 (CONTROL f (f (f 3))))))
+ (newline))
+
+(write-string "should be 6\t\t")
+(sandbox
+ (display ((PROMPT (* 2 (CONTROL f f))) 3))
+ (newline))
+
+(write-string "should be 35\t\t")
+(sandbox
+ (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")
+(sandbox
+ (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")
+(sandbox
+ (display (PROMPT0 (* 2 (CONTROL0 f 3))))
+ (newline))
+
+(write-string "should be 30\t\t")
+(sandbox
+ (display (PROMPT0 (* 2 (CONTROL0 f (* 5 (f 3))))))
+ (newline))
+
+(write-string "should be 12\t\t")
+(sandbox
+ (display (PROMPT0 (* 2 (CONTROL0 f (f (f 3))))))
+ (newline))
+
+(write-string "should be 6\t\t")
+(sandbox
+ (display ((PROMPT0 (* 2 (CONTROL0 f f))) 3))
+ (newline))
+
+(write-string "should be 7\t\t")
+(sandbox
+ (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")
+(sandbox
+ (display (RESET (* 2 (SHIFT f 3))))
+ (newline))
+
+(write-string "should be 30\t\t")
+(sandbox
+ (display (RESET (* 2 (SHIFT f (* 5 (f 3))))))
+ (newline))
+
+(write-string "should be 12\t\t")
+(sandbox
+ (display (RESET (* 2 (SHIFT f (f (f 3))))))
+ (newline))
+
+(write-string "should be 6\t\t")
+(sandbox
+ (display ((RESET (* 2 (SHIFT f f))) 3))
+ (newline))
+
+(write-string "should be 35\t\t")
+(sandbox
+ (display (RESET (* 5
+		    (RESET (* 2
+			      (SHIFT f2 (* 3 (SHIFT f3 7))))))))
+ (newline))
+
+(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")
+(sandbox
+ (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")
+(sandbox
+ (display (RESET0 (* 2 (SHIFT0 f 3))))
+ (newline))
+
+(write-string "should be 30\t\t")
+(sandbox
+ (display (RESET0 (* 2 (SHIFT0 f (* 5 (f 3))))))
+ (newline))
+
+(write-string "should be 12\t\t")
+(sandbox
+ (display (RESET0 (* 2 (SHIFT0 f (f (f 3))))))
+ (newline))
+
+(write-string "should be 6\t\t")
+(sandbox
+ (display ((RESET0 (* 2 (SHIFT0 f f))) 3))
+ (newline))
+
+(write-string "should be 7\t\t")
+(sandbox
+ (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")
+(sandbox
+ (display (RESET0 (* 5
+		     ((lambda (x) (SHIFT0 f1 x))
+		      (* 3 (SHIFT0 f2 (* 2 (f2 7))))))))
+ (newline))
+
+(write-string "r  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)
+
+(sandbox
+ (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)
+  (sandbox
+   (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))))))
+(write-string
+ "haskeem should have caught the exception raised by the syntax error\n")
diff --git a/deltest.scm b/deltest.scm
--- a/deltest.scm
+++ b/deltest.scm
@@ -18,170 +18,200 @@
 
 (write-string "examples from community.schemewiki.org\n")
 
-(write-string "should be 6\t\t")
-(display (+ 1 (reset (+ 2 3))))
-(newline)
+(write-string "r  should be 6\t\t")
+(sandbox
+ (display (+ 1 (reset (+ 2 3))))
+ (newline))
 
-(write-string "should be (1 2)\t\t")
-(display (cons 1 (reset (cons 2 '()))))
-(newline)
+(write-string "r  should be (1 2)\t")
+(sandbox
+ (display (cons 1 (reset (cons 2 '()))))
+ (newline))
 
-(write-string "should be 4\t\t")
-(display (+ 1 (reset (+ 2 (shift k 3)))))
-(newline)
+(write-string "r  should be 4\t\t")
+(sandbox
+ (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 "r  should be (1 3)\t")
+(sandbox
+ (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 "r  should be 10\t\t")
+(sandbox
+ (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 "r  should be 14\t\t")
+(sandbox
+ (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 "r  should be (1 3 2 4)\t")
+(sandbox
+ (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 "r  should be (1 3 2 2 4)\t")
+(sandbox
+ (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)
+(write-string "r  should be 2\t\t")
+(sandbox
+ (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 "r  should be 12\t\t")
+(sandbox
+ (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 "r  should be 12\t\t")
+(sandbox
+ (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 "r0 should be 134234\t")
+(sandbox
+ (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 "r0 should be 134234\t")
+(sandbox
+ (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 "r0 should be 134234\t")
+(sandbox
+ (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 "r0 should be 13564562356456\n\t     ")
+(sandbox
+ (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 "r  should be 57\t\t")
+(sandbox
+ (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)
+(write-string "r  should be 59\t\t")
+(sandbox
+ (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 "r  should be 1 3 2\t")
+(sandbox
+ (reset (begin (write-string "1 ")
+	       (shift c (begin (c 'ignore)
+			       (write-string "2 ")))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 3 2\t")
+(sandbox
+ (reset (begin (write-string "1 ")
+	       (shift c (c 'ignore) (write-string "2 "))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 3 2\t")
+(sandbox
+ (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 "r  should be 1 2 3\t")
+(sandbox
+ (reset (begin (write-string "1 ")
+	       (shift c (begin (write-string "2 ")
+			       (c 'ignore)))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 2 3\t")
+(sandbox
+ (reset (begin (write-string "1 ")
+	       (shift c (write-string "2 ") (c 'ignore))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 2 3\t")
+(sandbox
+ (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 "r  should be 1 3 2 3\t")
+(sandbox
+ (reset (begin (write-string "1 ")
+	       (shift c (begin (c 'ignore)
+			       (write-string "2 ")
+			       (c 'ignore)))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 3 2 3\t")
+(sandbox
+ (reset (begin (write-string "1 ")
+	       (shift c (c 'ignore) (write-string "2 ") (c 'ignore))
+	       (write-string "3 ")))
+ (newline))
+(write-string "r  should be 1 3 2 3\t")
+(sandbox
+ (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 "r  should be (a)\t")
+(sandbox
+ (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 "r0 should be ()\t\t")
+(sandbox
+ (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 "r  should be (a)\t")
+(sandbox
+ (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)
+(write-string "p  should be ()\t\t")
+(sandbox
+ (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.
@@ -199,68 +229,77 @@
 ;;;	      (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 "r  should be (a)\t")
+(sandbox
+ (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 "r0 should be (a)\t")
+(sandbox
+ (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 "p  should be ()\t\t")
+(sandbox
+ (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 "p0 should be ()\t\t")
+(sandbox
+ (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 "r  should be (a b)\t")
+(sandbox
+ (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 "p  should be (a)\t")
+(sandbox
+ (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)
+(write-string "r0 should be (b)\t")
+(sandbox
+ (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 "p0 should be ()\t\t")
+(sandbox
+ (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))
+      (write-string "r  should be (1 3)\t")
+      (write-string "r  should be (1 4 2 5)\t"))
+  (sandbox
+   (display
+    (cons 1 (reset (cons 2 (if flag
+			       (shift k1 (cons 3 '()))
+			       (shift k2 (cons 4 (k2 (cons 5 '())))))))))
+   (newline)))
 
 (doit1 #f)
 (doit1 #t)
@@ -268,13 +307,14 @@
 (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))
+      (write-string "r  should be (1 4 2 5)\t")
+      (write-string "r  should be (1 3)\t"))
+  (sandbox
+   (display
+    (cons 1 (reset (cons 2 (if flag
+			       (shift k2 (cons 4 (k2 (cons 5 '()))))
+			       (shift k1 (cons 3 '())))))))
+   (newline)))
 
 (doit2 #f)
 (doit2 #t)
@@ -282,16 +322,16 @@
 (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))
+  (write-string "r  should be (1 4 3)\t")	; independent of flag
+  (sandbox
+   (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)
@@ -299,15 +339,15 @@
 (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))
+      (write-string "r  should be (1 4 2 3)\t")
+      (write-string "r  should be (1 4 2 5)\t"))
+  (sandbox
+   (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)
@@ -315,35 +355,33 @@
 (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))
+      (write-string "r  should be (1 3 2 4)\t")
+      (write-string "r  should be (1 5 2 6)\t"))
+  (sandbox
+   (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))
+      (write-string "r  should be (1 3 2 4)\t")
+      (write-string "r  should be (1 5 2 6)\t"))
+  (sandbox
+   (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)
@@ -352,26 +390,31 @@
 
 (write-string "prompt/control examples\n")
 (write-string "should be 3\t\t")
-(display (prompt (* 2 (control f 3))))
-(newline)
+(sandbox
+ (display (prompt (* 2 (control f 3))))
+ (newline))
 
 (write-string "should be 30\t\t")
-(display (prompt (* 2 (control f (* 5 (f 3))))))
-(newline)
+(sandbox
+ (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)
+(sandbox
+ (display (prompt (* 2 (control f (f (f 3))))))
+ (newline))
 
 (write-string "should be 6\t\t")
-(display ((prompt (* 2 (control f f))) 3))
-(newline)
+(sandbox
+ (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)
+(sandbox
+ (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
@@ -387,33 +430,39 @@
  (newline))
 
 (write-string "should be 21\t\t")
-(display (prompt (* 5
-		    ((lambda (x) (control f1 x))
-		     (* 3 (control f2 (* 2 (f2 7))))))))
-(newline)
+(sandbox
+ (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)
+(sandbox
+ (display (prompt0 (* 2 (control0 f 3))))
+ (newline))
 
 (write-string "should be 30\t\t")
-(display (prompt0 (* 2 (control0 f (* 5 (f 3))))))
-(newline)
+(sandbox
+ (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)
+(sandbox
+ (display (prompt0 (* 2 (control0 f (f (f 3))))))
+ (newline))
 
 (write-string "should be 6\t\t")
-(display ((prompt0 (* 2 (control0 f f))) 3))
-(newline)
+(sandbox
+ (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)
+(sandbox
+ (display (prompt0 (* 5
+		      (prompt0 (* 2
+				  (control0 f2 (* 3 (control0 f3 7))))))))
+ (newline))
 
 (write-string "should be 7\t\t")
 (sandbox
@@ -438,31 +487,31 @@
 
 (write-string "reset/shift examples\n")
 (write-string "should be 3\t\t")
-(display (reset (* 2 (shift f 3))))
-(newline)
+(sandbox
+ (display (reset (* 2 (shift f 3))))
+ (newline))
 
 (write-string "should be 30\t\t")
-(display (reset (* 2 (shift f (* 5 (f 3))))))
-(newline)
+(sandbox
+ (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)
+(sandbox
+ (display (reset (* 2 (shift f (f (f 3))))))
+ (newline))
 
 (write-string "should be 6\t\t")
-(display ((reset (* 2 (shift f f))) 3))
-(newline)
+(sandbox
+ (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
+(sandbox
+ (display (reset (* 5
+		    (reset (* 2
+			      (shift f2 (* 3 (shift f3 7))))))))
+ (newline))
 
 (write-string "should be 7\t\t")
 (sandbox
@@ -473,33 +522,39 @@
  (newline))
 
 (write-string "should be 42\t\t")
-(display (reset (* 5
-		   ((lambda (x) (shift f1 x))
-		    (* 3 (shift f2 (* 2 (f2 7))))))))
-(newline)
+(sandbox
+ (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)
+(sandbox
+ (display (reset0 (* 2 (shift0 f 3))))
+ (newline))
 
 (write-string "should be 30\t\t")
-(display (reset0 (* 2 (shift0 f (* 5 (f 3))))))
-(newline)
+(sandbox
+ (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)
+(sandbox
+ (display (reset0 (* 2 (shift0 f (f (f 3))))))
+ (newline))
 
 (write-string "should be 6\t\t")
-(display ((reset0 (* 2 (shift0 f f))) 3))
-(newline)
+(sandbox
+ (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)
+(sandbox
+ (display (reset0 (* 5
+		     (reset0 (* 2
+				(shift0 f2 (* 3 (shift0 f3 7))))))))
+ (newline))
 
 (write-string "should be 7\t\t")
 (sandbox
@@ -510,12 +565,13 @@
  (newline))
 
 (write-string "should be 42\t\t")
-(display (reset0 (* 5
-		   ((lambda (x) (shift0 f1 x))
-		    (* 3 (shift0 f2 (* 2 (f2 7))))))))
-(newline)
+(sandbox
+ (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")
+(write-string "r  something actually useful! a small table of factorials\n")
 
 ; Eventually we want to be able to use code like this:
 
@@ -541,14 +597,15 @@
 (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))
+(sandbox
+ (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
@@ -561,14 +618,15 @@
 (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))
+  (sandbox
+   (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
@@ -580,3 +638,5 @@
  "syntax error coming up! should be an error... this'll kill mzscheme\n")
 
 (sandbox (display (+ 1 (reset (+ 2 (shift (+ k 1) 3))))))
+(write-string
+ "haskeem should have caught the exception raised by the syntax error\n")
diff --git a/haskeem.cabal b/haskeem.cabal
--- a/haskeem.cabal
+++ b/haskeem.cabal
@@ -1,5 +1,5 @@
 Name:             haskeem
-Version:          0.7.9
+Version:          0.7.12
 Homepage:         http://www.korgwal.com/haskeem/
 Author:           Uwe Hollerbach <uh@alumni.caltech.edu>
 Maintainer:       Uwe Hollerbach <uh@alumni.caltech.edu>
@@ -7,11 +7,11 @@
 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
-                  scheme, it should be pretty good.
+                  continuations, reset/shift et al. 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 scheme,
+                  it should be pretty good.
 License:          GPL
 License-File:     LICENSE
 Cabal-Version:    >= 1.2
diff --git a/haskeem.hs b/haskeem.hs
--- a/haskeem.hs
+++ b/haskeem.hs
@@ -1,8 +1,7 @@
 {- Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>
 Portions of this were derived from Jonathan Tang's haskell
 tutorial "Write yourself a scheme in 48 hours" and are thus
-Copyright Jonathan Tang
-(but I can't easily tell anymore who originally wrote what)
+Copyright Jonathan Tang (but there isn't much of his stuff left).
 
 This file is part of haskeem.
 haskeem is free software; you can redistribute it and/or modify
@@ -19,7 +18,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.38 2009-07-27 04:46:22 uwe Exp $ -}
+$Id: haskeem.hs,v 1.43 2009-08-08 05:09:00 uwe Exp $ -}
 
 module Main where
 import Prelude
@@ -43,7 +42,7 @@
 -- haskeem version
 
 version :: String
-version = "0.7.9"
+version = "0.7.12"
 
 -- a variable under which any command-line arguments to a script are
 -- made available; empty for interactive mode
@@ -63,7 +62,7 @@
 evalAndPrint :: Env -> Bool -> String -> InputT IO ()
 evalAndPrint env pflag expr =
   do ret <- liftIO (runErrorT (liftThrows (readExpr (dropWhile isSpace expr))
-              >>= evalLisp env 0))
+              >>= evalPP env >>= evalLisp env [] 0))
      case ret of
           Left err -> outputStrLn (show err)
           Right val -> if pflag then outputStrLn (show val) else outputStr ""
diff --git a/haskeem_readline.hs b/haskeem_readline.hs
--- a/haskeem_readline.hs
+++ b/haskeem_readline.hs
@@ -1,8 +1,7 @@
 {- Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>
 Portions of this were derived from Jonathan Tang's haskell
 tutorial "Write yourself a scheme in 48 hours" and are thus
-Copyright Jonathan Tang
-(but I can't easily tell anymore who originally wrote what)
+Copyright Jonathan Tang (but there isn't much of his stuff left).
 
 This file is part of haskeem.
 haskeem is free software; you can redistribute it and/or modify
@@ -25,14 +24,14 @@
 import Prelude
 import IO
 import System
-import Monad
+import Monad()
 import Control.Monad.Error as CME
 import Control.OldException as CE
 import Data.Char
 -- import System.Console.Readline
-import System.Posix.Signals
-import Control.Concurrent
-import Data.Typeable
+import System.Posix.Signals()
+import Control.Concurrent()
+import Data.Typeable()
 
 import LispData
 import Parser
@@ -43,7 +42,7 @@
 -- haskeem version
 
 version :: String
-version = "0.7.9"
+version = "0.7.12"
 
 -- a variable under which any command-line arguments to a script are
 -- made available; empty for interactive mode
@@ -61,11 +60,12 @@
 -- (but errors are always printed)
 
 evalAndPrint :: Env -> Bool -> String -> IO ()
-evalAndPrint env print expr =
-  do ret <- runErrorT (liftThrows (readExpr expr) >>= evalLisp env 0)
+evalAndPrint env pflag expr =
+  do ret <- runErrorT (liftThrows (readExpr (dropWhile isSpace expr))
+              >>= evalPP env >>= evalLisp env [] 0)
      case ret of
           Left err -> hPutStrLn stderr (show err)
-          Right val -> if print then putStrLn (show val) else putStr ""
+          Right val -> if pflag then putStrLn (show val) else putStr ""
 
 -- if the environment variable HASKEEM_INIT is set, try to load that file
 
@@ -73,7 +73,8 @@
 runInit env =
   (do ret <- CE.try (getEnv "HASKEEM_INIT")
       case ret of
-           Left err -> return "(write-string \"no init file loaded\n\")"
+           Left err -> return ("(write-string \"no init file loaded: " ++
+                               show err ++ "\n\")")
            Right val -> return ("(load \"" ++ val ++ "\")")) >>=
     evalAndPrint env False
 
diff --git a/stdlib.scm b/stdlib.scm
--- a/stdlib.scm
+++ b/stdlib.scm
@@ -1,8 +1,7 @@
 ; Copyright 2008 Uwe Hollerbach <uh@alumni.caltech.edu>
 ; Portions of this were derived from Jonathan Tang's haskell
 ; tutorial "Write yourself a scheme in 48 hours" and are thus
-; Copyright Jonathan Tang
-; (but I can't easily tell anymore who originally wrote what)
+; Copyright Jonathan Tang (but there isn't much of his stuff left).
 
 ; This file is part of haskeem.
 ; haskeem is free software; you can redistribute it and/or modify
@@ -19,7 +18,7 @@
 ; along with haskeem; if not, write to the Free Software
 ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
 
-; $Id: stdlib.scm,v 1.42 2009-07-03 23:17:01 uwe Exp $
+; $Id: stdlib.scm,v 1.43 2009-08-06 05:05:15 uwe Exp $
 
 ; The haskeem standard library
 
@@ -111,12 +110,13 @@
 
 (define (compose f g) (lambda args (apply f (apply g args))))
 
-;;; (define fcdr (compose force cdr))
-(define (fcdr x)
-  (let ((cx (cdr x)))
-    (if (promise? cx)
-	(force cx)
-	cx)))
+(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)