diff --git a/Evaluator.hs b/Evaluator.hs
--- a/Evaluator.hs
+++ b/Evaluator.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: evaluator.hs,v 1.32 2009-06-29 03:59:13 uwe Exp $ -}
+$Id: evaluator.hs,v 1.35 2009-07-04 07:47:22 uwe Exp $ -}
 
 module Evaluator (evalLisp) where
 import Prelude
@@ -45,9 +45,12 @@
 
 progError = error "internal error!"
 
-lastOrNil = liftM lON
-  where lON [] = List []
-        lON l = last l
+{-# INLINE mapML #-}
+mapML fn lst = mapMLA (List []) fn lst
+  where mapMLA r _ [] = return r
+        mapMLA ro fn (x:xs) =
+           do rn <- fn x
+              mapMLA rn fn xs
 
 isTrue :: LispVal -> Bool
 isTrue (Boolean False) = False
@@ -108,7 +111,7 @@
                 bindVarArgs varargs >>= evalBody
   where remainingArgs = drop (length params) args
         num = toInteger . length
-        evalBody env = lastOrNil (mapM (evalLisp env ql) body)
+        evalBody env = mapML (evalLisp env ql) body
         bindVarArgs arg env =
           case arg of
                Just argName ->
@@ -139,40 +142,40 @@
 makeNormalMacro = makeMacro Nothing
 makeVarargsMacro = makeMacro . Just . show
 
-isSpecialForm :: LispVal -> Bool
-isSpecialForm (Symbol "and") = True
-isSpecialForm (Symbol "apply") = True
-isSpecialForm (Symbol "begin") = True
-isSpecialForm (Symbol "case") = True
-isSpecialForm (Symbol "cond") = True
-isSpecialForm (Symbol "define") = True
-isSpecialForm (Symbol "defmacro") = True
-isSpecialForm (Symbol "delay") = True
-isSpecialForm (Symbol "do") = True
-isSpecialForm (Symbol "eval") = True
-isSpecialForm (Symbol "force") = True
-isSpecialForm (Symbol "guard") = True
-isSpecialForm (Symbol "if") = True
-isSpecialForm (Symbol "lambda") = True
-isSpecialForm (Symbol "let") = True
-isSpecialForm (Symbol "let*") = True
-isSpecialForm (Symbol "letrec") = True
-isSpecialForm (Symbol "letrec*") = True
-isSpecialForm (Symbol "load") = True
-isSpecialForm (Symbol "new-symbol") = True
-isSpecialForm (Symbol "or") = True
-isSpecialForm (Symbol "quasiquote") = True
-isSpecialForm (Symbol "quote") = True
-isSpecialForm (Symbol "set!") = True
-isSpecialForm (Symbol "unquote") = True
-isSpecialForm (Symbol "unquote-splicing") = True
-isSpecialForm (Symbol "vector-fill!") = True
-isSpecialForm (Symbol "vector-set!") = True
+specialForms = ["and", "apply", "begin", "case", "cond", "define",
+                "defmacro", "delay", "do", "eval", "force", "gensym",
+                "guard", "if", "lambda", "let", "let*", "letrec",
+                "letrec*", "load", "or", "quasiquote", "quote", "set!",
+                "unquote", "unquote-splicing", "vector-fill!",
+                "vector-set!", "trace", "dump-bindings"]
 
-isSpecialForm (Symbol "trace") = True
-isSpecialForm (Symbol "dump-bindings") = True
+isSpecialForm (Symbol s) = seek s specialForms
+  where seek _ [] = False
+        seek s (sf:sfs) = if s == sf then True else seek s sfs
 isSpecialForm _ = False
 
+isInt (IntNumber _) = True
+isInt _ = False
+getInt (IntNumber n) = n
+
+isStr (String _) = True
+isStr _ = False
+getStr (String s) = s
+
+isList (List _) = True
+isList _ = False
+getList (List l) = l
+
+isDL (DottedList _ _) = True
+isDL _ = False
+getDLh (DottedList h _) = h
+getDLt (DottedList _ t) = t
+
+isVec (Vector _ _) = True
+isVec _ = False
+getVecL (Vector l _) = l
+getVecV (Vector _ v) = v
+
 -- This is an internal symbol which temporarily replaces "unquote" and
 -- "unquote-splicing" after these have evaluated the expression(s): evalQQ
 -- looks for this marker and lifts the remainder of the list up by one
@@ -230,15 +233,15 @@
 evalQQ env ql (List (Symbol "unquote-splicing" : args)) =
   if ql == 1
      then do vals <- mapM (evalLisp env 0) args
-             if isList vals
+             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
              return (List ((Symbol "unquote-splicing") : (liftLUnq vals)))
-  where isList [] = True
-        isList ((List _):ls) = isList ls
-        isList _ = False
+  where isLL [] = True
+        isLL ((List _):ls) = isLL ls
+        isLL _ = False
         peel [] = []
         peel ((List l):ls) = l ++ (peel ls)
 
@@ -251,18 +254,11 @@
   do vals <- mapM (evalQQ env ql) con
      vcab <- evalQQ env ql cab >>= liftSUnq
      let head = liftLUnq vals
-     if isl vcab
-        then return (List (head ++ (unpl vcab)))
-        else if isdl vcab
-                then return (DottedList (head ++ (unpdlh vcab)) (unpdlt vcab))
+     if isList vcab
+        then return (List (head ++ (getList vcab)))
+        else if isDL vcab
+                then return (DottedList (head ++ (getDLh vcab)) (getDLt vcab))
                 else return (DottedList head vcab)
-  where isl (List _) = True
-        isl _ = False
-        unpl (List l) = l
-        isdl (DottedList _ _) = True
-        isdl _ = False
-        unpdlh (DottedList h _) = h
-        unpdlt (DottedList _ t) = t
 
 evalQQ env ql (Vector _ con) =
   do vals <- mapM (evalQQ env ql) (remkey (DIM.toAscList con))
@@ -319,8 +315,7 @@
 -- the (or a) top-level environment.
 
 evalLisp env ql (List (Symbol "eval" : args)) =
-  do argVals <- mapM (evalLisp env ql) args
-     lastOrNil (mapM (evalLisp env ql) argVals)
+  mapM (evalLisp env ql) args >>= mapML (evalLisp env 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
@@ -330,19 +325,16 @@
 -- function and modify the environment seen within that function.
 
 evalLisp env ql (List [Symbol "load", String filename]) =
-  loadFile filename >>= lastOrNil . mapM (evalLisp env ql)
+  loadFile filename >>= mapML (evalLisp env ql)
 evalLisp env ql (List [Symbol "load", arg]) =
   do fname <- evalLisp env ql arg
      if isStr fname
-        then loadFile (getStr fname) >>= lastOrNil . mapM (evalLisp env ql)
+        then loadFile (getStr fname) >>= mapML (evalLisp env ql)
         else throwError (Default ("bad load form: " ++
                                   (show fname) ++ " is not a string"))
-  where isStr (String _) = True
-        isStr _ = False
-        getStr (String s) = s
 
 evalLisp env ql (List (Symbol "begin" : args)) =
-  lastOrNil (mapM (evalLisp env ql) args)
+  mapML (evalLisp env ql) args
 
 evalLisp _ _ (List [Symbol "quote", val]) = return val
 
@@ -362,61 +354,44 @@
   do vec <- evalLisp env ql (Symbol var)
      if isVec vec
         then do lk <- evalLisp env ql indx
-                let l = getL vec
-                    k = getI lk
-                if ((isI lk) && k >= 0 && k < l)
+                let l = getVecL vec
+                    k = getInt lk
+                if ((isInt lk) && k >= 0 && k < l)
                    then do val <- evalLisp env ql obj
                            setVar env var (Vector l
-                             (DIM.insert (fromInteger k) val (getV vec)))
+                             (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"))
-  where isVec (Vector _ _) = True
-        isVec _ = False
-        isI (IntNumber _) = True
-        isI _ = False
-        getI (IntNumber n) = n
-        getL (Vector l _) = l
-        getV (Vector _ v) = v
 
 evalLisp env ql (List [Symbol "vector-fill!", Symbol var, obj]) =
   do vec <- evalLisp env ql (Symbol var)
      if isVec vec
         then do val <- evalLisp env ql obj
-                let n = getL vec
+                let n = getVecL vec
                 setVar env var (Vector n (DIM.fromAscList
                   (addkey val (fromInteger n))))
         else throwError (Default ("bad vector-fill! form: " ++
                                   (show var) ++ " is not a vector"))
-  where isVec (Vector _ _) = True
-        isVec _ = False
-        getL (Vector l _) = l
-        addkey _ 0 = []
+  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)
      if isVec vec
         then do lk <- evalLisp env ql obj
-                let l = getL vec
-                    k = getI lk
-                if (isI lk) && (k > 0)
+                let l = getVecL vec
+                    k = getInt lk
+                if (isInt lk) && (k > 0)
                    then do let new = if k < l
-                                        then rem (getV vec) l k
-                                        else add (getV vec) k l
+                                        then rem (getVecV vec) l k
+                                        else add (getVecV vec) k l
                            setVar env var (Vector k new)
                    else throwError (Default ("bad vector-resize! size: " ++
                                              (show k)))
         else throwError (Default ("bad vector-resize! form: " ++
                                   (show var) ++ " is not a vector"))
-  where isVec (Vector _ _) = True
-        isVec _ = False
-        getL (Vector l _) = l
-        getV (Vector _ v) = v
-        isI (IntNumber _) = True
-        isI _ = False
-        getI (IntNumber n) = n
-        rem vec h l =
+  where rem vec h l =
           if h == l
              then vec
              else rem (DIM.delete (fromInteger l) vec) h (l + 1)
@@ -497,13 +472,11 @@
   if foldl1 (&&) (map isList args) == False
      then errTypeMismatch "cond" "cond-clauses" (String (show args))
      else evc env args
-  where isList (List _) = True
-        isList _ = False
-        evc _ [] = return lispFalse
+  where evc _ [] = return lispFalse
         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 <- lastOrNil (mapM (evalLisp env ql) args)
+          do ret <- mapML (evalLisp env ql) args
              return (True, ret)
         evc_clause env (List (pred : args)) =
           do tst <- evalLisp env ql pred
@@ -511,8 +484,7 @@
                   Boolean False -> return (False, lispFalse)
                   _ -> do ret <- if isArrow args
                                     then evcArrow env args tst
-                                    else lastOrNil
-                                          (mapM (evalLisp env ql) args)
+                                    else mapML (evalLisp env ql) args
                           return (True, ret)
         evc_clause _ _ = return (False, lispFalse)
         isArrow [Symbol "=>", _] = True
@@ -544,7 +516,7 @@
   if letCheck False params
      then dols params body env
      else errBadForm "let*" params
-  where dols [] body env = lastOrNil (mapM (evalLisp env ql) body)
+  where dols [] body env = mapML (evalLisp env ql) body
         dols (p:ps) body env =
              do val <- evalLisp env ql (exv p)
                 (liftIO (bindVars env [(exn p, val)])) >>= (dols ps body)
@@ -560,7 +532,7 @@
              envn <- liftIO (bindVars env varn)
              varv <- mapM (evalLisp envn ql) (map exv params)
              mapM (doSet envn) (repl varn varv) >>
-                  lastOrNil (mapM (evalLisp envn ql) body)
+                  mapML (evalLisp envn ql) body
         exn (List [Symbol var, _]) = (var, lispFalse)
         exv (List [Symbol _, val]) = val
         repl [] [] = []
@@ -575,30 +547,30 @@
           do let varn = map exn params
              envn <- liftIO (bindVars env varn)
              mapM (evSet envn) params >>
-                  lastOrNil (mapM (evalLisp envn ql) body)
+                  mapML (evalLisp envn ql) body
         exn (List [Symbol var, _]) = (var, lispFalse)
         evSet env (List [Symbol var, val]) =
               evalLisp env ql val >>= setVar env var
 
 evalLisp _ _ (List [Symbol "case"]) = return lispFalse
 evalLisp env ql (List (Symbol "case" : key : args)) =
-  if (isNull args) || (foldl1 (&&) (map isList args) == False)
+  if (isNull args) || (foldl1 (&&) (map isLL args) == False)
      then errTypeMismatch "case" "case-clauses" (String (show args))
      else evalLisp env ql key >>= evc env args
   where isNull [] = True
         isNull _ = False
-        isList (List (List _ : _)) = True
-        isList (List (Symbol "else" : _)) = True
-        isList _ = False
+        isLL (List (List _ : _)) = True
+        isLL (List (Symbol "else" : _)) = True
+        isLL _ = False
         evc _ [] _ = return lispFalse
         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 <- lastOrNil (mapM (evalLisp env ql) args)
+          do ret <- mapML (evalLisp env ql) args
              return (True, ret)
         evc_clause env (List (List vals : args)) key =
           if valMatch key vals
-             then do ret <- lastOrNil (mapM (evalLisp env ql) args)
+             then do ret <- mapML (evalLisp env ql) args
                      return (True, ret)
              else return (False, lispFalse)
         evc_clause _ _ _ = return (False, lispFalse)
@@ -610,19 +582,17 @@
 evalLisp env 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 (lastOrNil (mapM (evalLisp env ql) body))
+     else catchError (mapML (evalLisp env ql) body)
                      (\err -> do let errval = unpackErr err
                                  liftIO (bindVars env [(var, errval)]) >>=
                                    evc err clauses)
-  where isList (List _) = True
-        isList _ = False
-        unpackErr (UserException val) = val
+  where unpackErr (UserException val) = val
         unpackErr err = String (show err)
         evc err [] _ = throwError err
         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 <- lastOrNil (mapM (evalLisp env ql) args)
+          do ret <- mapML (evalLisp env ql) args
              return (True, ret)
         evc_clause env (List (pred : args)) =
           do tst <- evalLisp env ql pred
@@ -630,8 +600,7 @@
                   Boolean False -> return (False, lispFalse)
                   _ -> do ret <- if isArrow args
                                     then evcArrow env args tst
-                                    else lastOrNil
-                                          (mapM (evalLisp env ql) args)
+                                    else mapML (evalLisp env ql) args
                           return (True, ret)
         evc_clause _ _ = return (False, lispFalse)
         isArrow [Symbol "=>", _] = True
@@ -647,10 +616,9 @@
 
 evalLisp env _ (List [Symbol "delay", val]) =
   do dval <- getVar env delayCounter
-     let count = getCount dval
+     let count = getInt dval
      do setVar env delayCounter (IntNumber (count + 1))
         return (Delay val env (" delay." ++ (show count)))
-  where getCount (IntNumber n) = n
 
 evalLisp envc ql (List [Symbol "force", val]) =
   do vali <- evalLisp envc ql val
@@ -684,7 +652,7 @@
         doloop env names (test:rets) steps =
           do tval <- evalLisp env ql test
              if isTrue tval
-                then do lastOrNil (mapM (evalLisp env ql) rets) >>= return
+                then mapML (evalLisp env ql) rets
                 else do mapM (evalLisp env ql) body
                         svals <- mapM (evalLisp env ql) steps
                         mapM (doSet env) (zip names svals)
@@ -693,13 +661,11 @@
 -- 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 "new-symbol"]) =
