* interp/Makefile.in (OBJS): Remove i-spec1.$(FASLEXT) and

	i-spec2.$(FASLEXT).  Add i-special.$(FASLEXT).
	* interp/i-spec1.boot, interp/i-spec2.boot: Move content to
	i-special.boot.  Remove.

4 files changed, 1205 insertions, 1233 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index d4a7d1f1..bee2cb4b 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,12 @@
 2011-02-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/Makefile.in (OBJS): Remove i-spec1.$(FASLEXT) and
+	i-spec2.$(FASLEXT).  Add i-special.$(FASLEXT).
+	* interp/i-spec1.boot, interp/i-spec2.boot: Move content to
+	i-special.boot.  Remove.
+
+2011-02-27  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* algebra/outform.spad.pamphlet (OutputForm) [infix?]: Rewrite.
 
 2011-02-26  Gabriel Dos Reis  <gdr@cs.tamu.edu>
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 94a6fe83..00a0a2ad 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -94,8 +94,8 @@ OBJS=   boot-pkg.$(FASLEXT)	types.$(FASLEXT)	 \
 	i-funsel.$(FASLEXT)	\
 	i-intern.$(FASLEXT)	i-map.$(FASLEXT)	\
 	i-output.$(FASLEXT)	\
-	i-spec1.$(FASLEXT)				\
-	i-spec2.$(FASLEXT)	i-syscmd.$(FASLEXT)	\
+	i-special.$(FASLEXT)				\
+	                    	i-syscmd.$(FASLEXT)	\
 	i-toplev.$(FASLEXT)	i-util.$(FASLEXT)	\
 	incl.$(FASLEXT)	int-top.$(FASLEXT)	\
 	intfile.$(FASLEXT)	c-util.$(FASLEXT)	\
@@ -328,8 +328,7 @@ int-top.$(FASLEXT): incl.$(FASLEXT) i-toplev.$(FASLEXT) unlisp.$(FASLEXT)
 i-toplev.$(FASLEXT): i-analy.$(FASLEXT)
 i-syscmd.$(FASLEXT): i-object.$(FASLEXT)
 i-output.$(FASLEXT): sys-macros.$(FASLEXT)
-i-spec2.$(FASLEXT): i-spec1.$(FASLEXT)
-i-spec1.$(FASLEXT): i-analy.$(FASLEXT)
+i-special.$(FASLEXT): i-analy.$(FASLEXT)
 i-funsel.$(FASLEXT): i-coerfn.$(FASLEXT)
 i-map.$(FASLEXT): i-object.$(FASLEXT)
 i-eval.$(FASLEXT): i-analy.$(FASLEXT)
diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot
deleted file mode 100644
index 9e46ef6b..00000000
--- a/src/interp/i-spec2.boot
+++ /dev/null
@@ -1,1228 +0,0 @@
--- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
--- All rights reserved.
---
--- Redistribution and use in source and binary forms, with or without
--- modification, are permitted provided that the following conditions are
--- met:
---
---     - Redistributions of source code must retain the above copyright
---       notice, this list of conditions and the following disclaimer.
---
---     - Redistributions in binary form must reproduce the above copyright
---       notice, this list of conditions and the following disclaimer in
---       the documentation and/or other materials provided with the
---       distribution.
---
---     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
---       names of its contributors may be used to endorse or promote products
---       derived from this software without specific prior written permission.
---
--- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-
-import i_-spec1
-namespace BOOT
-
-++ The `void' value object (an oxymoron).  There really are constants.
-$VoidValueObject := objNew(voidValue(), $Void)
-$VoidCodeObject := objNew('(voidValue), $Void)
-
-setValueToVoid t ==
-  putValue(t,$VoidValueObject)
-  putModeSet(t,[$Void])
-
-setCodeToVoid t ==
-  putValue(t,$VoidCodeObject)
-  putModeSet(t,[$Void])
-
-++ Interpreter macros
-$InterpreterMacroAlist ==
-  '((%i . (complex 0 1))
-    (%e . (exp 1))
-    (%pi . (pi))
-    (SF . (DoubleFloat))
-    (%infinity . (infinity))
-    (%plusInfinity . (plusInfinity))
-    (%minusInfinity . (minusInfinity)))
-
-
--- Functions which require special handlers (also see end of file)
-
---% Handlers for map definitions
-
-upDEF t ==
-  -- performs map definitions.  value is thrown away
-  t isnt [op,def,pred,.] => nil
-  v:=addDefMap(["DEF",:def],pred)
-  not(LISTP(def)) or null(def) =>
-    keyedSystemError("S2GE0016",['"upDEF",'"bad map definition"])
-  mapOp := first def
-  if LISTP(mapOp) then
-    null mapOp =>
-      keyedSystemError("S2GE0016",['"upDEF",'"bad map definition"])
-    mapOp := first mapOp
-  put(mapOp,"value",v,$e)
-  setValueToVoid op
-
---% Handler for package calling and $ constants
-
-++ Return non-nil if `form' designate a constant defined in the
-++ domain designated by `domainForm'.  More specifically, returns:
-++   nil: no such constant 
-++   <%Mode>: the type of the constant.
-++   T: too many constants designated by `form'.
-constantInDomain?(form,domainForm) ==
-    opAlist := getConstructorOperationsFromDB domainForm.op
-    key := opOf form
-    entryList := [entry for (entry := [.,.,.,k]) in LASSOC(key,opAlist) 
-                    | k in '(CONST ASCONST)]
-    entryList is [[sig,.,.,.]] => sig.target
-    #entryList > 2 => true
-    key = "One" => constantInDomain?(["1"], domainForm)
-    key = "Zero" => constantInDomain?(["0"], domainForm)
-    nil
-
-++ Constant `c' of `type' is referenced from domain `d'; return its value
-++ in the VAT `op'.
-findConstantInDomain(op,c,type,d) ==
-  isPartialMode d => throwKeyedMsg("S2IS0020",NIL)
-  val := 
-    $genValue => wrap getConstantFromDomain([c],d)
-    ["getConstantFromDomain",["LIST",MKQ c],MKQ d]
-  type := substitute(d,"$",type)
-  putValue(op,objNew(val,type))
-  putModeSet(op,[type])
-
-upDollar t ==
-  -- Puts "dollar" property in atree node, and calls bottom up
-  t isnt [op,D,form] => nil
-  t2 := t
-  (not $genValue) and "or"/[CONTAINED(var,D) for var in $localVars] =>
-    keyedMsgCompFailure("S2IS0032",NIL)
-  D="Lisp" => upLispCall(op,form)
-  if vector? D and (# D > 0) then D := D.0
-  t := evaluateType unabbrev D
-  categoryForm? t =>
-    throwKeyedMsg("S2IE0012", [t])
-  f := getUnname form
-  if f = $immediateDataSymbol then
-    f := objValUnwrap coerceInteractive(getValue form,$OutputForm)
-    if f = '(construct) then f := "nil"
-  atom form and (f ~= $immediateDataSymbol) =>
-    type := constantInDomain?([f],t) =>
-      type ~= true => findConstantInDomain(op,f,type,t)
-      -- Ambiguous constant.  FIXME: try to narrow before giving up.
-      throwKeyedMsg("S2IB0008h",[f,t])
-    findUniqueOpInDomain(op,f,t)
-
-  nargs := #rest form
-
-  (ms := upDollarTuple(op, f, t, t2, rest form, nargs)) => ms
-
-  f ~= "construct" and null isOpInDomain(f,t,nargs) =>
-    throwKeyedMsg("S2IS0023",[f,t])
-  if (sig := findCommonSigInDomain(f,t,nargs)) then
-    for x in sig for y in form repeat
-      if x then putTarget(y,x)
-  putAtree(first form,"dollar",t)
-  ms := bottomUp form
-  f in '(One Zero) and cons? (ms) and first(ms) = $OutputForm =>
-    throwKeyedMsg("S2IS0021",[f,t])
-  putValue(op,getValue first form)
-  putModeSet(op,ms)
-
-
-upDollarTuple(op, f, t, t2, args, nargs) ==
-  -- this function tries to find a tuple function to use
-  -- nargs = 1 and getUnname first args = "Tuple" => NIL
-  -- nargs = 1 and (ms := bottomUp first args) and ms is [["Tuple",.]] => NIL
-  null (singles := isOpInDomain(f,t,1)) => NIL
-  tuple := NIL
-  for [[.,arg], :.] in singles while null tuple repeat
-    if arg is ['Tuple,.] then tuple := arg
-  null tuple => NIL
-  [.,D,form] := t2
-  newArg := [mkAtreeNode "tuple",:args]
-  putTarget(newArg, tuple)
-  ms := bottomUp newArg
-  first ms ~= tuple => NIL
-  form := [first form, newArg]
-  putAtree(first form,"dollar",t)
-  ms := bottomUp form
-  putValue(op,getValue first form)
-  putModeSet(op,ms)
-
-upLispCall(op,t) ==
-  -- process $Lisp calls
-  if atom t then code:=getUnname t else
-    [lispOp,:argl]:= t
-    null functionp lispOp.0 =>
-      throwKeyedMsg("S2IS0024",[lispOp.0])
-    for arg in argl repeat bottomUp arg
-    code:=[getUnname lispOp,
-      :[getArgValue(arg,computedMode arg) for arg in argl]]
-  rt := '(SExpression)
-  putValue(op,object(code,rt))
-  putModeSet(op,[rt])
-
---% Handlers for equation
-
-upequation tree ==
-  -- only handle this if there is a target of Boolean
-  -- this should speed things up a bit
-  tree isnt [op,lhs,rhs] => NIL
-  $Boolean ~= getTarget(op) => NIL
-  not vector? op => NIL
-  -- change equation into '='
-  op.0 := "="
-  bottomUp tree
-
---% Handler for error
-
-uperror t ==
-  -- when compiling a function, this merely inserts another argument
-  -- which is the name of the function.
-  not $compilingMap => NIL
-  t isnt [op,msg] => NIL
-  msgMs := bottomUp putCallInfo(msg,"error",1,1)
-  msgMs isnt [=$String] => NIL
-  t.rest := [mkAtree object2String $mapName,msg]
-  bottomUp t
-
---% Handlers for free and local
-
-upfree t ==
-  setCodeToVoid t
-
-uplocal t ==
-  setCodeToVoid t
-
-upfreeWithType(var,type) ==
-  sayKeyedMsg("S2IS0055",['"free",var])
-  var
-
-uplocalWithType(var,type) ==
-  sayKeyedMsg("S2IS0055",['"local",var])
-  var
-
---% Handlers for has
-
-uphas t ==
-  t isnt [op,type,prop] => nil
-  -- handler for category and attribute queries
-  type :=
-    x := elaborateForm type
-    getModeSet x is [m] and (conceptualType m = $Type or categoryForm? m) =>
-      val := objValUnwrap getValue x
-      $genValue => MKQ val
-      ["devaluate",val]
-    throwKeyedMsg("S2IE0021",[type])
-  catCode :=
-    -- FIXME: when we come to support category valued variable
-    --        this code needs to be adapted.
-    prop := unabbrev prop
-    evaluateType0 prop => ["evaluateType", MKQ prop]
-    MKQ prop
-  code := ["NOT",["NULL",["newHasTest",type, catCode]]]
-  putValue(op,object(code,$Boolean))
-  putModeSet(op,[$Boolean])
-
---hasTest(a,b) ==
---  newHasTest(a,b)  --see NRUNFAST BOOT
-
---% Handlers for IF
-
-upIF t ==
-  t isnt [op,cond,a,b] => nil
-  bottomUpPredicate(cond,'"if/when")
-  $genValue => interpIF(op,cond,a,b)
-  compileIF(op,cond,a,b,t)
-
-compileIF(op,cond,a,b,t) ==
-  -- type analyzer for compiled case where types of both branches of
-  --  IF are resolved.
-  ms1 := bottomUp a
-  [m1] := ms1
-  b = "%noBranch" =>
-    evalIF(op,rest t,$Void)
-    putModeSet(op,[$Void])
-  b = "%noMapVal" =>
-    -- if this was a return statement, we take the mode to be that
-    -- of what is being returned.
-    if getUnname a = 'return then
-      ms1 := bottomUp second a
-      [m1] := ms1
-    evalIF(op,rest t,m1)
-    putModeSet(op,ms1)
-  ms2 := bottomUp b
-  [m2] := ms2
-  m:=
-    m2=m1 => m1
-    m2 = $Exit => m1
-    m1 = $Exit => m2
-    if m1 = $Symbol then
-      m1:=getMinimalVarMode(getUnname a,$declaredMode)
-    if m2 = $Symbol then
-      m2:=getMinimalVarMode(getUnname b,$declaredMode)
-    (r := resolveTTAny(m2,m1)) => r
-    rempropI($mapName,'localModemap)
-    rempropI($mapName,'localVars)
-    rempropI($mapName,'mapBody)
-    throwKeyedMsg("S2IS0026",[m2,m1])
-  evalIF(op,rest t,m)
-  putModeSet(op,[m])
-
-evalIF(op,[cond,a,b],m) ==
-  -- generate code form compiled IF
-  elseCode:=
-    b="%noMapVal" =>
-      [[MKQ true, ["throwKeyedMsg",MKQ "S2IM0018",
-        ["CONS",MKQ object2Identifier $mapName,NIL]]]]
-    b='%noBranch =>
-      $lastLineInSEQ => [[MKQ true,["voidValue"]]]
-      NIL
-    [[MKQ true,genIFvalCode(b,m)]]
-  code:=['%when,[getArgValue(cond,$Boolean),
-    genIFvalCode(a,m)],:elseCode]
-  triple:= objNew(code,m)
-  putValue(op,triple)
-
-genIFvalCode(t,m) ==
-  -- passes type information down braches of IF statement
-  --  So that coercions can be performed on data at branches of IF.
-  m1 := computedMode t
-  m1=m => getArgValue(t,m)
-  code:=objVal getValue t
-  IFcodeTran(code,m,m1)
-
-IFcodeTran(code,m,m1) ==
-  -- coerces values at branches of IF
-  null code => code
-  code is ["spadThrowBrightly",:.] => code
-  m1 = $Exit => code
-  code isnt ['%when,[p1,a1],['%otherwise,a2]] =>
-    m = $Void => code
-    code' := coerceInteractive(objNew(quote2Wrapped code,m1),m) =>
-      getValueNormalForm code'
-    throwKeyedMsgCannotCoerceWithValue(quote2Wrapped code,m1,m)
-  a1:=IFcodeTran(a1,m,m1)
-  a2:=IFcodeTran(a2,m,m1)
-  ['%when,[p1,a1],['%otherwise,a2]]
-
-interpIF(op,cond,a,b) ==
-  -- non-compiled version of IF type analyzer.  Doesn't resolve accross
-  --  branches of the IF.
-  val:= getValue cond
-  val:= coerceInteractive(val,$Boolean) =>
-    objValUnwrap(val) => upIFgenValue(op,a)
-    b="%noBranch" => setValueToVoid op
-    upIFgenValue(op,b)
-  throwKeyedMsg("S2IS0031",NIL)
-
-upIFgenValue(op,tree) ==
-  -- evaluates tree and transfers the results to op
-  ms:=bottomUp tree
-  val:= getValue tree
-  putValue(op,val)
-  putModeSet(op,ms)
-
---% Handlers for is
-
-upis t ==
-  t isnt [op,a,pattern] => nil
-  $opIsIs : local := true
-  upisAndIsnt t
-
-upisnt t ==
-  t isnt [op,a,pattern] => nil
-  $opIsIs : local := nil
-  upisAndIsnt t
-
-upisAndIsnt(t:=[op,a,pattern]) ==
-  -- handler for "is" pattern matching
-  mS:= bottomUp a
-  mS isnt [m] =>
-    keyedSystemError("S2GE0016",['"upisAndIsnt",'"non-unique modeset"])
-  putPvarModes(removeConstruct pattern,m)
-  evalis(op,rest t,m)
-  putModeSet(op,[$Boolean])
-
-putPvarModes(pattern,m) ==
-  -- Puts the modes for the pattern variables into $env
-  m isnt ["List",um] => throwKeyedMsg("S2IS0030",NIL)
-  for pvar in pattern repeat
-    IDENTP pvar => (not (pvar=$quadSymbol)) and put(pvar,'mode,um,$env)
-    pvar is ['_:,var] =>
-      null (var=$quadSymbol) and put(var,"mode",m,$env)
-    pvar is ['_=,var] =>
-      null (var=$quadSymbol) and put(var,"mode",um,$env)
-    putPvarModes(pvar,um)
-
-evalis(op,[a,pattern],mode) ==
-  -- actually handles is and isnt
-  if $opIsIs
-    then fun := 'evalIsPredicate
-    else fun := 'evalIsntPredicate
-  if isLocalPred pattern then
-    code:= compileIs(a,pattern)
-  else code:=[fun,getArgValue(a,mode),
-    MKQ pattern,MKQ mode]
-  triple := object(code,$Boolean)
-  putValue(op,triple)
-
-isLocalPred pattern ==
-  -- returns true if this predicate is to be compiled
-  for pat in pattern repeat
-    IDENTP pat and isLocallyBound pat => return true
-    pat is [":",var] and isLocallyBound var => return true
-    pat is ["=",var] and isLocallyBound var => return true
-
-compileIs(val,pattern) ==
-  -- produce code for compiled "is" predicate.  makes pattern variables
-  --  into local variables of the function
-  vars:= NIL
-  for pat in rest pattern repeat
-    IDENTP(pat) and isLocallyBound pat => vars:=[pat,:vars]
-    pat is [":",var] => vars:= [var,:vars]
-    pat is ["=",var] => vars:= [var,:vars]
-  predCode:=["%LET",g:=gensym(),["isPatternMatch",
-    getArgValue(val,computedMode val),MKQ removeConstruct pattern]]
-  for var in removeDuplicates vars repeat
-    assignCode:=[["%LET",var,["CDR",["ASSQ",MKQ var,g]]],:assignCode]
-  null $opIsIs =>
-    ['%when,[["EQ",predCode,MKQ "failed"],["SEQ",:assignCode,'%true]]]
-  ['%when,[['%not,["EQ",predCode,MKQ "failed"]],["SEQ",:assignCode,'%true]]]
-
-evalIsPredicate(value,pattern,mode) ==
-  --This function pattern matches value to pattern, and returns
-  --true if it matches, and false otherwise.  As a side effect
-  --if the pattern matches then the bindings given in the pattern
-  --are made
-  pattern:= removeConstruct pattern
-  not ((valueAlist:=isPatternMatch(value,pattern))='failed) =>
-    for [id,:value] in valueAlist repeat
-      evalLETchangeValue(id,objNewWrap(value,get(id,'mode,$env)))
-    true
-  false
-
-evalIsntPredicate(value,pattern,mode) ==
-  evalIsPredicate(value,pattern,mode) => false
-  true
-
-removeConstruct pat ==
-  -- removes the "construct" from the beginning of patterns
-  if pat is ["construct",:p] then pat:=p
-  if pat is ["cons", a, b] then pat := [a, [":", b]]
-  atom pat => pat
-  pat.first := removeConstruct first pat
-  pat.rest := removeConstruct rest pat
-  pat
-
-isPatternMatch(l,pats) ==
-  -- perform the actual pattern match
-  $subs: local := NIL
-  isPatMatch(l,pats)
-  $subs
-
-isPatMatch(l,pats) ==
-  null pats =>
-    null l => $subs
-    $subs:='failed
-  null l =>
-    null pats => $subs
-    pats is [[":",var]] =>
-      $subs := [[var],:$subs]
-    $subs:='failed
-  pats is [pat,:restPats] =>
-    IDENTP pat =>
-      $subs:=[[pat,:first l],:$subs]
-      isPatMatch(rest l,restPats)
-    pat is ["=",var] =>
-      p:=ASSQ(var,$subs) =>
-        first l = rest p => isPatMatch(rest l, restPats)
-        $subs:="failed"
-      $subs:="failed"
-    pat is [":",var] =>
-      n:=#restPats
-      m:=#l-n
-      m<0 => $subs:="failed"
-      ZEROP n => $subs:=[[var,:l],:$subs]
-      $subs:=[[var,:[x for x in l for i in 1..m]],:$subs]
-      isPatMatch(DROP(m,l),restPats)
-    isPatMatch(first l,pat) = "failed" => "failed"
-    isPatMatch(rest l,restPats)
-  keyedSystemError("S2GE0016",['"isPatMatch",
-     '"unknown form of is predicate"])
-
---% Handler for iterate
-
-upiterate t ==
-  null $repeatBodyLabel => throwKeyedMsg("S2IS0029",['"iterate"])
-  $iterateCount := $iterateCount + 1
-  code := ["THROW",$repeatBodyLabel,'(voidValue)]
-  $genValue => THROW(eval $repeatBodyLabel,voidValue())
-  putValue(t,objNew(code,$Void))
-  putModeSet(t,[$Void])
-
---% Handler for break
-
-upbreak t ==
-  t isnt [op,.] => nil
-  null $repeatLabel => throwKeyedMsg("S2IS0029",['"break"])
-  $breakCount := $breakCount + 1
-  code := ["THROW",$repeatLabel,'(voidValue)]
-  $genValue => THROW(eval $repeatLabel,voidValue())
-  putValue(op,objNew(code,$Void))
-  putModeSet(op,[$Void])
-
---% Handlers for %LET
-
-up%LET t ==
-  -- analyzes and evaluates the righthand side, and does the variable
-  -- binding
-  t isnt [op,lhs,rhs] => nil
-  $declaredMode: local := NIL
-  cons? lhs =>
-    var:= getUnname first lhs
-    var = "construct" => upLETWithPatternOnLhs t
-    var = "QUOTE" => throwKeyedMsg("S2IS0027",['"A quoted form"])
-    upLETWithFormOnLhs(op,lhs,rhs)
-  var:= getUnname lhs
-  var = $immediateDataSymbol =>
-    -- following will be immediate data, so probably ok to not
-    -- specially format it
-    obj := objValUnwrap coerceInteractive(getValue lhs,$OutputForm)
-    throwKeyedMsg("S2IS0027",[obj])
-  var in '(% %%) =>               -- for history
-    throwKeyedMsg("S2IS0027",[var])
-  (IDENTP var) and not (var in '(true false elt QUOTE)) =>
-    var ~= (var' := unabbrev(var)) =>  -- constructor abbreviation
-      throwKeyedMsg("S2IS0028",[var,var'])
-    if get(var,'isInterpreterFunction,$e) then
-      putHist(var,'isInterpreterFunction,false,$e)
-      sayKeyedMsg("S2IS0049",['"Function",var])
-    else if get(var,'isInterpreterRule,$e) then
-      putHist(var,'isInterpreterRule,false,$e)
-      sayKeyedMsg("S2IS0049",['"Rule",var])
-    (m := isType rhs) => upLETtype(op,lhs,m)
-    transferPropsToNode(var,lhs)
-    if ( m:= getMode(lhs) ) then
-      $declaredMode := m
-      putTarget(rhs,m)
-    if (val := getValue lhs) and (objMode val = $Boolean) and
-      getUnname(rhs) = 'equation then putTarget(rhs,$Boolean)
-    (rhsMs:= bottomUp rhs) = [$Void] =>
-      throwKeyedMsg("S2IS0034",[var])
-    val:=evalLET(lhs,rhs)
-    putValue(op,val)
-    putModeSet(op,[objMode(val)])
-  throwKeyedMsg("S2IS0027",[var])
-
-evalLET(lhs,rhs) ==
-  -- lhs is a vector for a variable, and rhs is the evaluated atree
-  --  for the value which is coerced to the mode of lhs
-  $useConvertForCoercions: local := true
-  v' := (v:= getValue rhs)
-  ((not getMode lhs) and (getModeSet rhs is [.])) or
-    get(getUnname lhs,'autoDeclare,$env) =>
-      v:=
-        $genValue => v
-        objNew(getValueNormalForm v,objMode v)
-      evalLETput(lhs,v)
-  t1:= objMode v
-  t2' := (t2 := getMode lhs)
-  value:=
-    t1 = t2 =>
-      $genValue => v
-      objNew(getValueNormalForm v,objMode v)
-    if isPartialMode t2 then
-      if t1 = $Symbol and $declaredMode then
-        t1:= getMinimalVarMode(objValUnwrap v,$declaredMode)
-      t' := t2
-      null (t2 := resolveTM(t1,t2)) =>
-        if not t2 then t2 := t'
-        throwKeyedMsg("S2IS0035",[t1,t2])
-    null (v := getArgValue(rhs,t2)) =>
-      isWrapped(objVal v') and (v2:=coerceInteractive(v',$OutputForm)) =>
-        throwKeyedMsg("S2IS0036",[objValUnwrap v2,t2])
-      throwKeyedMsg("S2IS0037",[t2])
-    t2 and object(v,t2)
-  value => evalLETput(lhs,value)
-  throwKeyedMsgCannotCoerceWithValue(objVal v,t1,getMode lhs)
-
-evalLETput(lhs,value) ==
-  -- put value into the cell for lhs
-  name:= getUnname lhs
-  if not $genValue then
-    code:=
-      isLocallyBound name =>
-        om := objMode(value)
-        dm := get(name,'mode,$env)
-        dm and not ((om = dm) or isSubDomain(om,dm) or
-          isSubDomain(dm,om)) =>
-            compFailure ['"   The type of the local variable",
-              :bright name,'"has changed in the computation."]
-        if dm and isSubDomain(dm,om) then put(name,'mode,om,$env)
-        ["%LET",name,objVal value,$mapName]
-               -- $mapName is set in analyzeMap
-      om := objMode value
-      dm := get(name, 'mode, $env) or objMode(get(name, 'value, $e))
-      dm and (null $compilingMap) and not(om = dm) and not(isSubDomain(om, dm)) =>
-        THROW('loopCompiler,'tryInterpOnly)
-      ['unwrap,['evalLETchangeValue,MKQ name,
-        objNewCode(['wrap,objVal value],objMode value)]]
-    value:= objNew(code,objMode value)
-    isLocallyBound name =>
-      if not get(name,'mode,$env) then put(name,'autoDeclare,'T,$env)
-      put(name,'mode,objMode(value),$env)
-    put(name,'automode,objMode(value),$env)
-  $genValue and evalLETchangeValue(name,value)
-  putValue(lhs,value)
-
-upLETWithPatternOnLhs(t := [op,pattern,a]) ==
-  $opIsIs : local := true
-  [m] := bottomUp a
-  putPvarModes(pattern,m)
-  object := evalis(op,[a,pattern],m)
-  -- have to change code to return value of a
-  failCode :=
-    ['spadThrowBrightly,['concat,
-      '"   Pattern",['QUOTE,bright form2String pattern],
-        '"is not matched in assignment to right-hand side."]]
-  if $genValue
-    then
-      null objValUnwrap object => eval failCode
-      putValue(op,getValue a)
-    else
-      code := ['%when,[objVal object,objVal getValue a],['%otherwise,failCode]]
-      putValue(op,objNew(code,m))
-  putModeSet(op,[m])
-
-evalLETchangeValue(name,value) ==
-  -- write the value of name into the environment, clearing dependent
-  --  maps if its type changes from its last value
-  localEnv := cons? $env
-  clearCompilationsFlag :=
-    val:= (localEnv and get(name,'value,$env)) or get(name,'value,$e)
-    null val =>
-      not ((localEnv and get(name,'mode,$env)) or get(name,'mode,$e))
-    objMode val ~= objMode(value)
-  if clearCompilationsFlag then
-    clearDependencies(name,true)
-  if localEnv and isLocallyBound name
-    then $env:= putHist(name,'value,value,$env)
-    else putIntSymTab(name,'value,value,$e)
-  objVal value
-
-upLETWithFormOnLhs(op,lhs,rhs) ==
-  -- bottomUp for assignment to forms (setelt, table or tuple)
-  lhs' := getUnnameIfCan lhs
-  rhs' := getUnnameIfCan rhs
-  lhs' = "tuple" =>
-    rhs' ~= "tuple" => throwKeyedMsg("S2IS0039",NIL)
-    #(lhs) ~= #(rhs) => throwKeyedMsg("S2IS0038",NIL)
-    -- generate a sequence of assignments, using local variables
-    -- to first hold the assignments so that things like
-    -- (t1,t2) := (t2,t1) will work.
-    seq := []
-    temps := [gensym() for l in rest lhs]
-    for lvar in temps repeat mkLocalVar($mapName,lvar)
-    for l in reverse rest lhs for t in temps repeat
-      transferPropsToNode(getUnname l,l)
-      let := mkAtreeNode "%LET"
-      t'  := mkAtreeNode t
-      if m := getMode(l) then putMode(t',m)
-      seq := [[let,l,t'],:seq]
-    for t in temps for r in reverse rest rhs
-      for l in reverse rest lhs repeat
-        let := mkAtreeNode "%LET"
-        t'  := mkAtreeNode t
-        if m := getMode(l) then putMode(t',m)
-        seq := [[let,t',r],:seq]
-    seq := [mkAtreeNode 'SEQ,:seq]
-    ms := bottomUp seq
-    putValue(op,getValue seq)
-    putModeSet(op,ms)
-  rhs' = "tuple" => throwKeyedMsg("S2IS0039",NIL)
-  tree:= seteltable(lhs,rhs) => upSetelt(op,lhs,tree)
-  throwKeyedMsg("S2IS0060", NIL)
---  upTableSetelt(op,lhs,rhs)
-
-seteltable(lhs is [f,:argl],rhs) ==
-  -- produces the setelt form for trees such as "l.2:= 3"
-  null (g := getUnnameIfCan f) => NIL
-  g="elt" => altSeteltable [:argl, rhs]
-  get(g,'value,$e) is [expr,:.] and isMapExpr expr => NIL
-  transferPropsToNode(g,f)
-  getValue(lhs) or getMode(lhs) =>
-    f is [f',:argl'] => altSeteltable [f',:argl',:argl,rhs]
-    altSeteltable [:lhs,rhs]
-  NIL
-
-altSeteltable args ==
-    for x in args repeat bottomUp x
-    newOps := [mkAtreeNode "setelt", mkAtreeNode "set!"]
-    form := NIL
-
-    -- first look for exact matches for any of the possibilities
-    while null form for newOp in newOps  repeat
-        if selectMms(newOp, args, NIL) then form := [newOp, :args]
-
-    -- now try retracting arguments after the first
-    while null form and ( "and"/[retractAtree(a) for a in rest args] ) repeat
-        while null form for newOp in newOps  repeat
-            if selectMms(newOp, args, NIL) then form := [newOp, :args]
-
-    form
-
-
-upSetelt(op,lhs,tree) ==
-  -- type analyzes implicit setelt forms
-  var:=opOf lhs
-  transferPropsToNode(getUnname var,var)
-  if (m1:=getMode var) then $declaredMode:= m1
-  if m1 or ((v1 := getValue var) and (m1 := objMode v1)) then
-    putModeSet(var,[m1])
-  ms := bottomUp tree
-  putValue(op,getValue tree)
-  putModeSet(op,ms)
-
-upTableSetelt(op,lhs is [htOp,:args],rhs) ==
-  -- called only for undeclared, uninitialized table setelts
-  ("*" = (PNAME getUnname htOp).0) and (1 ~= # args) =>
-    throwKeyedMsg("S2IS0040",NIL)
-  # args ~= 1 =>
-    throwKeyedMsg("S2IS0041",[[getUnname htOp,'".[",
-      getUnname first args,
-        ['",",getUnname arg for arg in rest args],'"]"]])
-  keyMode := $Any
-  putMode (htOp,['Table,keyMode,$Any])
-  -- if we are to use a new table, we must call the "table"
-  -- function to give it an initial value.
-  bottomUp [mkAtreeNode "%LET",htOp,[mkAtreeNode 'table]]
-  tableCode := objVal getValue htOp
-  r := upSetelt(op, lhs, [mkAtreeNode "setelt",:lhs,rhs])
-  $genValue => r
-  -- construct code
-  t := getValue op
-  putValue(op,objNew(['PROGN,tableCode,objVal t],objMode t))
-  r
-
-unVectorize body ==
-  -- transforms from an atree back into a tree
-  vector? body =>
-    name := getUnname body
-    name ~= $immediateDataSymbol => name
-    objValUnwrap getValue body
-  atom body => body
-  body is [op,:argl] =>
-    newOp:=unVectorize op
-    if newOp = 'SUCHTHAT then newOp := "|"
-    if newOp = 'COERCE then newOp := "::"
-    if newOp = 'Dollar then newOp := "$elt"
-    [newOp,:unVectorize argl]
-  systemErrorHere ["unVectorize",body]
-
-isType t ==
-  -- Returns the evaluated type if t is a tree representing a type,
-  -- and NIL otherwise
-   op:=opOf t
-   vector? op =>
-     isMap(op:= getUnname op) => NIL
-     op = 'Mapping and cons? t =>
-       argTypes := [isType type for type in rest t]
-       "or"/[null type for type in argTypes] => nil
-       ['Mapping, :argTypes]
-     isLocallyBound op => NIL
-     d := isDomainValuedVariable op => d
-     type:=
-       -- next line handles subscripted vars
-         (abbreviation?(op) or (op = 'typeOf) or
-           constructor?(op) or (op in '(Record Union Enumeration))) and
-             unabbrev unVectorize t
-     type and evaluateType type
-   d := isDomainValuedVariable op => d
-   NIL
-
-upLETtype(op,lhs,type) ==
-  -- performs type assignment
-  opName:= getUnname lhs
-  (not $genValue) and "or"/[CONTAINED(var,type) for var in $localVars] =>
-    compFailure ['"   Cannot compile type assignment to",:bright opName]
-  mode := conceptualType type
-  val:= objNew(type,mode)
-  if isLocallyBound opName then put(opName,'value,val,$env)
-  else putHist(opName,'value,val,$e)
-  putValue(op,val)
-  -- have to fix the following
-  putModeSet(op,[mode])
-
-assignSymbol(symbol, value, domain) ==
--- Special function for binding an interpreter variable from within algebra
--- code.  Does not do the assignment and returns nil, if the variable is
--- already assigned
-  val := get(symbol, 'value, $e) => nil
-  obj := objNew(wrap value, devaluate domain)
-  put(symbol, 'value, obj, $e)
-  true
-
---% Handler for Interpreter Macros
-
-getInterpMacroNames() ==
-  names := [n for [n,:.] in $InterpreterMacroAlist]
-  if (e := CAAR $InteractiveFrame) and (m := assoc("--macros--",e)) then
-    names := append(names,[n for [n,:.] in rest m])
-  MSORT names
-
-isInterpMacro name ==
-  -- look in local and then global environment for a macro
-  not IDENTP name => NIL
-  name in $specialOps => NIL
-  (m := get("--macros--",name,$env)) => m
-  (m := get("--macros--",name,$e))   => m
-  (m := get("--macros--",name,$InteractiveFrame))   => m
-  -- $InterpreterMacroAlist will probably be phased out soon
-  (sv := assoc(name,$InterpreterMacroAlist)) => [NIL,:rest sv]
-  NIL
-
---% Handlers for prefix QUOTE
-
-upQUOTE t ==
-  t isnt [op,expr] => NIL
-  ms:= list
-    m:= getBasicMode expr => m
-    IDENTP expr =>
---    $useSymbolNotVariable => $Symbol
-      getTarget t = $Identifier => $Identifier
-      ['Variable,expr]
-    $InputForm
-  evalQUOTE(op,[expr],ms)
-  putModeSet(op,ms)
-
-evalQUOTE(op,[expr],[m]) ==
-  triple:=
-    $genValue => objNewWrap(expr,m)
-    objNew(['QUOTE,expr],m)
-  putValue(op,triple)
-
---% Quasiquotation
-up_[_|_|_] t ==
-  t isnt [op, x] => nil
-  mode := getTypeOfSyntax x
-  putValue(op, objNewWrap(x, mode))
-  putModeSet(op, [mode])
-
---% Handler for pretend
-
-uppretend t ==
-  t isnt [op,expr,type] => NIL
-  mode := evaluateType unabbrev type
-  not isValidType(mode) => throwKeyedMsg("S2IE0004",[mode])
-  bottomUp expr
-  putValue(op,objNew(objVal getValue expr,mode))
-  putModeSet(op,[mode])
-
---% Handlers for REDUCE
-
-getReduceFunction(op,type,result, locale) ==
-  -- return the function cell for operation with the signature
-  --  (type,type) -> type, possible from locale
-  if type is ['Variable,var] then
-    args := [arg := mkAtreeNode var,arg]
-    putValue(arg,objNewWrap(var,type))
-  else
-    args := [arg := mkAtreeNode "%1",arg]
-    if type=$Symbol then putValue(arg,objNewWrap("%1",$Symbol))
-  putModeSet(arg,[type])
-  vecOp:=mkAtreeNode op
-  transferPropsToNode(op,vecOp)
-  if locale then putAtree(vecOp,'dollar,locale)
-  mmS:= selectMms(vecOp,args,result)
-  mm:= or/[mm for (mm:=[[.,:sig],fun,cond]) in mmS |
-    (isHomogeneousArgs sig) and "and"/[null c for c in cond]]
-  null mm => 'failed
-  [[dc,:sig],fun,:.]:=mm
-  dc='local => [MKQ [fun,:'local],:first sig]
-  dcVector := evalDomain dc
-  $compilingMap =>
-    k := NRTgetMinivectorIndex(
-      NRTcompiledLookup(op,sig,dcVector),op,sig,dcVector)
-    ['ELT,"$$$",k]  --$$$ denotes minivector
-  env:=
-    NRTcompiledLookup(op,sig,dcVector)
-  MKQ env
-
-isHomogeneous sig ==
-  --return true if sig describes a homogeneous binary operation
-  sig.0=sig.1 and sig.1=sig.2
-
-isHomogeneousArgs sig ==
-  --return true if sig describes a homogeneous binary operation
-  sig.1=sig.2
-
---% Handlers for REPEAT
-
-transformREPEAT [:itrl,body] ==
-  -- syntactic transformation of repeat iterators, called from mkAtree2
-  iterList:=[:iterTran1 for it in itrl] where iterTran1() ==
-    it is ["STEP",index,lower,step,:upperList] =>
-      [["STEP",index,mkAtree1 lower,mkAtree1 step,:[mkAtree1 upper
-        for upper in upperList]]]
-    it is ["IN",index,s] =>
-      [['IN,index,mkAtree1 s]]
-    it is ["ON",index,s] =>
-      [['IN,index,mkAtree1 ['tails,s]]]
-    it is ["WHILE",b] =>
-      [["WHILE",mkAtree1 b]]
-    it is ["|",pred] =>
-      [["SUCHTHAT",mkAtree1 pred]]
-    it is [op,:.] and (op in '(VALUE UNTIL)) => nil
-  bodyTree:=mkAtree1 body
-  iterList:=NCONC(iterList,[:iterTran2 for it in itrl]) where iterTran2() ==
-    it is ["STEP",:.] => nil
-    it is ["IN",:.] => nil
-    it is ["ON",:.] => nil
-    it is ["WHILE",:.] => nil
-    it is [op,b] and (op in '(UNTIL VALUE)) =>
-      [[op,mkAtree1 b]]
-    it is ['_|,pred] => nil
-    keyedSystemError("S2GE0016",
-      ['"transformREPEAT",'"Unknown type of iterator"])
-  [:iterList,bodyTree]
-
-upREPEAT t ==
-  -- REPEATS always return void() of Void
-  -- assures throw to interpret-code mode goes to outermost loop
-  $repeatLabel : local := MKQ gensym()
-  $breakCount  : local := 0
-  $repeatBodyLabel : local := MKQ gensym()
-  $iterateCount    : local := 0
-  $compilingLoop => upREPEAT1 t
-  upREPEAT0 t
-
-upREPEAT0 t ==
-  -- sets up catch point for interp-only mode
-  $compilingLoop: local := true
-  ms := CATCH('loopCompiler,upREPEAT1 t)
-  ms = 'tryInterpOnly => interpOnlyREPEAT t
-  ms
-
-upREPEAT1 t ==
-  -- repeat loop handler with compiled body
-  -- see if it has the expected form
-  t isnt [op,:itrl,body] => NIL
-  -- determine the mode of the repeat loop. At the moment, if there
-  -- there are no iterators and there are no "break" statements, then
-  -- the return type is Exit, otherwise Void.
-  repeatMode :=
-    null(itrl) and ($breakCount=0) => $Void
-    $Void
-
-  -- if interpreting, go do that
-  $interpOnly => interpREPEAT(op,itrl,body,repeatMode)
-
-  -- analyze iterators and loop body
-  $iteratorVars: local := nil
-  upLoopIters itrl
-  bottomUpCompile body
-
-  -- now that the body is analyzed, we should know everything that
-  -- is in the UNTIL clause
-  for itr in itrl repeat
-    itr is ["UNTIL", pred] => bottomUpCompilePredicate(pred,'"until")
-
-  -- now go do it
-  evalREPEAT(op,rest t,repeatMode)
-  putModeSet(op,[repeatMode])
-
-evalREPEAT(op,[:itrl,body],repeatMode) ==
-  -- generate code for loop
-  bodyMode := computedMode body
-  bodyCode := getArgValue(body,bodyMode)
-  if $iterateCount > 0 then
-    bodyCode := ["CATCH",$repeatBodyLabel,bodyCode]
-  code := ['%loop,:[evalLoopIter itr for itr in itrl],bodyCode,voidValue()]
-  code := timedOptimization code
-  if $breakCount > 0 then code := ['CATCH,$repeatLabel,code]
-  val :=
-    $genValue =>
-      timedEVALFUN code
-      objNewWrap(voidValue(),repeatMode)
-    objNew(code,repeatMode)
-  putValue(op,val)
-
-interpOnlyREPEAT t ==
-  -- interpret-code mode call to upREPEAT
-  $genValue: local := true
-  $interpOnly: local := true
-  upREPEAT1 t
-
-interpREPEAT(op,itrl,body,repeatMode) ==
-  -- performs interpret-code repeat
-  $indexVars: local := NIL
-  $indexTypes: local := NIL
-  code :=
-      -- we must insert a CATCH for the iterate clause
-      ['%loop,:[interpIter itr for itr in itrl],
-        ["CATCH",$repeatBodyLabel,interpLoop(body,$indexVars,
-          $indexTypes,nil)],voidValue()]
-  SPADCATCH(eval $repeatLabel,timedEVALFUN code)
-  val:= objNewWrap(voidValue(),repeatMode)
-  putValue(op,val)
-  putModeSet(op,[repeatMode])
-
-interpLoop(expr,indexList,indexTypes,requiredType) ==
-  -- generates code for interp-only repeat body
-  ['interpLoopIter,MKQ expr,MKQ indexList,["LIST",:indexList],
-    MKQ indexTypes, MKQ requiredType]
-
-interpLoopIter(exp,indexList,indexVals,indexTypes,requiredType) ==
-  -- call interpreter on exp with loop vars in indexList with given
-  --  values and types, requiredType is used from interpCOLLECT
-  --  to indicate the required type of the result
-  emptyAtree exp
-  for i in indexList for val in indexVals for type in indexTypes repeat
-    put(i,'value,objNewWrap(val,type),$env)
-  bottomUp exp
-  v:= getValue exp
-  val :=
-    null requiredType => v
-    coerceInteractive(v,requiredType)
-  null val =>
-    throwKeyedMsgCannotCoerceWithValue(objVal v,objMode v,requiredType)
-  objValUnwrap val
-
---% Handler for return
-
-upreturn t ==
-  -- make sure we are in a user function
-  t isnt [op,val] => NIL
-  (null $compilingMap) and (null $interpOnly) =>
-    throwKeyedMsg("S2IS0047",NIL)
-  if $mapTarget then putTarget(val,$mapTarget)
-  bottomUp val
-  if $mapTarget
-    then
-      val' := getArgValue(val, $mapTarget)
-      m := $mapTarget
-    else
-      val' := getValueNormalForm getValue val
-      m := computedMode val
-  cn := mapCatchName $mapName
-  $mapReturnTypes := insert(m, $mapReturnTypes)
-  $mapThrowCount := $mapThrowCount + 1
-  -- if $genValue then we are interpreting the map
-  $genValue => THROW(cn,objNewWrap(removeQuote val',m))
-  putValue(op,objNew(['THROW,MKQ cn,val'],m))
-  putModeSet(op,[$Exit])
-
---% Handler for SEQ
-
-upSEQ u ==
-  -- assumes that exits were translated into if-then-elses
-  -- handles flat SEQs and embedded returns
-  u isnt [op,:args] => NIL
-  if (target := getTarget(op)) then putTarget(last args, target)
-  for x in args repeat bottomUp x
-  null (m := computedMode last args) =>
-    keyedSystemError("S2GE0016",['"upSEQ",
-      '"last line of SEQ has no mode"])
-  evalSEQ(op,args,m)
-  putModeSet(op,[m])
-
-evalSEQ(op,args,m) ==
-  -- generate code for SEQ
-  [:argl,last] := args
-  val:=
-    $genValue => getValue last
-    bodyCode := nil
-    for x in args repeat
-      (m1 := computedMode x) and (m1 ~= '$ThrowAwayMode) =>
-        (av := getArgValue(x,m1)) ~= voidValue() =>
-          bodyCode := [av,:bodyCode]
-    code:=
-      bodyCode is [c] => c
-      ['PROGN,:reverse bodyCode]
-    objNew(code,m)
-  putValue(op,val)
-
---% Handlers for tuple
-
-uptuple t ==
-  --Computes the common mode set of the construct by resolving across
-  --the argument list, and evaluating
-  t isnt [op,:l] => nil
-  dol := getAtree(op,'dollar)
-  tar := getTarget(op) or dol
-  null l => upNullTuple(op,l,tar)
-  isTaggedUnion tar => upTaggedUnionConstruct(op,l,tar)
-  aggs := '(List)
-  if tar and cons?(tar) and not isPartialMode(tar) then
-    first(tar) in aggs =>
-      ud := second tar
-      for x in l repeat if not getTarget(x) then putTarget(x,ud)
-    first(tar) in '(Matrix SquareMatrix RectangularMatrix) =>
-      vec := ['List,underDomainOf tar]
-      for x in l repeat if not getTarget(x) then putTarget(x,vec)
-  argModeSetList:= [bottomUp x for x in l]
-  eltTypes := replaceSymbols([first x for x in argModeSetList],l)
-  if not isPartialMode(tar) and tar is ['Tuple,ud] then
-    mode := ['Tuple, resolveTypeListAny [ud,:eltTypes]]
-  else mode := ['Tuple, resolveTypeListAny eltTypes]
-  if isPartialMode tar then tar:=resolveTM(mode,tar)
-  evalTuple(op,l,mode,tar)
-
-evalTuple(op,l,m,tar) ==
-  [agg,:.,underMode]:= m
-  code := asTupleNewCode(underMode, #l,
-    [(getArgValue(x,underMode) or throwKeyedMsg("S2IC0007",[underMode])) for x in l])
-  val := object(code,m)
-  if tar then val1 := coerceInteractive(val,tar) else val1 := val
-
-  val1 =>
-    putValue(op,val1)
-    putModeSet(op,[tar or m])
-  putValue(op,val)
-  putModeSet(op,[m])
-
-upNullTuple(op,l,tar) ==
-  -- handler for the empty tuple
-  defMode :=
-    tar and tar is [a,b] and (a in '(Stream Vector List)) and
-      not isPartialMode(b) => ['Tuple,b]
-    '(Tuple (None))
-  val := objNewWrap(asTupleNew(getVMType second defMode,0,NIL), defMode)
-  tar and not isPartialMode(tar) =>
-    null (val' := coerceInteractive(val,tar)) =>
-      throwKeyedMsg("S2IS0013",[tar])
-    putValue(op,val')
-    putModeSet(op,[tar])
-  putValue(op,val)
-  putModeSet(op,[defMode])
-
---% Handler for typeOf
-
-uptypeOf form ==
-  form isnt [op, arg] => NIL
-  if vector? arg then transferPropsToNode(getUnname arg,arg)
-  if m := isType(arg) then
-    m := conceptualType m
-  else if not (m := getMode arg) then [m] := bottomUp arg
-  t := conceptualType m        -- ??? shall we reveal more impl. details?
-  putValue(op, objNew(m,t))
-  putModeSet(op,[t])
-
---% Handler for where
-
-upwhere t ==
-  -- upwhere does the puts in where into a local environment
-  t isnt [op,tree,clause] => NIL
-  -- since the "clause" might be a local macro, we now call mkAtree
-  -- on the "tree" part (it is not yet a vat)
-  not $genValue =>
-    compFailure [:bright '"  where",
-      '"for compiled code is not yet implemented."]
-  $whereCacheList : local := nil
-  [env,:e] := upwhereClause(clause,$env,$e)
-  tree := upwhereMkAtree(tree,env,e)
-  if x := getAtree(op,'dollar) then
-    atom tree => throwKeyedMsg("S2IS0048",NIL)
-    putAtree(first tree,'dollar,x)
-  upwhereMain(tree,env,e)
-  val := getValue tree
-  putValue(op,val)
-  result := putModeSet(op,getModeSet tree)
-  wcl := [op for op in $whereCacheList]
-  for op in wcl repeat clearDependencies(op,'T)
-  result
-
-upwhereClause(tree,env,e) ==
-  -- uses the variable bindings from env and e and returns an environment
-  -- of its own bindings
-  $env: local := copyHack env
-  $e: local := copyHack e
-  bottomUp tree
-  [$env,:$e]
-
-upwhereMkAtree(tree,$env,$e) == mkAtree tree
-
-upwhereMain(tree,$env,$e) ==
-  -- uses local copies of $env and $e while evaluating tree
-  bottomUp tree
-
-copyHack(env) ==
-  -- makes a copy of an environment with the exception of pairs
-  -- (localModemap . something)
-  c:= CAAR env
-  d:= [fn p for p in c] where fn(p) ==
-    [first p,:[(q is ["localModemap",:.] => q; copy q) for q in rest p]]
-  [[d]]
-
-
---% Case patterns
-
-up%Match t ==
-  sorry '"case pattern"
-
-
---% importing domains
-up%Import t ==
-  t isnt [.,:types] => nil
-  -- ??? shall we error in case types is nil?
-  for x in types repeat
-    $e := addDomain(devaluate objVal getValue x,$e)
-  setValueToVoid t
-
---% Macro handling
-
--- Well, in fact we never handle macros in the interpreter directly.
--- Rather, they are saved in the `macro processing phase' (phMacro)
--- to be used in future macro expansions, and the AST we get at this
--- point already went through the macro expansion massage.  So, all we
--- have to do is to the rubber stamp.
-up%Macro t ==
-  setValueToVoid t
-
-up%MLambda t ==
-  setValueToVoid t
-
-
---% Sorry for unhandled input constructs
-sorry kind ==
-  throwKeyedMsg("S2IP0006",[kind])
-
---% Export
-up%Export t ==
-  sorry '"export declaration"
-
---% Inline
-up%Inline t ==
-  sorry '"inline declaration"
-
---% Category
-up%With t ==
-  sorry '"category definition"
-
---% Domain
-up%Add t ==
-  sorry '"domain definition"
-
--- Creates the function names of the special function handlers and puts
---  them on the property list of the function name
-
-for name in $specialOps repeat
-   functionName:=INTERNL('up,name)
-   property(name,'up) := functionName
-
diff --git a/src/interp/i-spec1.boot b/src/interp/i-special.boot
index ebc27251..6eb04e47 100644
--- a/src/interp/i-spec1.boot
+++ b/src/interp/i-special.boot
@@ -38,7 +38,7 @@ namespace BOOT
 
 -- Functions which require special handlers (also see end of file)
 
-$specialOps := '(
+$specialOps == '(
   ADEF AlgExtension _and _case COERCE COLLECT construct Declare DEF Dollar
    equation error free _has IF _is _isnt iterate _break %LET _local MDEF _or
     pretend QUOTE REDUCE REPEAT _return SEQ TARGET tuple typeOf _where 
@@ -1269,3 +1269,1197 @@ $iteratorVars := nil
 mkIteratorVariable id ==
   $iteratorVars := [id,:$iteratorVars]
   -- mkLocalVar('"the iterator expression",id)
+
+
+++ The `void' value object (an oxymoron).  There really are constants.
+$VoidValueObject := objNew(voidValue(), $Void)
+$VoidCodeObject := objNew('(voidValue), $Void)
+
+setValueToVoid t ==
+  putValue(t,$VoidValueObject)
+  putModeSet(t,[$Void])
+
+setCodeToVoid t ==
+  putValue(t,$VoidCodeObject)
+  putModeSet(t,[$Void])
+
+++ Interpreter macros
+$InterpreterMacroAlist ==
+  '((%i . (complex 0 1))
+    (%e . (exp 1))
+    (%pi . (pi))
+    (SF . (DoubleFloat))
+    (%infinity . (infinity))
+    (%plusInfinity . (plusInfinity))
+    (%minusInfinity . (minusInfinity)))
+
+
+-- Functions which require special handlers (also see end of file)
+
+--% Handlers for map definitions
+
+upDEF t ==
+  -- performs map definitions.  value is thrown away
+  t isnt [op,def,pred,.] => nil
+  v:=addDefMap(["DEF",:def],pred)
+  not(LISTP(def)) or null(def) =>
+    keyedSystemError("S2GE0016",['"upDEF",'"bad map definition"])
+  mapOp := first def
+  if LISTP(mapOp) then
+    null mapOp =>
+      keyedSystemError("S2GE0016",['"upDEF",'"bad map definition"])
+    mapOp := first mapOp
+  put(mapOp,"value",v,$e)
+  setValueToVoid op
+
+--% Handler for package calling and $ constants
+
+++ Return non-nil if `form' designate a constant defined in the
+++ domain designated by `domainForm'.  More specifically, returns:
+++   nil: no such constant 
+++   <%Mode>: the type of the constant.
+++   T: too many constants designated by `form'.
+constantInDomain?(form,domainForm) ==
+    opAlist := getConstructorOperationsFromDB domainForm.op
+    key := opOf form
+    entryList := [entry for (entry := [.,.,.,k]) in LASSOC(key,opAlist) 
+                    | k in '(CONST ASCONST)]
+    entryList is [[sig,.,.,.]] => sig.target
+    #entryList > 2 => true
+    key = "One" => constantInDomain?(["1"], domainForm)
+    key = "Zero" => constantInDomain?(["0"], domainForm)
+    nil
+
+++ Constant `c' of `type' is referenced from domain `d'; return its value
+++ in the VAT `op'.
+findConstantInDomain(op,c,type,d) ==
+  isPartialMode d => throwKeyedMsg("S2IS0020",NIL)
+  val := 
+    $genValue => wrap getConstantFromDomain([c],d)
+    ["getConstantFromDomain",["LIST",MKQ c],MKQ d]
+  type := substitute(d,"$",type)
+  putValue(op,objNew(val,type))
+  putModeSet(op,[type])
+
+upDollar t ==
+  -- Puts "dollar" property in atree node, and calls bottom up
+  t isnt [op,D,form] => nil
+  t2 := t
+  (not $genValue) and "or"/[CONTAINED(var,D) for var in $localVars] =>
+    keyedMsgCompFailure("S2IS0032",NIL)
+  D="Lisp" => upLispCall(op,form)
+  if vector? D and (# D > 0) then D := D.0
+  t := evaluateType unabbrev D
+  categoryForm? t =>
+    throwKeyedMsg("S2IE0012", [t])
+  f := getUnname form
+  if f = $immediateDataSymbol then
+    f := objValUnwrap coerceInteractive(getValue form,$OutputForm)
+    if f = '(construct) then f := "nil"
+  atom form and (f ~= $immediateDataSymbol) =>
+    type := constantInDomain?([f],t) =>
+      type ~= true => findConstantInDomain(op,f,type,t)
+      -- Ambiguous constant.  FIXME: try to narrow before giving up.
+      throwKeyedMsg("S2IB0008h",[f,t])
+    findUniqueOpInDomain(op,f,t)
+
+  nargs := #rest form
+
+  (ms := upDollarTuple(op, f, t, t2, rest form, nargs)) => ms
+
+  f ~= "construct" and null isOpInDomain(f,t,nargs) =>
+    throwKeyedMsg("S2IS0023",[f,t])
+  if (sig := findCommonSigInDomain(f,t,nargs)) then
+    for x in sig for y in form repeat
+      if x then putTarget(y,x)
+  putAtree(first form,"dollar",t)
+  ms := bottomUp form
+  f in '(One Zero) and cons? (ms) and first(ms) = $OutputForm =>
+    throwKeyedMsg("S2IS0021",[f,t])
+  putValue(op,getValue first form)
+  putModeSet(op,ms)
+
+
+upDollarTuple(op, f, t, t2, args, nargs) ==
+  -- this function tries to find a tuple function to use
+  -- nargs = 1 and getUnname first args = "Tuple" => NIL
+  -- nargs = 1 and (ms := bottomUp first args) and ms is [["Tuple",.]] => NIL
+  null (singles := isOpInDomain(f,t,1)) => NIL
+  tuple := NIL
+  for [[.,arg], :.] in singles while null tuple repeat
+    if arg is ['Tuple,.] then tuple := arg
+  null tuple => NIL
+  [.,D,form] := t2
+  newArg := [mkAtreeNode "tuple",:args]
+  putTarget(newArg, tuple)
+  ms := bottomUp newArg
+  first ms ~= tuple => NIL
+  form := [first form, newArg]
+  putAtree(first form,"dollar",t)
+  ms := bottomUp form
+  putValue(op,getValue first form)
+  putModeSet(op,ms)
+
+upLispCall(op,t) ==
+  -- process $Lisp calls
+  if atom t then code:=getUnname t else
+    [lispOp,:argl]:= t
+    null functionp lispOp.0 =>
+      throwKeyedMsg("S2IS0024",[lispOp.0])
+    for arg in argl repeat bottomUp arg
+    code:=[getUnname lispOp,
+      :[getArgValue(arg,computedMode arg) for arg in argl]]
+  rt := '(SExpression)
+  putValue(op,object(code,rt))
+  putModeSet(op,[rt])
+
+--% Handlers for equation
+
+upequation tree ==
+  -- only handle this if there is a target of Boolean
+  -- this should speed things up a bit
+  tree isnt [op,lhs,rhs] => NIL
+  $Boolean ~= getTarget(op) => NIL
+  not vector? op => NIL
+  -- change equation into '='
+  op.0 := "="
+  bottomUp tree
+
+--% Handler for error
+
+uperror t ==
+  -- when compiling a function, this merely inserts another argument
+  -- which is the name of the function.
+  not $compilingMap => NIL
+  t isnt [op,msg] => NIL
+  msgMs := bottomUp putCallInfo(msg,"error",1,1)
+  msgMs isnt [=$String] => NIL
+  t.rest := [mkAtree object2String $mapName,msg]
+  bottomUp t
+
+--% Handlers for free and local
+
+upfree t ==
+  setCodeToVoid t
+
+uplocal t ==
+  setCodeToVoid t
+
+upfreeWithType(var,type) ==
+  sayKeyedMsg("S2IS0055",['"free",var])
+  var
+
+uplocalWithType(var,type) ==
+  sayKeyedMsg("S2IS0055",['"local",var])
+  var
+
+--% Handlers for has
+
+uphas t ==
+  t isnt [op,type,prop] => nil
+  -- handler for category and attribute queries
+  type :=
+    x := elaborateForm type
+    getModeSet x is [m] and (conceptualType m = $Type or categoryForm? m) =>
+      val := objValUnwrap getValue x
+      $genValue => MKQ val
+      ["devaluate",val]
+    throwKeyedMsg("S2IE0021",[type])
+  catCode :=
+    -- FIXME: when we come to support category valued variable
+    --        this code needs to be adapted.
+    prop := unabbrev prop
+    evaluateType0 prop => ["evaluateType", MKQ prop]
+    MKQ prop
+  code := ["NOT",["NULL",["newHasTest",type, catCode]]]
+  putValue(op,object(code,$Boolean))
+  putModeSet(op,[$Boolean])
+
+--hasTest(a,b) ==
+--  newHasTest(a,b)  --see NRUNFAST BOOT
+
+--% Handlers for IF
+
+upIF t ==
+  t isnt [op,cond,a,b] => nil
+  bottomUpPredicate(cond,'"if/when")
+  $genValue => interpIF(op,cond,a,b)
+  compileIF(op,cond,a,b,t)
+
+compileIF(op,cond,a,b,t) ==
+  -- type analyzer for compiled case where types of both branches of
+  --  IF are resolved.
+  ms1 := bottomUp a
+  [m1] := ms1
+  b = "%noBranch" =>
+    evalIF(op,rest t,$Void)
+    putModeSet(op,[$Void])
+  b = "%noMapVal" =>
+    -- if this was a return statement, we take the mode to be that
+    -- of what is being returned.
+    if getUnname a = 'return then
+      ms1 := bottomUp second a
+      [m1] := ms1
+    evalIF(op,rest t,m1)
+    putModeSet(op,ms1)
+  ms2 := bottomUp b
+  [m2] := ms2
+  m:=
+    m2=m1 => m1
+    m2 = $Exit => m1
+    m1 = $Exit => m2
+    if m1 = $Symbol then
+      m1:=getMinimalVarMode(getUnname a,$declaredMode)
+    if m2 = $Symbol then
+      m2:=getMinimalVarMode(getUnname b,$declaredMode)
+    (r := resolveTTAny(m2,m1)) => r
+    rempropI($mapName,'localModemap)
+    rempropI($mapName,'localVars)
+    rempropI($mapName,'mapBody)
+    throwKeyedMsg("S2IS0026",[m2,m1])
+  evalIF(op,rest t,m)
+  putModeSet(op,[m])
+
+evalIF(op,[cond,a,b],m) ==
+  -- generate code form compiled IF
+  elseCode:=
+    b="%noMapVal" =>
+      [[MKQ true, ["throwKeyedMsg",MKQ "S2IM0018",
+        ["CONS",MKQ object2Identifier $mapName,NIL]]]]
+    b='%noBranch =>
+      $lastLineInSEQ => [[MKQ true,["voidValue"]]]
+      NIL
+    [[MKQ true,genIFvalCode(b,m)]]
+  code:=['%when,[getArgValue(cond,$Boolean),
+    genIFvalCode(a,m)],:elseCode]
+  triple:= objNew(code,m)
+  putValue(op,triple)
+
+genIFvalCode(t,m) ==
+  -- passes type information down braches of IF statement
+  --  So that coercions can be performed on data at branches of IF.
+  m1 := computedMode t
+  m1=m => getArgValue(t,m)
+  code:=objVal getValue t
+  IFcodeTran(code,m,m1)
+
+IFcodeTran(code,m,m1) ==
+  -- coerces values at branches of IF
+  null code => code
+  code is ["spadThrowBrightly",:.] => code
+  m1 = $Exit => code
+  code isnt ['%when,[p1,a1],['%otherwise,a2]] =>
+    m = $Void => code
+    code' := coerceInteractive(objNew(quote2Wrapped code,m1),m) =>
+      getValueNormalForm code'
+    throwKeyedMsgCannotCoerceWithValue(quote2Wrapped code,m1,m)
+  a1:=IFcodeTran(a1,m,m1)
+  a2:=IFcodeTran(a2,m,m1)
+  ['%when,[p1,a1],['%otherwise,a2]]
+
+interpIF(op,cond,a,b) ==
+  -- non-compiled version of IF type analyzer.  Doesn't resolve accross
+  --  branches of the IF.
+  val:= getValue cond
+  val:= coerceInteractive(val,$Boolean) =>
+    objValUnwrap(val) => upIFgenValue(op,a)
+    b="%noBranch" => setValueToVoid op
+    upIFgenValue(op,b)
+  throwKeyedMsg("S2IS0031",NIL)
+
+upIFgenValue(op,tree) ==
+  -- evaluates tree and transfers the results to op
+  ms:=bottomUp tree
+  val:= getValue tree
+  putValue(op,val)
+  putModeSet(op,ms)
+
+--% Handlers for is
+
+upis t ==
+  t isnt [op,a,pattern] => nil
+  $opIsIs : local := true
+  upisAndIsnt t
+
+upisnt t ==
+  t isnt [op,a,pattern] => nil
+  $opIsIs : local := nil
+  upisAndIsnt t
+
+upisAndIsnt(t:=[op,a,pattern]) ==
+  -- handler for "is" pattern matching
+  mS:= bottomUp a
+  mS isnt [m] =>
+    keyedSystemError("S2GE0016",['"upisAndIsnt",'"non-unique modeset"])
+  putPvarModes(removeConstruct pattern,m)
+  evalis(op,rest t,m)
+  putModeSet(op,[$Boolean])
+
+putPvarModes(pattern,m) ==
+  -- Puts the modes for the pattern variables into $env
+  m isnt ["List",um] => throwKeyedMsg("S2IS0030",NIL)
+  for pvar in pattern repeat
+    IDENTP pvar => (not (pvar=$quadSymbol)) and put(pvar,'mode,um,$env)
+    pvar is ['_:,var] =>
+      null (var=$quadSymbol) and put(var,"mode",m,$env)
+    pvar is ['_=,var] =>
+      null (var=$quadSymbol) and put(var,"mode",um,$env)
+    putPvarModes(pvar,um)
+
+evalis(op,[a,pattern],mode) ==
+  -- actually handles is and isnt
+  if $opIsIs
+    then fun := 'evalIsPredicate
+    else fun := 'evalIsntPredicate
+  if isLocalPred pattern then
+    code:= compileIs(a,pattern)
+  else code:=[fun,getArgValue(a,mode),
+    MKQ pattern,MKQ mode]
+  triple := object(code,$Boolean)
+  putValue(op,triple)
+
+isLocalPred pattern ==
+  -- returns true if this predicate is to be compiled
+  for pat in pattern repeat
+    IDENTP pat and isLocallyBound pat => return true
+    pat is [":",var] and isLocallyBound var => return true
+    pat is ["=",var] and isLocallyBound var => return true
+
+compileIs(val,pattern) ==
+  -- produce code for compiled "is" predicate.  makes pattern variables
+  --  into local variables of the function
+  vars:= NIL
+  for pat in rest pattern repeat
+    IDENTP(pat) and isLocallyBound pat => vars:=[pat,:vars]
+    pat is [":",var] => vars:= [var,:vars]
+    pat is ["=",var] => vars:= [var,:vars]
+  predCode:=["%LET",g:=gensym(),["isPatternMatch",
+    getArgValue(val,computedMode val),MKQ removeConstruct pattern]]
+  for var in removeDuplicates vars repeat
+    assignCode:=[["%LET",var,["CDR",["ASSQ",MKQ var,g]]],:assignCode]
+  null $opIsIs =>
+    ['%when,[["EQ",predCode,MKQ "failed"],["SEQ",:assignCode,'%true]]]
+  ['%when,[['%not,["EQ",predCode,MKQ "failed"]],["SEQ",:assignCode,'%true]]]
+
+evalIsPredicate(value,pattern,mode) ==
+  --This function pattern matches value to pattern, and returns
+  --true if it matches, and false otherwise.  As a side effect
+  --if the pattern matches then the bindings given in the pattern
+  --are made
+  pattern:= removeConstruct pattern
+  not ((valueAlist:=isPatternMatch(value,pattern))='failed) =>
+    for [id,:value] in valueAlist repeat
+      evalLETchangeValue(id,objNewWrap(value,get(id,'mode,$env)))
+    true
+  false
+
+evalIsntPredicate(value,pattern,mode) ==
+  evalIsPredicate(value,pattern,mode) => false
+  true
+
+removeConstruct pat ==
+  -- removes the "construct" from the beginning of patterns
+  if pat is ["construct",:p] then pat:=p
+  if pat is ["cons", a, b] then pat := [a, [":", b]]
+  atom pat => pat
+  pat.first := removeConstruct first pat
+  pat.rest := removeConstruct rest pat
+  pat
+
+isPatternMatch(l,pats) ==
+  -- perform the actual pattern match
+  $subs: local := NIL
+  isPatMatch(l,pats)
+  $subs
+
+isPatMatch(l,pats) ==
+  null pats =>
+    null l => $subs
+    $subs:='failed
+  null l =>
+    null pats => $subs
+    pats is [[":",var]] =>
+      $subs := [[var],:$subs]
+    $subs:='failed
+  pats is [pat,:restPats] =>
+    IDENTP pat =>
+      $subs:=[[pat,:first l],:$subs]
+      isPatMatch(rest l,restPats)
+    pat is ["=",var] =>
+      p:=ASSQ(var,$subs) =>
+        first l = rest p => isPatMatch(rest l, restPats)
+        $subs:="failed"
+      $subs:="failed"
+    pat is [":",var] =>
+      n:=#restPats
+      m:=#l-n
+      m<0 => $subs:="failed"
+      ZEROP n => $subs:=[[var,:l],:$subs]
+      $subs:=[[var,:[x for x in l for i in 1..m]],:$subs]
+      isPatMatch(DROP(m,l),restPats)
+    isPatMatch(first l,pat) = "failed" => "failed"
+    isPatMatch(rest l,restPats)
+  keyedSystemError("S2GE0016",['"isPatMatch",
+     '"unknown form of is predicate"])
+
+--% Handler for iterate
+
+upiterate t ==
+  null $repeatBodyLabel => throwKeyedMsg("S2IS0029",['"iterate"])
+  $iterateCount := $iterateCount + 1
+  code := ["THROW",$repeatBodyLabel,'(voidValue)]
+  $genValue => THROW(eval $repeatBodyLabel,voidValue())
+  putValue(t,objNew(code,$Void))
+  putModeSet(t,[$Void])
+
+--% Handler for break
+
+upbreak t ==
+  t isnt [op,.] => nil
+  null $repeatLabel => throwKeyedMsg("S2IS0029",['"break"])
+  $breakCount := $breakCount + 1
+  code := ["THROW",$repeatLabel,'(voidValue)]
+  $genValue => THROW(eval $repeatLabel,voidValue())
+  putValue(op,objNew(code,$Void))
+  putModeSet(op,[$Void])
+
+--% Handlers for %LET
+
+up%LET t ==
+  -- analyzes and evaluates the righthand side, and does the variable
+  -- binding
+  t isnt [op,lhs,rhs] => nil
+  $declaredMode: local := NIL
+  cons? lhs =>
+    var:= getUnname first lhs
+    var = "construct" => upLETWithPatternOnLhs t
+    var = "QUOTE" => throwKeyedMsg("S2IS0027",['"A quoted form"])
+    upLETWithFormOnLhs(op,lhs,rhs)
+  var:= getUnname lhs
+  var = $immediateDataSymbol =>
+    -- following will be immediate data, so probably ok to not
+    -- specially format it
+    obj := objValUnwrap coerceInteractive(getValue lhs,$OutputForm)
+    throwKeyedMsg("S2IS0027",[obj])
+  var in '(% %%) =>               -- for history
+    throwKeyedMsg("S2IS0027",[var])
+  (IDENTP var) and not (var in '(true false elt QUOTE)) =>
+    var ~= (var' := unabbrev(var)) =>  -- constructor abbreviation
+      throwKeyedMsg("S2IS0028",[var,var'])
+    if get(var,'isInterpreterFunction,$e) then
+      putHist(var,'isInterpreterFunction,false,$e)
+      sayKeyedMsg("S2IS0049",['"Function",var])
+    else if get(var,'isInterpreterRule,$e) then
+      putHist(var,'isInterpreterRule,false,$e)
+      sayKeyedMsg("S2IS0049",['"Rule",var])
+    (m := isType rhs) => upLETtype(op,lhs,m)
+    transferPropsToNode(var,lhs)
+    if ( m:= getMode(lhs) ) then
+      $declaredMode := m
+      putTarget(rhs,m)
+    if (val := getValue lhs) and (objMode val = $Boolean) and
+      getUnname(rhs) = 'equation then putTarget(rhs,$Boolean)
+    (rhsMs:= bottomUp rhs) = [$Void] =>
+      throwKeyedMsg("S2IS0034",[var])
+    val:=evalLET(lhs,rhs)
+    putValue(op,val)
+    putModeSet(op,[objMode(val)])
+  throwKeyedMsg("S2IS0027",[var])
+
+evalLET(lhs,rhs) ==
+  -- lhs is a vector for a variable, and rhs is the evaluated atree
+  --  for the value which is coerced to the mode of lhs
+  $useConvertForCoercions: local := true
+  v' := (v:= getValue rhs)
+  ((not getMode lhs) and (getModeSet rhs is [.])) or
+    get(getUnname lhs,'autoDeclare,$env) =>
+      v:=
+        $genValue => v
+        objNew(getValueNormalForm v,objMode v)
+      evalLETput(lhs,v)
+  t1:= objMode v
+  t2' := (t2 := getMode lhs)
+  value:=
+    t1 = t2 =>
+      $genValue => v
+      objNew(getValueNormalForm v,objMode v)
+    if isPartialMode t2 then
+      if t1 = $Symbol and $declaredMode then
+        t1:= getMinimalVarMode(objValUnwrap v,$declaredMode)
+      t' := t2
+      null (t2 := resolveTM(t1,t2)) =>
+        if not t2 then t2 := t'
+        throwKeyedMsg("S2IS0035",[t1,t2])
+    null (v := getArgValue(rhs,t2)) =>
+      isWrapped(objVal v') and (v2:=coerceInteractive(v',$OutputForm)) =>
+        throwKeyedMsg("S2IS0036",[objValUnwrap v2,t2])
+      throwKeyedMsg("S2IS0037",[t2])
+    t2 and object(v,t2)
+  value => evalLETput(lhs,value)
+  throwKeyedMsgCannotCoerceWithValue(objVal v,t1,getMode lhs)
+
+evalLETput(lhs,value) ==
+  -- put value into the cell for lhs
+  name:= getUnname lhs
+  if not $genValue then
+    code:=
+      isLocallyBound name =>
+        om := objMode(value)
+        dm := get(name,'mode,$env)
+        dm and not ((om = dm) or isSubDomain(om,dm) or
+          isSubDomain(dm,om)) =>
+            compFailure ['"   The type of the local variable",
+              :bright name,'"has changed in the computation."]
+        if dm and isSubDomain(dm,om) then put(name,'mode,om,$env)
+        ["%LET",name,objVal value,$mapName]
+               -- $mapName is set in analyzeMap
+      om := objMode value
+      dm := get(name, 'mode, $env) or objMode(get(name, 'value, $e))
+      dm and (null $compilingMap) and not(om = dm) and not(isSubDomain(om, dm)) =>
+        THROW('loopCompiler,'tryInterpOnly)
+      ['unwrap,['evalLETchangeValue,MKQ name,
+        objNewCode(['wrap,objVal value],objMode value)]]
+    value:= objNew(code,objMode value)
+    isLocallyBound name =>
+      if not get(name,'mode,$env) then put(name,'autoDeclare,'T,$env)
+      put(name,'mode,objMode(value),$env)
+    put(name,'automode,objMode(value),$env)
+  $genValue and evalLETchangeValue(name,value)
+  putValue(lhs,value)
+
+upLETWithPatternOnLhs(t := [op,pattern,a]) ==
+  $opIsIs : local := true
+  [m] := bottomUp a
+  putPvarModes(pattern,m)
+  object := evalis(op,[a,pattern],m)
+  -- have to change code to return value of a
+  failCode :=
+    ['spadThrowBrightly,['concat,
+      '"   Pattern",['QUOTE,bright form2String pattern],
+        '"is not matched in assignment to right-hand side."]]
+  if $genValue
+    then
+      null objValUnwrap object => eval failCode
+      putValue(op,getValue a)
+    else
+      code := ['%when,[objVal object,objVal getValue a],['%otherwise,failCode]]
+      putValue(op,objNew(code,m))
+  putModeSet(op,[m])
+
+evalLETchangeValue(name,value) ==
+  -- write the value of name into the environment, clearing dependent
+  --  maps if its type changes from its last value
+  localEnv := cons? $env
+  clearCompilationsFlag :=
+    val:= (localEnv and get(name,'value,$env)) or get(name,'value,$e)
+    null val =>
+      not ((localEnv and get(name,'mode,$env)) or get(name,'mode,$e))
+    objMode val ~= objMode(value)
+  if clearCompilationsFlag then
+    clearDependencies(name,true)
+  if localEnv and isLocallyBound name
+    then $env:= putHist(name,'value,value,$env)
+    else putIntSymTab(name,'value,value,$e)
+  objVal value
+
+upLETWithFormOnLhs(op,lhs,rhs) ==
+  -- bottomUp for assignment to forms (setelt, table or tuple)
+  lhs' := getUnnameIfCan lhs
+  rhs' := getUnnameIfCan rhs
+  lhs' = "tuple" =>
+    rhs' ~= "tuple" => throwKeyedMsg("S2IS0039",NIL)
+    #(lhs) ~= #(rhs) => throwKeyedMsg("S2IS0038",NIL)
+    -- generate a sequence of assignments, using local variables
+    -- to first hold the assignments so that things like
+    -- (t1,t2) := (t2,t1) will work.
+    seq := []
+    temps := [gensym() for l in rest lhs]
+    for lvar in temps repeat mkLocalVar($mapName,lvar)
+    for l in reverse rest lhs for t in temps repeat
+      transferPropsToNode(getUnname l,l)
+      let := mkAtreeNode "%LET"
+      t'  := mkAtreeNode t
+      if m := getMode(l) then putMode(t',m)
+      seq := [[let,l,t'],:seq]
+    for t in temps for r in reverse rest rhs
+      for l in reverse rest lhs repeat
+        let := mkAtreeNode "%LET"
+        t'  := mkAtreeNode t
+        if m := getMode(l) then putMode(t',m)
+        seq := [[let,t',r],:seq]
+    seq := [mkAtreeNode 'SEQ,:seq]
+    ms := bottomUp seq
+    putValue(op,getValue seq)
+    putModeSet(op,ms)
+  rhs' = "tuple" => throwKeyedMsg("S2IS0039",NIL)
+  tree:= seteltable(lhs,rhs) => upSetelt(op,lhs,tree)
+  throwKeyedMsg("S2IS0060", NIL)
+--  upTableSetelt(op,lhs,rhs)
+
+seteltable(lhs is [f,:argl],rhs) ==
+  -- produces the setelt form for trees such as "l.2:= 3"
+  null (g := getUnnameIfCan f) => NIL
+  g="elt" => altSeteltable [:argl, rhs]
+  get(g,'value,$e) is [expr,:.] and isMapExpr expr => NIL
+  transferPropsToNode(g,f)
+  getValue(lhs) or getMode(lhs) =>
+    f is [f',:argl'] => altSeteltable [f',:argl',:argl,rhs]
+    altSeteltable [:lhs,rhs]
+  NIL
+
+altSeteltable args ==
+    for x in args repeat bottomUp x
+    newOps := [mkAtreeNode "setelt", mkAtreeNode "set!"]
+    form := NIL
+
+    -- first look for exact matches for any of the possibilities
+    while null form for newOp in newOps  repeat
+        if selectMms(newOp, args, NIL) then form := [newOp, :args]
+
+    -- now try retracting arguments after the first
+    while null form and ( "and"/[retractAtree(a) for a in rest args] ) repeat
+        while null form for newOp in newOps  repeat
+            if selectMms(newOp, args, NIL) then form := [newOp, :args]
+
+    form
+
+
+upSetelt(op,lhs,tree) ==
+  -- type analyzes implicit setelt forms
+  var:=opOf lhs
+  transferPropsToNode(getUnname var,var)
+  if (m1:=getMode var) then $declaredMode:= m1
+  if m1 or ((v1 := getValue var) and (m1 := objMode v1)) then
+    putModeSet(var,[m1])
+  ms := bottomUp tree
+  putValue(op,getValue tree)
+  putModeSet(op,ms)
+
+upTableSetelt(op,lhs is [htOp,:args],rhs) ==
+  -- called only for undeclared, uninitialized table setelts
+  ("*" = (PNAME getUnname htOp).0) and (1 ~= # args) =>
+    throwKeyedMsg("S2IS0040",NIL)
+  # args ~= 1 =>
+    throwKeyedMsg("S2IS0041",[[getUnname htOp,'".[",
+      getUnname first args,
+        ['",",getUnname arg for arg in rest args],'"]"]])
+  keyMode := $Any
+  putMode (htOp,['Table,keyMode,$Any])
+  -- if we are to use a new table, we must call the "table"
+  -- function to give it an initial value.
+  bottomUp [mkAtreeNode "%LET",htOp,[mkAtreeNode 'table]]
+  tableCode := objVal getValue htOp
+  r := upSetelt(op, lhs, [mkAtreeNode "setelt",:lhs,rhs])
+  $genValue => r
+  -- construct code
+  t := getValue op
+  putValue(op,objNew(['PROGN,tableCode,objVal t],objMode t))
+  r
+
+unVectorize body ==
+  -- transforms from an atree back into a tree
+  vector? body =>
+    name := getUnname body
+    name ~= $immediateDataSymbol => name
+    objValUnwrap getValue body
+  atom body => body
+  body is [op,:argl] =>
+    newOp:=unVectorize op
+    if newOp = 'SUCHTHAT then newOp := "|"
+    if newOp = 'COERCE then newOp := "::"
+    if newOp = 'Dollar then newOp := "$elt"
+    [newOp,:unVectorize argl]
+  systemErrorHere ["unVectorize",body]
+
+isType t ==
+  -- Returns the evaluated type if t is a tree representing a type,
+  -- and NIL otherwise
+   op:=opOf t
+   vector? op =>
+     isMap(op:= getUnname op) => NIL
+     op = 'Mapping and cons? t =>
+       argTypes := [isType type for type in rest t]
+       "or"/[null type for type in argTypes] => nil
+       ['Mapping, :argTypes]
+     isLocallyBound op => NIL
+     d := isDomainValuedVariable op => d
+     type:=
+       -- next line handles subscripted vars
+         (abbreviation?(op) or (op = 'typeOf) or
+           constructor?(op) or (op in '(Record Union Enumeration))) and
+             unabbrev unVectorize t
+     type and evaluateType type
+   d := isDomainValuedVariable op => d
+   NIL
+
+upLETtype(op,lhs,type) ==
+  -- performs type assignment
+  opName:= getUnname lhs
+  (not $genValue) and "or"/[CONTAINED(var,type) for var in $localVars] =>
+    compFailure ['"   Cannot compile type assignment to",:bright opName]
+  mode := conceptualType type
+  val:= objNew(type,mode)
+  if isLocallyBound opName then put(opName,'value,val,$env)
+  else putHist(opName,'value,val,$e)
+  putValue(op,val)
+  -- have to fix the following
+  putModeSet(op,[mode])
+
+assignSymbol(symbol, value, domain) ==
+-- Special function for binding an interpreter variable from within algebra
+-- code.  Does not do the assignment and returns nil, if the variable is
+-- already assigned
+  val := get(symbol, 'value, $e) => nil
+  obj := objNew(wrap value, devaluate domain)
+  put(symbol, 'value, obj, $e)
+  true
+
+--% Handler for Interpreter Macros
+
+getInterpMacroNames() ==
+  names := [n for [n,:.] in $InterpreterMacroAlist]
+  if (e := CAAR $InteractiveFrame) and (m := assoc("--macros--",e)) then
+    names := append(names,[n for [n,:.] in rest m])
+  MSORT names
+
+isInterpMacro name ==
+  -- look in local and then global environment for a macro
+  not IDENTP name => NIL
+  name in $specialOps => NIL
+  (m := get("--macros--",name,$env)) => m
+  (m := get("--macros--",name,$e))   => m
+  (m := get("--macros--",name,$InteractiveFrame))   => m
+  -- $InterpreterMacroAlist will probably be phased out soon
+  (sv := assoc(name,$InterpreterMacroAlist)) => [NIL,:rest sv]
+  NIL
+
+--% Handlers for prefix QUOTE
+
+upQUOTE t ==
+  t isnt [op,expr] => NIL
+  ms:= list
+    m:= getBasicMode expr => m
+    IDENTP expr =>
+--    $useSymbolNotVariable => $Symbol
+      getTarget t = $Identifier => $Identifier
+      ['Variable,expr]
+    $InputForm
+  evalQUOTE(op,[expr],ms)
+  putModeSet(op,ms)
+
+evalQUOTE(op,[expr],[m]) ==
+  triple:=
+    $genValue => objNewWrap(expr,m)
+    objNew(['QUOTE,expr],m)
+  putValue(op,triple)
+
+--% Quasiquotation
+up_[_|_|_] t ==
+  t isnt [op, x] => nil
+  mode := getTypeOfSyntax x
+  putValue(op, objNewWrap(x, mode))
+  putModeSet(op, [mode])
+
+--% Handler for pretend
+
+uppretend t ==
+  t isnt [op,expr,type] => NIL
+  mode := evaluateType unabbrev type
+  not isValidType(mode) => throwKeyedMsg("S2IE0004",[mode])
+  bottomUp expr
+  putValue(op,objNew(objVal getValue expr,mode))
+  putModeSet(op,[mode])
+
+--% Handlers for REDUCE
+
+getReduceFunction(op,type,result, locale) ==
+  -- return the function cell for operation with the signature
+  --  (type,type) -> type, possible from locale
+  if type is ['Variable,var] then
+    args := [arg := mkAtreeNode var,arg]
+    putValue(arg,objNewWrap(var,type))
+  else
+    args := [arg := mkAtreeNode "%1",arg]
+    if type=$Symbol then putValue(arg,objNewWrap("%1",$Symbol))
+  putModeSet(arg,[type])
+  vecOp:=mkAtreeNode op
+  transferPropsToNode(op,vecOp)
+  if locale then putAtree(vecOp,'dollar,locale)
+  mmS:= selectMms(vecOp,args,result)
+  mm:= or/[mm for (mm:=[[.,:sig],fun,cond]) in mmS |
+    (isHomogeneousArgs sig) and "and"/[null c for c in cond]]
+  null mm => 'failed
+  [[dc,:sig],fun,:.]:=mm
+  dc='local => [MKQ [fun,:'local],:first sig]
+  dcVector := evalDomain dc
+  $compilingMap =>
+    k := NRTgetMinivectorIndex(
+      NRTcompiledLookup(op,sig,dcVector),op,sig,dcVector)
+    ['ELT,"$$$",k]  --$$$ denotes minivector
+  env:=
+    NRTcompiledLookup(op,sig,dcVector)
+  MKQ env
+
+isHomogeneous sig ==
+  --return true if sig describes a homogeneous binary operation
+  sig.0=sig.1 and sig.1=sig.2
+
+isHomogeneousArgs sig ==
+  --return true if sig describes a homogeneous binary operation
+  sig.1=sig.2
+
+--% Handlers for REPEAT
+
+transformREPEAT [:itrl,body] ==
+  -- syntactic transformation of repeat iterators, called from mkAtree2
+  iterList:=[:iterTran1 for it in itrl] where iterTran1() ==
+    it is ["STEP",index,lower,step,:upperList] =>
+      [["STEP",index,mkAtree1 lower,mkAtree1 step,:[mkAtree1 upper
+        for upper in upperList]]]
+    it is ["IN",index,s] =>
+      [['IN,index,mkAtree1 s]]
+    it is ["ON",index,s] =>
+      [['IN,index,mkAtree1 ['tails,s]]]
+    it is ["WHILE",b] =>
+      [["WHILE",mkAtree1 b]]
+    it is ["|",pred] =>
+      [["SUCHTHAT",mkAtree1 pred]]
+    it is [op,:.] and (op in '(VALUE UNTIL)) => nil
+  bodyTree:=mkAtree1 body
+  iterList:=NCONC(iterList,[:iterTran2 for it in itrl]) where iterTran2() ==
+    it is ["STEP",:.] => nil
+    it is ["IN",:.] => nil
+    it is ["ON",:.] => nil
+    it is ["WHILE",:.] => nil
+    it is [op,b] and (op in '(UNTIL VALUE)) =>
+      [[op,mkAtree1 b]]
+    it is ['_|,pred] => nil
+    keyedSystemError("S2GE0016",
+      ['"transformREPEAT",'"Unknown type of iterator"])
+  [:iterList,bodyTree]
+
+upREPEAT t ==
+  -- REPEATS always return void() of Void
+  -- assures throw to interpret-code mode goes to outermost loop
+  $repeatLabel : local := MKQ gensym()
+  $breakCount  : local := 0
+  $repeatBodyLabel : local := MKQ gensym()
+  $iterateCount    : local := 0
+  $compilingLoop => upREPEAT1 t
+  upREPEAT0 t
+
+upREPEAT0 t ==
+  -- sets up catch point for interp-only mode
+  $compilingLoop: local := true
+  ms := CATCH('loopCompiler,upREPEAT1 t)
+  ms = 'tryInterpOnly => interpOnlyREPEAT t
+  ms
+
+upREPEAT1 t ==
+  -- repeat loop handler with compiled body
+  -- see if it has the expected form
+  t isnt [op,:itrl,body] => NIL
+  -- determine the mode of the repeat loop. At the moment, if there
+  -- there are no iterators and there are no "break" statements, then
+  -- the return type is Exit, otherwise Void.
+  repeatMode :=
+    null(itrl) and ($breakCount=0) => $Void
+    $Void
+
+  -- if interpreting, go do that
+  $interpOnly => interpREPEAT(op,itrl,body,repeatMode)
+
+  -- analyze iterators and loop body
+  $iteratorVars: local := nil
+  upLoopIters itrl
+  bottomUpCompile body
+
+  -- now that the body is analyzed, we should know everything that
+  -- is in the UNTIL clause
+  for itr in itrl repeat
+    itr is ["UNTIL", pred] => bottomUpCompilePredicate(pred,'"until")
+
+  -- now go do it
+  evalREPEAT(op,rest t,repeatMode)
+  putModeSet(op,[repeatMode])
+
+evalREPEAT(op,[:itrl,body],repeatMode) ==
+  -- generate code for loop
+  bodyMode := computedMode body
+  bodyCode := getArgValue(body,bodyMode)
+  if $iterateCount > 0 then
+    bodyCode := ["CATCH",$repeatBodyLabel,bodyCode]
+  code := ['%loop,:[evalLoopIter itr for itr in itrl],bodyCode,voidValue()]
+  code := timedOptimization code
+  if $breakCount > 0 then code := ['CATCH,$repeatLabel,code]
+  val :=
+    $genValue =>
+      timedEVALFUN code
+      objNewWrap(voidValue(),repeatMode)
+    objNew(code,repeatMode)
+  putValue(op,val)
+
+interpOnlyREPEAT t ==
+  -- interpret-code mode call to upREPEAT
+  $genValue: local := true
+  $interpOnly: local := true
+  upREPEAT1 t
+
+interpREPEAT(op,itrl,body,repeatMode) ==
+  -- performs interpret-code repeat
+  $indexVars: local := NIL
+  $indexTypes: local := NIL
+  code :=
+      -- we must insert a CATCH for the iterate clause
+      ['%loop,:[interpIter itr for itr in itrl],
+        ["CATCH",$repeatBodyLabel,interpLoop(body,$indexVars,
+          $indexTypes,nil)],voidValue()]
+  SPADCATCH(eval $repeatLabel,timedEVALFUN code)
+  val:= objNewWrap(voidValue(),repeatMode)
+  putValue(op,val)
+  putModeSet(op,[repeatMode])
+
+interpLoop(expr,indexList,indexTypes,requiredType) ==
+  -- generates code for interp-only repeat body
+  ['interpLoopIter,MKQ expr,MKQ indexList,["LIST",:indexList],
+    MKQ indexTypes, MKQ requiredType]
+
+interpLoopIter(exp,indexList,indexVals,indexTypes,requiredType) ==
+  -- call interpreter on exp with loop vars in indexList with given
+  --  values and types, requiredType is used from interpCOLLECT
+  --  to indicate the required type of the result
+  emptyAtree exp
+  for i in indexList for val in indexVals for type in indexTypes repeat
+    put(i,'value,objNewWrap(val,type),$env)
+  bottomUp exp
+  v:= getValue exp
+  val :=
+    null requiredType => v
+    coerceInteractive(v,requiredType)
+  null val =>
+    throwKeyedMsgCannotCoerceWithValue(objVal v,objMode v,requiredType)
+  objValUnwrap val
+
+--% Handler for return
+
+upreturn t ==
+  -- make sure we are in a user function
+  t isnt [op,val] => NIL
+  (null $compilingMap) and (null $interpOnly) =>
+    throwKeyedMsg("S2IS0047",NIL)
+  if $mapTarget then putTarget(val,$mapTarget)
+  bottomUp val
+  if $mapTarget
+    then
+      val' := getArgValue(val, $mapTarget)
+      m := $mapTarget
+    else
+      val' := getValueNormalForm getValue val
+      m := computedMode val
+  cn := mapCatchName $mapName
+  $mapReturnTypes := insert(m, $mapReturnTypes)
+  $mapThrowCount := $mapThrowCount + 1
+  -- if $genValue then we are interpreting the map
+  $genValue => THROW(cn,objNewWrap(removeQuote val',m))
+  putValue(op,objNew(['THROW,MKQ cn,val'],m))
+  putModeSet(op,[$Exit])
+
+--% Handler for SEQ
+
+upSEQ u ==
+  -- assumes that exits were translated into if-then-elses
+  -- handles flat SEQs and embedded returns
+  u isnt [op,:args] => NIL
+  if (target := getTarget(op)) then putTarget(last args, target)
+  for x in args repeat bottomUp x
+  null (m := computedMode last args) =>
+    keyedSystemError("S2GE0016",['"upSEQ",
+      '"last line of SEQ has no mode"])
+  evalSEQ(op,args,m)
+  putModeSet(op,[m])
+
+evalSEQ(op,args,m) ==
+  -- generate code for SEQ
+  [:argl,last] := args
+  val:=
+    $genValue => getValue last
+    bodyCode := nil
+    for x in args repeat
+      (m1 := computedMode x) and (m1 ~= '$ThrowAwayMode) =>
+        (av := getArgValue(x,m1)) ~= voidValue() =>
+          bodyCode := [av,:bodyCode]
+    code:=
+      bodyCode is [c] => c
+      ['PROGN,:reverse bodyCode]
+    objNew(code,m)
+  putValue(op,val)
+
+--% Handlers for tuple
+
+uptuple t ==
+  --Computes the common mode set of the construct by resolving across
+  --the argument list, and evaluating
+  t isnt [op,:l] => nil
+  dol := getAtree(op,'dollar)
+  tar := getTarget(op) or dol
+  null l => upNullTuple(op,l,tar)
+  isTaggedUnion tar => upTaggedUnionConstruct(op,l,tar)
+  aggs := '(List)
+  if tar and cons?(tar) and not isPartialMode(tar) then
+    first(tar) in aggs =>
+      ud := second tar
+      for x in l repeat if not getTarget(x) then putTarget(x,ud)
+    first(tar) in '(Matrix SquareMatrix RectangularMatrix) =>
+      vec := ['List,underDomainOf tar]
+      for x in l repeat if not getTarget(x) then putTarget(x,vec)
+  argModeSetList:= [bottomUp x for x in l]
+  eltTypes := replaceSymbols([first x for x in argModeSetList],l)
+  if not isPartialMode(tar) and tar is ['Tuple,ud] then
+    mode := ['Tuple, resolveTypeListAny [ud,:eltTypes]]
+  else mode := ['Tuple, resolveTypeListAny eltTypes]
+  if isPartialMode tar then tar:=resolveTM(mode,tar)
+  evalTuple(op,l,mode,tar)
+
+evalTuple(op,l,m,tar) ==
+  [agg,:.,underMode]:= m
+  code := asTupleNewCode(underMode, #l,
+    [(getArgValue(x,underMode) or throwKeyedMsg("S2IC0007",[underMode])) for x in l])
+  val := object(code,m)
+  if tar then val1 := coerceInteractive(val,tar) else val1 := val
+
+  val1 =>
+    putValue(op,val1)
+    putModeSet(op,[tar or m])
+  putValue(op,val)
+  putModeSet(op,[m])
+
+upNullTuple(op,l,tar) ==
+  -- handler for the empty tuple
+  defMode :=
+    tar and tar is [a,b] and (a in '(Stream Vector List)) and
+      not isPartialMode(b) => ['Tuple,b]
+    '(Tuple (None))
+  val := objNewWrap(asTupleNew(getVMType second defMode,0,NIL), defMode)
+  tar and not isPartialMode(tar) =>
+    null (val' := coerceInteractive(val,tar)) =>
+      throwKeyedMsg("S2IS0013",[tar])
+    putValue(op,val')
+    putModeSet(op,[tar])
+  putValue(op,val)
+  putModeSet(op,[defMode])
+
+--% Handler for typeOf
+
+uptypeOf form ==
+  form isnt [op, arg] => NIL
+  if vector? arg then transferPropsToNode(getUnname arg,arg)
+  if m := isType(arg) then
+    m := conceptualType m
+  else if not (m := getMode arg) then [m] := bottomUp arg
+  t := conceptualType m        -- ??? shall we reveal more impl. details?
+  putValue(op, objNew(m,t))
+  putModeSet(op,[t])
+
+--% Handler for where
+
+upwhere t ==
+  -- upwhere does the puts in where into a local environment
+  t isnt [op,tree,clause] => NIL
+  -- since the "clause" might be a local macro, we now call mkAtree
+  -- on the "tree" part (it is not yet a vat)
+  not $genValue =>
+    compFailure [:bright '"  where",
+      '"for compiled code is not yet implemented."]
+  $whereCacheList : local := nil
+  [env,:e] := upwhereClause(clause,$env,$e)
+  tree := upwhereMkAtree(tree,env,e)
+  if x := getAtree(op,'dollar) then
+    atom tree => throwKeyedMsg("S2IS0048",NIL)
+    putAtree(first tree,'dollar,x)
+  upwhereMain(tree,env,e)
+  val := getValue tree
+  putValue(op,val)
+  result := putModeSet(op,getModeSet tree)
+  wcl := [op for op in $whereCacheList]
+  for op in wcl repeat clearDependencies(op,'T)
+  result
+
+upwhereClause(tree,env,e) ==
+  -- uses the variable bindings from env and e and returns an environment
+  -- of its own bindings
+  $env: local := copyHack env
+  $e: local := copyHack e
+  bottomUp tree
+  [$env,:$e]
+
+upwhereMkAtree(tree,$env,$e) == mkAtree tree
+
+upwhereMain(tree,$env,$e) ==
+  -- uses local copies of $env and $e while evaluating tree
+  bottomUp tree
+
+copyHack(env) ==
+  -- makes a copy of an environment with the exception of pairs
+  -- (localModemap . something)
+  c:= CAAR env
+  d:= [fn p for p in c] where fn(p) ==
+    [first p,:[(q is ["localModemap",:.] => q; copy q) for q in rest p]]
+  [[d]]
+
+
+--% Case patterns
+
+up%Match t ==
+  sorry '"case pattern"
+
+
+--% importing domains
+up%Import t ==
+  t isnt [.,:types] => nil
+  -- ??? shall we error in case types is nil?
+  for x in types repeat
+    $e := addDomain(devaluate objVal getValue x,$e)
+  setValueToVoid t
+
+--% Macro handling
+
+-- Well, in fact we never handle macros in the interpreter directly.
+-- Rather, they are saved in the `macro processing phase' (phMacro)
+-- to be used in future macro expansions, and the AST we get at this
+-- point already went through the macro expansion massage.  So, all we
+-- have to do is to the rubber stamp.
+up%Macro t ==
+  setValueToVoid t
+
+up%MLambda t ==
+  setValueToVoid t
+
+
+--% Sorry for unhandled input constructs
+sorry kind ==
+  throwKeyedMsg("S2IP0006",[kind])
+
+--% Export
+up%Export t ==
+  sorry '"export declaration"
+
+--% Inline
+up%Inline t ==
+  sorry '"inline declaration"
+
+--% Category
+up%With t ==
+  sorry '"category definition"
+
+--% Domain
+up%Add t ==
+  sorry '"domain definition"
+
+-- Creates the function names of the special function handlers and puts
+--  them on the property list of the function name
+
+for name in $specialOps repeat
+   functionName:=INTERNL('up,name)
+   property(name,'up) := functionName
+
+