+evalLisp env _ (List [Symbol "gensym"]) =
   do sval <- getVar env symbolCounter
-     let count = getCount sval
+     let count = getInt sval
      do setVar env symbolCounter (IntNumber (count + 1))
         return (Symbol (" symbol." ++ (show count)))
-  where getCount (IntNumber n) = n
-        getCount _ = progError
 
 -- 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
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.30 2009-06-27 21:51:29 uwe Exp $ -}
+$Id: library.hs,v 1.33 2009-07-04 02:48:29 uwe Exp $ -}
 
 module Library (primitiveBindings, delayCounter, symbolCounter, loadFile, eqv)
   where
@@ -314,6 +314,35 @@
                      return . IntNumber . foldl1 intOp
                 else errTypeMismatch name "number" (List av)
 
+-- wrappers around rational comparison operators so that
+-- we can deal properly with infinities and NaNs
+
+myRatEQ n1 n2 | n1 == myRatNaN || n2 == myRatNaN    = False
+              | otherwise                           = n1 == n2
+
+myRatNE n1 n2 | n1 == myRatNaN || n2 == myRatNaN    = True
+              | otherwise                           = n1 /= n2
+
+myRatLT n1 n2 | n1 == myRatNaN || n2 == myRatNaN    = False
+              | n1 == myRatNInf                     = n2 /= myRatNInf
+              | n2 == myRatPInf                     = n1 /= myRatPInf
+              | otherwise                           = n1 < n2
+
+myRatLE n1 n2 | n1 == myRatNaN || n2 == myRatNaN    = False
+              | n1 == myRatNInf                     = True
+              | n1 == myRatPInf                     = n2 == myRatPInf
+              | otherwise                           = n1 <= n2
+
+myRatGT n1 n2 | n1 == myRatNaN || n2 == myRatNaN    = False
+              | n2 == myRatNInf                     = n1 /= myRatNInf
+              | n1 == myRatPInf                     = n2 /= myRatPInf
+              | otherwise                           = n1 > n2
+
+myRatGE n1 n2 | n1 == myRatNaN || n2 == myRatNaN    = False
+              | n1 == myRatPInf                     = True
+              | n2 == myRatPInf                     = n1 == myRatPInf
+              | otherwise                           = n1 >= n2
+
 numBoolBinop :: String -> (Integer -> Integer -> Bool) ->
                 (Rational -> Rational -> Bool) ->
                 (Double -> Double -> Bool) ->
@@ -411,6 +440,18 @@
             | (denominator n1 /= 0)                  = n2
             | otherwise                              = n1
 
+mymin :: Rational -> Rational -> Rational
+mymin n1 n2 =
+  if n1 == myRatNInf || n2 == myRatNInf
+     then myRatNInf
+     else min n1 n2
+
+mymax :: Rational -> Rational -> Rational
+mymax n1 n2 =
+  if n1 == myRatPInf || n2 == myRatPInf
+     then myRatPInf
+     else max n1 n2
+
 mypow :: Rational -> Integer -> Rational
 mypow b e | (b == myRatNaN)                     = myRatNaN
           | (b == myRatPInf && e > 0)           = myRatPInf
@@ -475,7 +516,7 @@
 lispMin [RatNumber n] = return (RatNumber n)
 lispMin [FltNumber n] = return (FltNumber n)
 lispMin (val:[]) = errTypeMismatch "min" "number" (String (show val))
-lispMin (a:as) = numericBinop "min" min min min (a:as)
+lispMin (a:as) = numericBinop "min" min mymin min (a:as)
 
 lispMax :: [LispVal] -> ThrowsError LispVal
 lispMax [] = errNumArgs "max" 1 []
@@ -483,21 +524,31 @@
 lispMax [RatNumber n] = return (RatNumber n)
 lispMax [FltNumber n] = return (FltNumber n)
 lispMax (val:[]) = errTypeMismatch "max" "number" (String (show val))
-lispMax (a:as) = numericBinop "max" max max max (a:as)
+lispMax (a:as) = numericBinop "max" max mymax max (a:as)
 
+-- It would probably be more reasonable to just make everything
+-- involving infinities to return a NaN... that stuff is just too messy
+
 fltpow :: Double -> Double -> LispVal
-fltpow x y | y == 0                                 = IntNumber 1
-           | (x == 0 && y > 0)                      = IntNumber 0
-           | (x == 0 && y < 0)                      = libRatPInf
-           | ((abs x) < 1 && y > 0 && isInfinite y) = IntNumber 0
-           | ((abs x) > 1 && y < 0 && isInfinite y) = IntNumber 0
-           | otherwise                              = FltNumber (x ** y)
+fltpow x y | y == 0                                   = if isInfinite x
+                                                           then libFltNaN
+                                                           else IntNumber 1
+           | x == 0                                   = if y > 0
+                                                           then IntNumber 0
+                                                           else libRatPInf
+           | (abs x) < 1 && y > 0 && isInfinite y     = IntNumber 0
+           | (abs x) > 1 && y < 0 && isInfinite y     = IntNumber 0
+           | x == -1 && isInfinite y                  = libFltNaN
+           | x < -1 && y > 0 && isInfinite y          = libFltNaN
+           | x > -1 && x < 0 && y < 0 && isInfinite y = libFltNaN
+           | otherwise                                = FltNumber (x ** y)
 
 spow :: Rational -> Rational -> LispVal
 spow x y | x < -1 && y == myRatPInf                       = libRatNaN
          | x < 0 && x > -1 && y == myRatNInf              = libRatNaN
          | x == -1 && (abs y) == myRatPInf                = libRatNaN
          | x == myRatNInf && y > 0 && (denominator y) > 1 = libRatNaN
+         | x == myRatPInf && y == 0                       = libRatNaN
          | (abs x) == myRatPInf && y > 0                  = libRatPInf
          | x > 1 && y == myRatPInf                        = libRatPInf
          | x > 0 && x < 1 && y == myRatNInf               = libRatPInf
@@ -907,12 +958,12 @@
               ("remainder", integerBinop "remainder" rem),
               ("gcd", integerBinop "gcd" gcd),
               ("lcm", integerBinop "lcm" lcm),
-              ("=", numBoolBinop "=" (==) (==) (==) False),
-              ("<", numBoolBinop "<" (<) (<) (<) False),
-              (">", numBoolBinop ">" (>) (>) (>) False),
-              ("/=", numBoolBinop "/=" (/=) (/=) (/=) True),
-              (">=", numBoolBinop ">=" (>=) (>=) (>=) False),
-              ("<=", numBoolBinop "<=" (<=) (<=) (<=) False),
+              ("=", numBoolBinop "=" (==) myRatEQ (==) False),
+              ("<", numBoolBinop "<" (<) myRatLT (<) False),
+              (">", numBoolBinop ">" (>) myRatGT (>) False),
+              ("/=", numBoolBinop "/=" (/=) myRatNE (/=) True),
+              (">=", numBoolBinop ">=" (>=) myRatGE (>=) False),
+              ("<=", numBoolBinop "<=" (<=) myRatLE (<=) False),
               ("boolean?", isBool),
               ("symbol?", Library.isSymbol),
               ("char?", isChar),
diff --git a/cpm.scm b/cpm.scm
--- a/cpm.scm
+++ b/cpm.scm
@@ -1,5 +1,5 @@
 ; Copyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>
-; $Id: cpm.scm,v 1.1 2009-06-29 03:59:41 uwe Exp $
+; $Id: cpm.scm,v 1.3 2009-07-03 23:17:00 uwe Exp $
 ; BSD3
 
 ; Continuation-passing macros in the style of "On Lisp" by Paul Graham;
@@ -33,6 +33,11 @@
 (defmacro (=return val)
   `(*cont* ,val))
 
+; Define the (=bind) macro
+
+(defmacro (=bind params expr . body)
+  `(let ((*cont* (lambda ,params ,@body))) ,expr))
+
 ; Define the CPS analog of (define): define a macro that looks like
 ; the function without the continuation argument, and define the
 ; function using a generated symbol with the continuation argument.
@@ -47,7 +52,7 @@
 ; (define (,ifn ...) ...). Otherwise, it's tricky to get at it.
 
 (defmacro (=define formals . body)
-  (let ((ifn (new-symbol))
+  (let ((ifn (gensym))
 	(fn (car formals))
 	(args (cdr formals)))
     (if (symbol? args)
@@ -71,6 +76,11 @@
   (display (foo *cont* 4))
   (newline))
 
+; This should print "9 + 1 = 10"
+
+(=bind (y) (=apply foo 9)
+       (write-string "9 + 1 = " (number->string y) #\newline))
+
 ; This should print "14": the function says to add 10 to the value passed
 ; in, and the current continuation, which is the default identity, is then
 ; applied to that value: 4 + 10 -> identity -> 14
@@ -87,6 +97,11 @@
 (let ((*cont* (lambda (x) (+ 1 x))))
   (display (bar 4))
   (newline))
+
+; This should print "9 + 10 = 19"
+
+(=bind (y) (bar 9)
+       (write-string "9 + 10 = " (number->string y) #\newline))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; explicit CPS conversion of fibonacci function:
diff --git a/haskeem.cabal b/haskeem.cabal
--- a/haskeem.cabal
+++ b/haskeem.cabal
@@ -1,5 +1,5 @@
 Name:             haskeem
-Version:          0.7.5
+Version:          0.7.7
 Homepage:         http://www.korgwal.com/haskeem/
 Author:           Uwe Hollerbach <uh@alumni.caltech.edu>
 Maintainer:       Uwe Hollerbach <uh@alumni.caltech.edu>
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.36 2009-06-29 00:25:51 uwe Exp $
+; $Id: haskeem.doc,v 1.39 2009-07-03 23:17:00 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
@@ -42,10 +42,10 @@
 ((form defmacro) (args (var params) body))
 ((form defmacro) (args (var params . varargs) body))
 
-((form let) (args ???))
-((form let*) (args ???))
-((form letrec) (args ???))
-((form letrec*) (args ???))
+((form let) (args (vars params) . body))
+((form let*) (args (vars params) . body))
+((form letrec) (args (vars params) . body))
+((form letrec*) (args (vars params) . body))
 
 ((form do) (args a lot))
 
@@ -346,8 +346,6 @@
 ((primitive set-no-buffering!) (args handle))
 ((function stream-scale) (args scale stream) (return stream))
 
-; TODO: what have I missed? defmacro added above
-
 ((primitive procedure->data) (args lisp-function) (return list))
 ((macro assert) (args expr) (return expr))
 ((function list-remove-dups) (args list) (return list))
@@ -440,3 +438,6 @@
 ((function set-for-each) (args set fn))
 ((function intset-for-each) (args intset fn))
 ((function bitset-for-each) (args bitset fn))
+
+((function make-stack) (args . values) (return function))
+((macro fluid-let) (args (vars params) . body))
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.34 2009-06-29 04:21:36 uwe Exp $ -}
+$Id: haskeem.hs,v 1.36 2009-07-04 19:07:00 uwe Exp $ -}
 
 module Main where
 import Prelude
@@ -43,7 +43,7 @@
 -- haskeem version
 
 version :: String
-version = "0.7.5"
+version = "0.7.7"
 
 -- 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.5"
+version = "0.7.7"
 
 -- a variable under which any command-line arguments to a script are
 -- made available; empty for interactive mode
diff --git a/heap.scm b/heap.scm
--- a/heap.scm
+++ b/heap.scm
@@ -1,5 +1,5 @@
 ; Copyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>
-; $Id: heap.scm,v 1.2 2009-06-29 00:24:24 uwe Exp $
+; $Id: heap.scm,v 1.3 2009-07-03 23:17:00 uwe Exp $
 ; BSD3
 
 ; Priority queues implemented as heaps
@@ -90,7 +90,7 @@
 ; in place, and return the highest-priority item
 
 (defmacro (heap-remove! heap)
-  (let ((l (new-symbol)))
+  (let ((l (gensym)))
     `(let ((,l (heap-remove ,heap)))
        (set! ,heap (cadr ,l))
        (car ,l))))
diff --git a/macro-test.scm b/macro-test.scm
--- a/macro-test.scm
+++ b/macro-test.scm
@@ -12,7 +12,7 @@
 
 ; This version is careful to evaluate tval only once
 (defmacro (numeric-if-1 tval ifn ifz ifp)
-  (let ((nit (new-symbol)))
+  (let ((nit (gensym)))
     `(let ((,nit ,tval))
        (if (number? ,nit)
 	   (if (negative? ,nit)
@@ -71,7 +71,7 @@
 
 (write-string "################ while test\n")
 (defmacro (while some-cond . some-actions)
-  (let ((mc (new-symbol)))
+  (let ((mc (gensym)))
     `(do ((,mc 0 (+ ,mc 1)))
 	 ((not ,some-cond) ,mc)
        ,@some-actions)))
@@ -94,7 +94,7 @@
 
 (write-string "################ swap test\n")
 (defmacro (swap var1 var2)
-  (let ((vs (new-symbol)))
+  (let ((vs (gensym)))
     `(let ((,vs ,var1))
        (set! ,var1 ,var2)
        (set! ,var2 ,vs))))
diff --git a/regexp.scm b/regexp.scm
--- a/regexp.scm
+++ b/regexp.scm
@@ -1,5 +1,5 @@
 ; Copyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>
-; $Id: regexp.scm,v 1.13 2009-06-29 00:25:19 uwe Exp $
+; $Id: regexp.scm,v 1.14 2009-07-02 05:49:56 uwe Exp $
 ; BSD3... but if you use this for anything serious, you gotta be kidding
 
 ; grammar for regular expressions: precedence is (highest to lowest)
@@ -32,19 +32,19 @@
 ; string, need to double-escape it: for example (regexp-parse "(a|\\()*")
 
 ; An NFA state is a list: the car is the name of the state itself, a simple
-; integer. The names are generated by the st-count counter in this routine:
-; it starts at 0, but it's pre-incremented, so state names start at 1. In
-; principle, they could be arbitrary, but we make use of the fact that they
-; are non-negative integers in the next routine, where we generate the
-; epsilon-closure of each state: we use bit-sets there, which assume (in my
-; implementation) that all elements of a set are non-negative integers.
-; The second element of the NFA state list is the set of states to which
-; epsilon-transitions are possible. In the output of this routine, that is
-; a simple list of state names; in the output of gen-eps-closure, it gets
-; turned into a bitset which is represented as a single integer.
-; The remaining entries in the list are themselves lists, each representing
-; a new state to which a transition may be made, and the inputs triggering
-; that transition. For example:
+; integer. The names are generated by the st-count counter in the
+; regexp-make-nfa routine: it starts at 0, and it's pre-incremented, so
+; state names start at 1. In principle, they could be arbitrary, but we
+; make use of the fact that they are non-negative integers in the next
+; routine, where we generate the epsilon-closure of each state: we use
+; bit-sets there, which assume (in my implementation) that all elements of
+; a set are non-negative integers.  The second element of the NFA state
+; list is the set of states to which epsilon-transitions are possible. In
+; the output of this routine, that is a simple list of state names; in the
+; output of gen-eps-closure, it gets turned into a bitset which is
+; represented as a single integer.  The remaining entries in the list are
+; themselves lists, each representing a new state to which a transition may
+; be made, and the inputs triggering that transition. For example:
 ;
 ;   (2 (10) (1 #\+ #\-) (5 #\a #\b) (7 #\c #\d))
 ;
@@ -78,10 +78,12 @@
   (letrec* ((tokens (filter (lambda (c) (not (char-whitespace? c)))
 			    (string->char str)))
 	    (cur-tok #f)
+; look ahead one character without consuming it
 	    (peek (lambda ()
 		    (if (null? tokens)
 			#f
 			(car tokens))))
+; get and consume the current character
 	    (pop (lambda ()
 		   (if (null? tokens)
 		       #f
@@ -154,14 +156,17 @@
 				  (eqv? cur #\+))
 			      (raise "error: unexpected operator"))
 			     (else (pop))))))
+; parse the whole regexp
 	    (regexp (p-re0)))
-	   (if (eqv? (peek) #f)
-	       regexp
-	       (raise "error: input not completely used"))))
+; if there's something left over, it's an error;
+; otherwise, we've successfully parsed the regexp
+    (if (eqv? (peek) #f)
+	regexp
+	(raise "error: input not completely used"))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; Flatten the AST produced by regexp-parse: instead of a pure tree of
-; binary ops, CONCAT and ALT get turned into multi-operand operators
+; Flatten the AST produced by regexp-parse: instead of a nearly pure tree
+; of binary ops, CONCAT and ALT get turned into multi-operand operators
 ; where applicable. For example
 ;	(CONCAT #\a (CONCAT #\b (CONCAT #\c (CONCAT #\d #\e))))
 ; gets turned into
@@ -172,12 +177,11 @@
 
 (define (regexp-flatten-ast ast)
   (let ((s-op (lambda (op t1 t2)
-		(let ((lst (list op))
-		      (lifter (lambda (l)
+		(let ((lifter (lambda (l)
 				((if (and (list? l) (eqv? (car l) op))
 				     cdr
 				     list) l))))
-		  (append (append lst (lifter t1)) (lifter t2))))))
+		  (cons op (append (lifter t1) (lifter t2)))))))
     (if (list? ast)
 	(cond ((eqv? 'COUNT (car ast))
 	       (list (car ast)
@@ -192,11 +196,14 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; This routine generates a list of states describing an NFA, given an AST
-; generated from the above routine(s). The first state in the list will be the
-; start state, and the second state in the list will be the end state;
+; generated from the above routine(s). The first state in the list will be
+; the start state, and the second state in the list will be the end state;
 ; intermediate states will follow after that. The initial version produces
 ; copious intermediate states with epsilon-transitions. It does do fairly
-; efficient character ranges now.
+; efficient character ranges now: rather than producing a pair of states
+; for every single character in a range, and gluing all of these together
+; with another pair of states, it just does one pair of states with a whole
+; bunch of characters on which to transition.
 
 (define (regexp-make-nfa ast)
   (letrec* ((con3 (lambda (a b c) (cons a (cons b c))))
@@ -366,7 +373,7 @@
 
 ; {M} = eps-closure of NFA state 1
 ; DFA state 1 = {M}
-; add {M} to work queue (or stack, doesn't matter)
+; add {M} to work queue (or stack, order doesn't particularly matter)
 ; while (work queue/stack not empty)
 ;   remove {M}
 ;   for each input character i
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.42 2009-06-20 03:09:42 uwe Exp $
+; $Id: selftest.scm,v 1.45 2009-07-04 01:29:53 uwe Exp $
 
 (define start (epochtime))
 
@@ -59,7 +59,7 @@
 (define (chk-run expect expr) (chk-closeto eqv? expect expr))
 
 (define (rel-tol x y)
-  (when verbose? 
+  (when verbose?
 	(write-string "\nrel diff  " (number->string (abs (- x y)))))
   (< (abs (- x y)) (* (* 0.5 (+ (abs x) (abs y))) 1.25e-15)))
 
@@ -135,6 +135,11 @@
 (chk-run 11 '(- 5 4 -2 3 -11))
 (chk-run 163 '(+ 1 (* 2 (expt 3 4))))
 
+(chk-run 163 '((car (list + * expt))
+	       1 ((cadr (list + * expt))
+		  2 ((caddr (list + * expt))
+		     3 4))))
+
 (chk-run 1267650600228229401496703205376 '(expt 2 100))
 
 (chk-run +nan.0 '(sqrt -1.0))
@@ -2238,7 +2243,7 @@
   (define test-value  (lambda () (set! probe (+ probe 1000)) test-val))
 
   (defmacro (test-numeric-if tval ifn ifz ifp)
-    (let ((nit (new-symbol)))
+    (let ((nit (gensym)))
       `(let ((,nit ,tval))
 	 (if (number? ,nit)
 	     (if (negative? ,nit)
@@ -2304,7 +2309,7 @@
 
 (begin
   (defmacro (test-swap var1 var2)
-    (let ((vs (new-symbol)))
+    (let ((vs (gensym)))
       `(let ((,vs ,var1))
 	 (set! ,var1 ,var2)
 	 (set! ,var2 ,vs))))
@@ -2368,11 +2373,13 @@
 
 (define (do-dir-tests)
   (write-string
-   "    Some of the tests involving directory and file creation\n"
-   "    and removal may fail if run on an NFS-mounted filesystem.\n"
-   "    If you see weird files like '.nfs000000000029a82600000001'\n"
-   "    and an exception while removing the test directory, that\n"
-   "    is the likely cause. Don't Panic!\n")
+   #\linefeed
+   "Some of the tests involving directory and file creation\n"
+   "and removal may fail if run on an NFS-mounted filesystem.\n"
+   "If you see weird files like '.nfs000000000029a82600000001'\n"
+   "and an exception while removing the test directory, that\n"
+   "is the likely cause. Don't Panic!\n"
+   #\linefeed)
   (catch-exceptions (chk-run #f '(directory-exists? test-dir1)))
   (catch-exceptions (chk-run #t '(create-directory test-dir1)))
   (catch-exceptions (chk-run #t '(create-directory test-dir2)))
@@ -2588,25 +2595,53 @@
 (chk-run 1242 '(ilog (- (expt 2 1243) 1)))
 (chk-run 1243 '(ilog (expt 2 1243)))
 
-(chk-run "1.2345e0" '(number->string 1.2345))
-(chk-run "1.2345e0" '(number->string 1.2345 10))
-(chk-run "1.2345" '(number->string 1.2345 10 4))
-(chk-run "1.23450" '(number->string 1.2345 10 5))
-(chk-run "1.234500" '(number->string 1.2345 10 6))
+(define mynum 1.2345)
 
-(chk-run "1.234" '(number->string 1.2345 10 3))
-(chk-run "1.23" '(number->string 1.2345 10 2))
-(chk-run "1.2" '(number->string 1.2345 10 1))
-(chk-run "1." '(number->string 1.2345 10 0))
-(chk-run "1.2e0" '(number->string 1.2345 10 -1))
-(chk-run "1.23e0" '(number->string 1.2345 10 -2))
+(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 "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))
 
-(chk-run "1.234e0" '(number->string 1.2345 10 -3))
-(chk-run "1.2345e0" '(number->string 1.2345 10 -4))
+(write-string "This test might fail, returning \"1.235\" instead\n")
+(chk-run "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 "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))
 (chk-run "1.2345e0" '(number->string 12345/10000 10 -4))
 
+; Same as 1.2345 decimal, but in the above when we read in 1.2345 the last
+; four binary digits get turned into 1110 which doesn't quite get turned
+; back into 1.2345; that leads to the four "might fail" cases above.
+
+(set! mynum #b1.0011110000001000001100010010011011101001011110001101)
+
+(chk-run "1.2345e0" '(number->string mynum))
+(chk-run "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))
+
+(chk-run "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))
+
+(chk-run "1.234e0" '(number->string mynum 10 -3))
+(chk-run "1.2345e0" '(number->string mynum 10 -4))
+
 (chk-run "1.0" '(number->string 0.99999 10 1))
 (chk-run "1.00" '(number->string 0.99999 10 2))
 (chk-run "1.000" '(number->string 0.99999 10 3))
@@ -2736,6 +2771,47 @@
 ; to make the distinction they do.
 
 (chk-run '((1 2) 3 4 five 6) '(let ((a 3)) `((1 2) ,a ,4 ,'five 6)))
+
+(define st (make-stack))
+(define counter 0)
+
+(define (bump-counter)
+  (set! counter (+ 1 counter))
+  (st 'push counter)
+  counter)
+
+(chk-run #f '(st 'top))
+(chk-run '(3) '(st 'push 3))
+(chk-run '(2 3) '(st 'push 2))
+(chk-run '(17 2 3) '(st 'push 17))
+(chk-run 17 '(st 'pop))
+(chk-run #f '(st 'empty?))
+(chk-run '(1 2 3) '(st 'push 1))
+(chk-run '(1 2 3) '(st 'dump))
+(chk-run #f '(st 'top))
+(chk-run #t '(st 'empty?))
+
+(bump-counter)
+(bump-counter)
+(bump-counter)
+(chk-run '(3 2 1) '(st 'dump))
+
+(let ((counter 99))
+  (bump-counter)
+  (st 'push counter)
+  (bump-counter)
+  (st 'push counter)
+  (bump-counter))
+(chk-run '(6 99 5 99 4) '(st 'dump))
+
+(fluid-let ((counter 99))
+  (bump-counter)
+  (st 'push counter)
+  (bump-counter)
+  (st 'push counter)
+  (bump-counter))
+(chk-run '(102 101 101 100 100) '(st 'dump))
+(chk-run 6 counter)
 
 ; if anything gets past the guard, it'll kill the self-test; so don't do that
 
diff --git a/stdlib.scm b/stdlib.scm
--- a/stdlib.scm
+++ b/stdlib.scm
@@ -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: stdlib.scm,v 1.39 2009-06-20 03:09:42 uwe Exp $
+; $Id: stdlib.scm,v 1.42 2009-07-03 23:17:01 uwe Exp $
 
 ; The haskeem standard library
 
@@ -471,13 +471,13 @@
 ; These take zero or more trips through the loop
 
 (defmacro (while some-cond . some-actions)
-  (let ((mc (new-symbol)))
+  (let ((mc (gensym)))
     `(do ((,mc 0 (+ ,mc 1)))
 	 ((not ,some-cond) ,mc)
        ,@some-actions)))
 
 (defmacro (until some-cond . some-actions)
-  (let ((mc (new-symbol)))
+  (let ((mc (gensym)))
     `(do ((,mc 0 (+ ,mc 1)))
 	 (,some-cond ,mc)
        ,@some-actions)))
@@ -485,13 +485,13 @@
 ; These take at least one trip through the loop
 
 (defmacro (do-while some-cond . some-actions)
-  (let ((mc (new-symbol)))
+  (let ((mc (gensym)))
     `(do ((,mc 0 (+ ,mc 1)))
 	 ((and (positive? ,mc) (not ,some-cond)) ,mc)
        ,@some-actions)))
 
 (defmacro (do-until some-cond . some-actions)
-  (let ((mc (new-symbol)))
+  (let ((mc (gensym)))
     `(do ((,mc 0 (+ ,mc 1)))
 	 ((and (positive? ,mc) ,some-cond) ,mc)
        ,@some-actions)))
@@ -512,6 +512,50 @@
 	   (if filepath
 	       `(load ,filepath)
 	       `(write-string "unable to find file '" ,fname "'\n"))))
+
+; A stack generator:
+; (make-stack . init)	-> stacker, optionally initialized with init value(s)
+;			   as though pushed in order from left to right
+; (stacker 'push val)	-> push val onto stack
+; (stacker 'pop)	-> return top of stack with popping
+; (stacker 'top)	-> return top of stack without popping
+;	in both of the above cases, return #f if the stack is empty
+; (stacker 'empty?)	-> return #t if the stack is empty, #f otherwise
+; (stacker 'dump)	-> make the stack empty, returning all of its content
+
+(define (make-stack . init)
+  (let* ((stk (reverse init))
+	 (ret #f)
+	 (fn (lambda (op . val)
+	       (cond ((eqv? 'push op) (if (null? val)
+					  (raise "nothing to push onto stack!")
+					  (set! stk (cons (car val) stk))))
+		     ((eqv? 'pop op) (if (null? stk)
+					 #f
+					 (begin (set! ret (car stk))
+						(set! stk (cdr stk))
+						ret)))
+		     ((eqv? 'top op) (if (null? stk) #f (car stk)))
+		     ((eqv? 'empty? op) (null? stk))
+		     ((eqv? 'dump op) (set! ret stk) (set! stk '()) ret)
+		     (else (raise "stack error: unknown op!"))))))
+    fn))
+
+; Shamelessly stolen from Dorai Sitaram "Teach Yourself Scheme in
+; Fixnum Days"... I could independently write the single-variable
+; version of this, (fluid-let1 (var val) body), but here the nested
+; quasi-quotes got just a little hairy... yow!
+
+(defmacro (fluid-let vals . body)
+  (let ((svals (map (lambda (ig) (gensym)) vals))
+	(result (gensym))
+	(vars (map car vals))
+	(tvals (map cadr vals)))
+    `(let ,(map (lambda (s v) `(,s ,v)) svals vars)
+       ,@(map (lambda (v t) `(set! ,v ,t)) vars tvals)
+       (let ((,result (begin ,@body)))
+	 ,@(map (lambda (v s) `(set! ,v ,s)) vars svals)
+	 ,result))))
 
 ; if desired, this can be enabled; that's a nice confirmation in the REPL
 ; that everything is ok