Revert commits to the wrong tree.

1 files changed, 1185 insertions, 0 deletions

diff --git a/src/interp/i-map.boot.pamphlet b/src/interp/i-map.boot.pamphlet
new file mode 100644
index 00000000..b66f02b9
--- /dev/null
+++ b/src/interp/i-map.boot.pamphlet
@@ -0,0 +1,1185 @@
+\documentclass{article}
+\usepackage{axiom}
+
+\title{\File{src/interp/i-map.boot} Pamphlet}
+\author{The Axiom Team}
+
+\begin{document}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+
+\section{License}
+
+<<license>>=
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- 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.
+
+@
+<<*>>=
+<<license>>
+
+--% User Function Creation and Analysis Code
+
+SETANDFILEQ($mapTarget,nil)
+SETANDFILEQ($mapReturnTypes,nil)
+SETANDFILEQ($mapName,'noMapName)
+SETANDFILEQ($mapThrowCount, 0) -- times a "return" occurs in map
+SETANDFILEQ($compilingMap, NIL)
+SETANDFILEQ($definingMap, NIL)
+
+--% Generating internal names for functions
+
+SETANDFILEQ($specialMapNameSuffix, NIL)
+
+makeInternalMapName(userName,numArgs,numMms,extraPart) ==
+  name := CONCAT('"*",STRINGIMAGE numArgs,'";",
+    object2String userName,'";",STRINGIMAGE numMms,'";",
+      object2String frameName first $interpreterFrameRing )
+  if extraPart then name := CONCAT(name,'";",extraPart)
+  if $specialMapNameSuffix then
+    name := CONCAT(name,'";",$specialMapNameSuffix)
+  INTERN name
+
+isInternalMapName name ==
+  -- this only returns true or false as a "best guess"
+  (not IDENTP(name)) or (name = "*") or (name = "**") => false
+  sz := SIZE (name' := PNAME name)
+  (sz < 7) or (char("*") ^= name'.0) => false
+  null DIGITP name'.1 => false
+  null STRPOS('"_;",name',1,NIL) => false
+  -- good enough
+  true
+
+makeInternalMapMinivectorName(name) ==
+  STRINGP name =>
+    INTERN STRCONC(name,'";MV")
+  INTERN STRCONC(PNAME name,'";MV")
+
+mkCacheName(name) == INTERNL(STRINGIMAGE name,'";AL")
+
+mkAuxiliaryName(name) == INTERNL(STRINGIMAGE name,'";AUX")
+
+--% Adding a function definition
+
+isMapExpr x == x is ['MAP,:.]
+
+isMap x ==
+  y := get(x,'value,$InteractiveFrame) =>
+    objVal y is ['MAP,:.] => x
+
+addDefMap(['DEF,lhs,mapsig,.,rhs],pred) ==
+  -- Create a new map, add to an existing one, or define a variable
+  --   compute the dependencies for a map
+
+  -- next check is for bad forms on the lhs of the ==, such as
+  -- numbers, constants.
+  if not PAIRP lhs then
+    op := lhs
+    putHist(op,'isInterpreterRule,true,$e)
+    putHist(op,'isInterpreterFunction,false,$e)
+    lhs := [lhs]
+  else
+    -- this is a function definition. If it has been declared
+    -- previously, make sure it is Mapping.
+    op := first lhs
+    (oldMode := get(op,'mode,$e)) and oldMode isnt ['Mapping,:.] =>
+      throwKeyedMsg("S2IM0001",[op,oldMode])
+    putHist(op,'isInterpreterRule,false,$e)
+    putHist(op,'isInterpreterFunction,true,$e)
+
+  (NUMBERP(op) or op in '(true false nil % %%)) =>
+    throwKeyedMsg("S2IM0002",[lhs])
+
+  -- verify a constructor abbreviation is not used on the lhs
+  op ^= (op' := unabbrev op) => throwKeyedMsg("S2IM0003",[op,op'])
+
+  -- get the formal parameters. These should only be atomic symbols
+  -- that are not numbers.
+  parameters := [p for p in rest lhs | IDENTP(p)]
+
+  -- see if a signature has been given. if anything in mapsig is NIL,
+  -- then declaration was omitted.
+  someDecs := nil
+  allDecs := true
+  mapmode := ['Mapping]
+  $env:local := [[NIL]]
+  $eval:local := true           --generate code-- don't just type analyze
+  $genValue:local := true       --evaluate all generated code
+  for d in mapsig repeat
+    if d then
+      someDecs := true
+      d' := evaluateType unabbrev d
+      isPartialMode d' => throwKeyedMsg("S2IM0004",NIL)
+--      tree := mkAtree d'
+--      null (d' := isType tree) => throwKeyedMsg("S2IM0005",[d])
+      mapmode := [d',:mapmode]
+    else allDecs := false
+  if allDecs then
+    mapmode := nreverse mapmode
+    putHist(op,'mode,mapmode,$e)
+    sayKeyedMsg("S2IM0006",[formatOpSignature(op,rest mapmode)])
+  else if someDecs then throwKeyedMsg("S2IM0007",[op])
+
+  -- if map is declared, check that signature arg count is the
+  -- same as what is given.
+  if get(op,'mode,$e) is ['Mapping,.,:mapargs] then
+    EQCAR(rhs,'rules) =>
+      0 ^= (numargs := # rest lhs) =>
+        throwKeyedMsg("S2IM0027",[numargs,op])
+    # rest lhs ^= # mapargs => throwKeyedMsg("S2IM0008",[op])
+  --get all the user variables in the map definition.  This is a multi
+  --step process as this should not include recursive calls to the map
+  --itself, or the formal parameters
+  userVariables1 := getUserIdentifiersIn rhs
+  $freeVars: local := NIL
+  $localVars: local := NIL
+  for parm in parameters repeat mkLocalVar($mapName,parm)
+  userVariables2 := setDifference(userVariables1,findLocalVars(op,rhs))
+  userVariables3 := setDifference(userVariables2, parameters)
+  userVariables4 := REMDUP setDifference (userVariables3, [op])
+
+  --figure out the new dependencies for the new map (what it depends on)
+  newDependencies := makeNewDependencies (op, userVariables4)
+  putDependencies (op, newDependencies)
+  clearDependencies(op,'T)
+  addMap(lhs,rhs,pred)
+
+addMap(lhs,rhs,pred) ==
+  [op,:argl] := lhs
+  $sl: local:= nil
+  formalArgList:= [mkFormalArg(makeArgumentIntoNumber x,s)
+    for x in argl for s in $FormalMapVariableList]
+  argList:=
+    [fn for x in formalArgList] where
+      fn ==
+        if x is ["SUCHTHAT",s,p] then (predList:= [p,:predList]; x:= s)
+        x
+  mkMapAlias(op,argl)
+  argPredList:= NREVERSE predList
+  finalPred :=
+-- handle g(a,T)==a+T confusion between pred=T and T variable
+    MKPF((pred and (pred ^= 'T) => [:argPredList,SUBLISNQ($sl,pred)]; argPredList),"and")
+  body:= SUBLISNQ($sl,rhs)
+  oldMap :=
+    (obj := get(op,'value,$InteractiveFrame)) => objVal obj
+    NIL
+  newMap := augmentMap(op,argList,finalPred,body,oldMap)
+  null newMap =>
+    sayRemoveFunctionOrValue op
+    putHist(op,'alias,nil,$e)
+    ""      -- clears value--- see return from addDefMap in tree2Atree1
+  if get(op,'isInterpreterRule,$e) then type := ['RuleCalled,op]
+  else type := ['FunctionCalled,op]
+  recursive :=
+    depthOfRecursion(op,newMap) = 0 => false
+    true
+  putHist(op,'recursive,recursive,$e)
+  objNew(newMap,type)
+
+augmentMap(op,args,pred,body,oldMap) ==
+  pattern:= makePattern(args,pred)
+  newMap:=deleteMap(op,pattern,oldMap)
+  body="" =>
+    if newMap=oldMap then
+      sayMSG ['"   Cannot find part of",:bright op,'"to delete."]
+    newMap  --just delete rule if body is 
+  entry:= [pattern,:body]
+  resultMap:=
+    newMap is ["MAP",:tail] => ["MAP",:tail,entry]
+    ["MAP",entry]
+  resultMap
+
+deleteMap(op,pattern,map) ==
+  map is ["MAP",:tail] =>
+    newMap:= ['MAP,:[x for x in tail | w]] where w ==
+      x is [=pattern,:replacement] => sayDroppingFunctions(op,[x])
+      true
+    null rest newMap => nil
+    newMap
+  NIL
+
+getUserIdentifiersIn body ==
+  null body => nil
+  IDENTP body =>
+    isSharpVarWithNum body => nil
+    body="" => nil
+    [body]
+  body is ["WRAPPED",:.] => nil
+  (body is ["COLLECT",:itl,body1]) or (body is ['REPEAT,:itl,body1]) =>
+    userIds :=
+      S_+(getUserIdentifiersInIterators itl,getUserIdentifiersIn body1)
+    S_-(userIds,getIteratorIds itl)
+  body is [op,:l] =>
+    argIdList:= "append"/[getUserIdentifiersIn y for y in l]
+    bodyIdList :=
+      CONSP op or not (GET(op,'Nud) or GET(op,'Led) or GET(op,'up))=>
+        NCONC(getUserIdentifiersIn op, argIdList)
+      argIdList
+    REMDUP bodyIdList
+
+getUserIdentifiersInIterators itl ==
+  for x in itl repeat
+    x is ["STEP",i,:l] =>
+      varList:= [:"append"/[getUserIdentifiersIn y for y in l],:varList]
+    x is ["IN",.,y]   => varList:= [:getUserIdentifiersIn y,:varList]
+    x is ["ON",.,y]   => varList:= [:getUserIdentifiersIn y,:varList]
+    x is [op,a] and op in '(_| WHILE UNTIL) =>
+      varList:= [:getUserIdentifiersIn a,:varList]
+    keyedSystemError("S2GE0016",['"getUserIdentifiersInIterators",
+      '"unknown iterator construct"])
+  REMDUP varList
+
+getIteratorIds itl ==
+  for x in itl repeat
+    x is ["STEP",i,:.] => varList:= [i,:varList]
+    x is ["IN",y,:.]   => varList:= [y,:varList]
+    x is ["ON",y,:.]   => varList:= [y,:varList]
+    nil
+  varList
+
+makeArgumentIntoNumber x ==
+  x=$Zero => 0
+  x=$One => 1
+  atom x => x
+  x is ["-",n] and NUMBERP n => -n
+  [removeZeroOne first x,:removeZeroOne rest x]
+
+mkMapAlias(op,argl) ==
+  u:= mkAliasList argl
+  newAlias :=
+    alias:= get(op,"alias",$e) => [(y => y; x) for x in alias for y in u]
+    u
+  $e:= putHist(op,"alias",newAlias,$e)
+
+mkAliasList l == fn(l,nil) where fn(l,acc) ==
+  null l => NREVERSE acc
+  not IDENTP first l or first l in acc => fn(rest l,[nil,:acc])
+  fn(rest l,[first l,:acc])
+
+args2Tuple args ==
+  args is [first,:rest] =>
+    null rest => first
+    ["Tuple",:args]
+  nil
+
+makePattern(args,pred) ==
+  nargs:= #args
+  nargs = 1 =>
+    pred is ["=","#1",n] => n
+    addPatternPred("#1",pred)
+  u:= canMakeTuple(nargs,pred) => u
+  addPatternPred(["Tuple",:TAKE(nargs,$FormalMapVariableList)],pred)
+
+addPatternPred(arg,pred) ==
+  pred=true => arg
+  ["|",arg,pred]
+
+canMakeTuple(nargs,pred) ==
+  pred is ["and",:l] and nargs=#l and
+    (u:= [(x is ["=",=y,a] => a; return nil)
+      for y in $FormalMapVariableList for x in orderList l]) =>
+        ["Tuple",:u]
+
+sayRemoveFunctionOrValue x ==
+  (obj := getValue x) and (md := objMode obj) =>
+    md = $EmptyMode =>
+      sayMessage ['"  ",:bright x,'"now has no function parts."]
+    sayMessage ['"   value for",:bright x,'"has been removed."]
+  sayMessage ['"  ",:bright x,'"has no value so this does nothing."]
+
+sayDroppingFunctions(op,l) ==
+  sayKeyedMsg("S2IM0017",[#l,op])
+  if $displayDroppedMap then
+    for [pattern,:replacement] in l repeat
+      displaySingleRule(op,pattern,replacement)
+  nil
+
+makeRuleForm(op,pattern)==
+  pattern is ["Tuple",:l] => [op,:l]
+  [op,:pattern]
+
+mkFormalArg(x,s) ==
+  isConstantArgument x => ["SUCHTHAT",s,["=",s,x]]
+  isPatternArgument x => ["SUCHTHAT",s,["is",s,x]]
+  IDENTP x =>
+    y:= LASSOC(x,$sl) => ["SUCHTHAT",s,["=",s,y]]
+    $sl:= [[x,:s],:$sl]
+    s
+  ['SUCHTHAT,s,["=",s,x]]
+
+isConstantArgument x ==
+  NUMBERP x => x
+  x is ["QUOTE",.] => x
+
+isPatternArgument x == x is ["construct",:.]
+
+--% Map dependencies
+
+makeNewDependencies (op, userVariables) ==
+  null userVariables => nil
+  --add the new dependencies
+  [[(first userVariables),op],
+    :makeNewDependencies (op, rest userVariables)]
+
+putDependencies (op, dependencies) ==
+  oldDependencies := getFlag "$dependencies"
+  --remove the obsolete dependencies:  all those that applied to the
+  --old definition, but may not apply here.  If they do, they'll be
+  --in the list of new dependencies anyway
+  oldDependencies := removeObsoleteDependencies (op, oldDependencies) where
+    removeObsoleteDependencies (op, oldDep) ==
+      null oldDep => nil
+      op = rest first oldDep =>
+        removeObsoleteDependencies (op, rest oldDep)
+      [first oldDep,:removeObsoleteDependencies (op, rest oldDep)]
+  --Create the list of dependencies to output.  This will be all the
+  --old dependencies that are still applicable, and all the new ones
+  --that have just been generated.  Remember that the list of
+  --dependencies does not just include those for the map just being
+  --defined, but includes those for all maps and variables that exist
+  newDependencies := union (dependencies, oldDependencies)
+  putFlag ("$dependencies", newDependencies)
+
+clearDependencies(x,clearLocalModemapsIfTrue) ==
+  $dependencies: local:= COPY getFlag "$dependencies"
+  clearDep1(x,nil,nil,$dependencies)
+
+clearDep1(x,toDoList,doneList,depList) ==
+  x in doneList => nil
+  clearCache x
+  newDone:= [x,:doneList]
+  until null a repeat
+    a:= ASSQ(x,depList)
+    a =>
+      depList:= delete(a,depList)
+      toDoList:= setUnion(toDoList,
+        setDifference(CDR a,doneList))
+  toDoList is [a,:res] => clearDep1(a,res,newDone,depList)
+  'done
+
+--% Formatting and displaying maps
+
+displayRule(op,rule) ==
+  null rule => nil
+  mathprint ["CONCAT","Definition:   ", rule]
+  nil
+
+outputFormat(x,m) ==
+  -- this is largely junk and is being phased out
+  IDENTP m => x
+  m=$OutputForm or m=$EmptyMode => x
+  categoryForm?(m) => x
+  isMapExpr x => x
+  containsVars x => x
+  atom(x) and CAR(m) = 'List => x
+  (x is ['construct,:.]) and m = '(List (Expression)) => x
+  T:= coerceInteractive(objNewWrap(x,maximalSuperType(m)),
+    $OutputForm) or return x
+  objValUnwrap T
+
+displaySingleRule($op,pattern,replacement) ==
+  mathprint ['MAP,[pattern,:replacement]]
+
+displayMap(headingIfTrue,$op,map) ==
+  mathprint
+    headingIfTrue => ['CONCAT,PNAME "value:  ",map]
+    map
+
+simplifyMapPattern (x,alias) ==
+  for a in alias
+    for m in $FormalMapVariableList | a and ^CONTAINED(a,x) repeat
+      x:= substitute(a,m,x)
+  [lhs,:rhs]:= x
+  rhs := simplifyMapConstructorRefs rhs
+  x := [lhs,:rhs]
+  lhs is ["|",y,pred] =>
+    pred:= predTran pred
+    sl:= getEqualSublis pred =>
+      y':= SUBLIS(sl,y)
+      pred:= unTrivialize SUBLIS(sl,pred) where unTrivialize x ==
+        x is [op,:l] and op in '(_and _or) =>
+          MKPF([unTrivialize y for y in l],op)
+        x is [op,a,=a] and op in '(_= is)=> true
+        x
+      rhs':= SUBLIS(sl,rhs)
+      pred=true => [y',:rhs']
+      [["PAREN",["|",y',pred]],:rhs']
+    pred=true => [y,:rhs]
+    [["PAREN",["|",y,pred]],:rhs]
+  lhs=true => ["true",:rhs]
+  x
+
+simplifyMapConstructorRefs form ==
+  -- try to linear format constructor names
+  ATOM form => form
+  [op,:args] := form
+  op in '(exit SEQ) =>
+    [op,:[simplifyMapConstructorRefs a for a in args]]
+  op in '(REPEAT) =>
+    [op,first args,:[simplifyMapConstructorRefs a for a in rest args]]
+  op in '(_: _:_: _@) =>
+    args is [obj,dom] =>
+      dom' := prefix2String dom
+      --if ATOM dom' then dom' := [dom']
+      --[op,obj,APPLY('CONCAT,dom')]
+      dom'' :=
+          ATOM dom' => dom'
+          NULL CDR dom' => CAR dom'
+          APPLY('CONCAT, dom')
+      [op,obj, dom'']
+    form
+  form
+
+predTran x ==
+  x is ["IF",a,b,c] =>
+    c = "false" => MKPF([predTran a,predTran b],"and")
+    b = "true" => MKPF([predTran a,predTran c],"or")
+    b = "false" and c = "true" => ["not",predTran a]
+    x
+  x
+
+getEqualSublis pred == fn(pred,nil) where fn(x,sl) ==
+  (x:= SUBLIS(sl,x)) is [op,:l] and op in '(_and _or) =>
+    for y in l repeat sl:= fn(y,sl)
+    sl
+  x is ["is",a,b] => [[a,:b],:sl]
+  x is ["=",a,b] =>
+    IDENTP a and not CONTAINED(a,b) => [[a,:b],:sl]
+    IDENTP b and not CONTAINED(b,a) => [[b,:a],:sl]
+    sl
+  sl
+
+--% User function analysis
+
+mapCatchName mapname ==
+   INTERN STRCONC('"$",STRINGIMAGE mapname,'"CatchMapIdentifier$")
+
+analyzeMap(op,argTypes,mapDef, tar) ==
+  -- Top level enty point for map type analysis.  Sets up catch point
+  --  for interpret-code mode.
+  $compilingMap:local := true
+  $definingMap:local := true
+  $minivector     : local := nil   -- later becomes value of $minivectorName
+  $mapThrowCount  : local := 0     -- number of "return"s encountered
+  $mapReturnTypes : local := nil   -- list of types from returns
+  $repeatLabel    : local := nil   -- for loops; see upREPEAT
+  $breakCount     : local := 0     -- breaks from loops; ditto
+  $mapTarget      : local := tar
+  $interpOnly: local := NIL
+  $mapName : local := op.0
+  if get($mapName,'recursive,$e) then
+    argTypes := [f t for t in argTypes] where
+      f x ==
+        isEqualOrSubDomain(x,$Integer) => $Integer
+        x
+  mapAndArgTypes := [$mapName,:argTypes]
+  member(mapAndArgTypes,$analyzingMapList) =>
+    -- if the map is declared, return the target type
+    (getMode op) is ['Mapping,target,:.] => target
+    throwKeyedMsg("S2IM0009",
+      [$mapName,['" ", map for [map,:.] in $analyzingMapList]])
+  PUSH(mapAndArgTypes,$analyzingMapList)
+  mapDef := mapDefsWithCorrectArgCount(#argTypes, mapDef)
+  null mapDef => (POP $analyzingMapList; nil)
+
+  UNWIND_-PROTECT(x:=CATCH('mapCompiler,analyzeMap0(op,argTypes,mapDef)),
+    POP $analyzingMapList)
+  x='tryInterpOnly =>
+    opName:=getUnname op
+    fun := mkInterpFun(op,opName,argTypes)
+    if getMode op isnt ['Mapping,:sig] then
+      sig := [nil,:[nil for type in argTypes]]
+    $e:=putHist(opName,'localModemap,
+      [[['interpOnly,:sig],fun,NIL]],$e)
+  x
+
+analyzeMap0(op,argTypes,mapDef) ==
+  -- Type analyze and compile a map.  Returns the target type of the map.
+  --  only called if there is no applicable compiled map
+  $MapArgumentTypeList:local:= argTypes
+  numMapArgs mapDef ^= #argTypes => nil
+  ((m:=getMode op) is ['Mapping,:sig]) or (m and (sig:=[m])) =>
+    -- op has mapping property only if user has declared the signature
+    analyzeDeclaredMap(op,argTypes,sig,mapDef,$mapList)
+  analyzeUndeclaredMap(getUnname op,argTypes,mapDef,$mapList)
+
+compFailure msg ==
+  -- Called when compilation fails in such a way that interpret-code
+  --  mode might be of some use.
+  not $useCoerceOrCroak =>    THROW('coerceOrCroaker, 'croaked)
+  if $reportInterpOnly then
+    sayMSG msg
+    sayMSG '"   We will attempt to interpret the code."
+  null $compilingMap => THROW('loopCompiler,'tryInterpOnly)
+  THROW('mapCompiler,'tryInterpOnly)
+
+mkInterpFun(op,opName,argTypes) ==
+  -- creates a function form to put in fun slot of interp-only
+  -- local modemaps
+  getMode op isnt ['Mapping,:sig] => nil
+  parms := [var for type in argTypes for var in $FormalMapVariableList]
+  arglCode := ['LIST,:[argCode for type in argTypes
+    for argName in parms]] where argCode ==
+      ['putValueValue,['mkAtreeNode,MKQ argName],
+        objNewCode(['wrap,argName],type)]
+  funName := GENSYM()
+  body:=['rewriteMap1,MKQ opName,arglCode,MKQ sig]
+  putMapCode(opName,body,sig,funName,parms,false)
+  genMapCode(opName,body,sig,funName,parms,false)
+  funName
+
+rewriteMap(op,opName,argl) ==
+  -- interpret-code handler for maps.  Recursively calls the interpreter
+  --   on the body of the map.
+  not $genValue =>
+    get(opName,'mode,$e) isnt ['Mapping,:sig] =>
+      compFailure  ['"   Cannot compile map:",:bright opName]
+    arglCode := ['LIST,:[argCode for arg in argl for argName in
+      $FormalMapVariableList]] where argCode ==
+        ['putValueValue,['mkAtreeNode,MKQ argName],
+          objNewCode(['wrap,wrapped2Quote(objVal getValue arg)],
+            getMode arg)]
+    putValue(op,objNew(['rewriteMap1,MKQ opName,arglCode,MKQ sig],
+      CAR sig))
+    putModeSet(op,[CAR sig])
+  rewriteMap0(op,opName,argl)
+
+putBodyInEnv(opName, numArgs) ==
+  val := get(opName, 'value, $e)
+  val is [.,'MAP, :bod] =>
+    $e := putHist(opName, 'mapBody, combineMapParts
+      mapDefsWithCorrectArgCount(numArgs, bod), $e)
+  'failed
+
+removeBodyFromEnv(opName) ==
+  $e := putHist(opName, 'mapBody, nil, $e)
+
+
+rewriteMap0(op,opName,argl) ==
+  -- $genValue case of map rewriting
+  putBodyInEnv(opName, #argl)
+  if (s := get(opName,'mode,$e)) then
+    tar := CADR s
+    argTypes := CDDR s
+  else
+    tar:= nil
+    argTypes:= nil
+  get(opName,'mode,$e) is ['Mapping,tar,:argTypes]
+  $env: local := [[NIL]]
+  for arg in argl
+    for var in $FormalMapVariableList repeat
+      if argTypes then
+        t := CAR argTypes
+        argTypes:= CDR argTypes
+        val :=
+          t is ['Mapping,:.] => getValue arg
+          coerceInteractive(getValue arg,t)
+      else
+        val:= getValue arg
+      $env:=put(var,'value,val,$env)
+      if VECP arg then $env := put(var,'name,getUnname arg,$env)
+      (m := getMode arg) => $env := put(var,'mode,m,$env)
+  null (val:= interpMap(opName,tar)) =>
+    throwKeyedMsg("S2IM0010",[opName])
+  putValue(op,val)
+  removeBodyFromEnv(opName)
+  ms := putModeSet(op,[objMode val])
+
+rewriteMap1(opName,argl,sig) ==
+  -- compiled case of map rewriting
+  putBodyInEnv(opName, #argl)
+  if sig then
+    tar:= CAR sig
+    argTypes:= CDR sig
+  else
+    tar:= nil
+    argTypes:= nil
+  evArgl := NIL
+  for arg in reverse argl repeat
+    v := getValue arg
+    evArgl := [objNew(objVal v, objMode v),:evArgl]
+  $env : local := [[NIL]]
+  for arg in argl for evArg in evArgl
+    for var in $FormalMapVariableList repeat
+      if argTypes then
+        t:=CAR argTypes
+        argTypes:= CDR argTypes
+        val :=
+          t is ['Mapping,:.] => evArg
+          coerceInteractive(evArg,t)
+      else
+        val:= evArg
+      $env:=put(var,'value,val,$env)
+      if VECP arg then $env := put(var,'name,getUnname arg,$env)
+      (m := getMode arg) => $env := put(var,'mode,m,$env)
+  val:= interpMap(opName,tar)
+  removeBodyFromEnv(opName)
+  objValUnwrap(val)
+
+interpMap(opName,tar) ==
+  -- call the interpreter recursively on map body
+  $genValue : local:= true
+  $interpMapTag : local := nil
+  $interpOnly : local := true
+  $localVars : local := NIL
+  for lvar in get(opName,'localVars,$e) repeat mkLocalVar(opName,lvar)
+  $mapName : local := opName
+  $mapTarget : local := tar
+  body:= get(opName,'mapBody,$e)
+  savedTimerStack := COPY $timedNameStack
+  catchName := mapCatchName $mapName
+  c := CATCH(catchName, interpret1(body,tar,nil))
+--  $interpMapTag and $interpMapTag ^= mapCatchName $mapName =>
+--    THROW($interpMapTag,c)
+  while savedTimerStack ^= $timedNameStack repeat
+    stopTimingProcess peekTimedName()
+  c  -- better be a triple
+
+analyzeDeclaredMap(op,argTypes,sig,mapDef,$mapList) ==
+  -- analyzes and compiles maps with declared signatures.  argTypes
+  -- is a list of types of the arguments, sig is the declared signature
+  -- mapDef is the stored form of the map body.
+  opName := getUnname op
+  $mapList:=[opName,:$mapList]
+  $mapTarget := CAR sig
+  (mmS:= get(opName,'localModemap,$e)) and
+    (mm:= or/[mm for (mm:=[[.,:mmSig],:.]) in mmS | mmSig=sig]) =>
+      compileCoerceMap(opName,argTypes,mm)
+  -- The declared map needs to be compiled
+  compileDeclaredMap(opName,sig,mapDef)
+  argTypes ^= CDR sig =>
+    analyzeDeclaredMap(op,argTypes,sig,mapDef,$mapList)
+  CAR sig
+
+compileDeclaredMap(op,sig,mapDef) ==
+  -- Type analyzes and compiles a map with a declared signature.
+  -- creates a local modemap and puts it into the environment
+  $localVars: local := nil
+  $freeVars: local := nil
+  $env:local:= [[NIL]]
+  parms:=[var for var in $FormalMapVariableList for m in CDR sig]
+  for m in CDR sig for var in parms repeat
+    $env:= put(var,'mode,m,$env)
+  body:= getMapBody(op,mapDef)
+  for lvar in parms repeat mkLocalVar($mapName,lvar)
+  for lvar in getLocalVars(op,body) repeat mkLocalVar($mapName,lvar)
+  name := makeLocalModemap(op,sig)
+  val  := compileBody(body,CAR sig)
+  isRecursive := (depthOfRecursion(op,body) > 0)
+  putMapCode(op,objVal val,sig,name,parms,isRecursive)
+  genMapCode(op,objVal val,sig,name,parms,isRecursive)
+  CAR sig
+
+putMapCode(op,code,sig,name,parms,isRecursive) ==
+  -- saves the generated code and some other information about the
+  -- function
+  codeInfo := VECTOR(op,code,sig,name,parms,isRecursive)
+  allCode := [codeInfo,:get(op,'generatedCode,$e)]
+  $e := putHist(op,'generatedCode,allCode,$e)
+  op
+
+makeLocalModemap(op,sig) ==
+  -- create a local modemap for op with sig, and put it into $e
+  if (currentMms := get(op,'localModemap,$e)) then
+    untraceMapSubNames [CADAR currentMms]
+  newName := makeInternalMapName(op,#sig-1,1+#currentMms,NIL)
+  newMm := [['local,:sig],newName,nil]
+  mms := [newMm,:currentMms]
+  $e := putHist(op,'localModemap,mms,$e)
+  newName
+
+genMapCode(op,body,sig,fnName,parms,isRecursive) ==
+  -- calls the lisp compiler on the body of a map
+  if lmm:= get(op,'localModemap,$InteractiveFrame) then
+    untraceMapSubNames [CADAR lmm]
+  op0 :=
+    ( n := isSharpVarWithNum op ) => STRCONC('"<argument ",object2String n,'">")
+    op
+  if get(op,'isInterpreterRule,$e) then
+    sayKeyedMsg("S2IM0014",[op0,(PAIRP sig =>prefix2String CAR sig;'"?")])
+  else sayKeyedMsg("S2IM0015",[op0,formatSignature sig])
+  $whereCacheList := [op,:$whereCacheList]
+
+  -- RSS: 6-21-94
+  -- The following code ensures that local variables really are local
+  -- to a function. We will unnecessarily generate preliminary LETs for
+  -- loop variables and variables that do have LET expressions, but that
+  -- can be finessed later.
+
+  locals := SETDIFFERENCE(COPY $localVars, parms)
+  if locals then
+    lets := [['LET, l, ''UNINITIALIZED__VARIABLE, op] for l in locals]
+    body := ['PROGN, :lets, body]
+
+  reportFunctionCompilation(op,fnName,parms,
+    wrapMapBodyWithCatch flattenCOND body,isRecursive)
+
+compileBody(body,target) ==
+  -- recursively calls the interpreter on the map body
+  --  returns a triple with the LISP code for body in the value cell
+  $insideCompileBodyIfTrue: local := true
+  $genValue: local := false
+  $declaredMode:local := target
+  $eval:local:= true
+  r := interpret1(body,target,nil)
+
+compileCoerceMap(op,argTypes,mm) ==
+  -- compiles call to user-declared map where the arguments need
+  --  to be coerced. mm is the modemap for the declared map.
+  $insideCompileBodyIfTrue: local := true
+  $genValue: local := false
+  [[.,:sig],imp,.]:= mm
+  parms:= [var for var in $FormalMapVariableList for t in CDR sig]
+  name:= makeLocalModemap(op,[CAR sig,:argTypes])
+  argCode := [objVal(coerceInteractive(objNew(arg,t1),t2) or
+    throwKeyedMsg("S2IC0001",[arg,$mapName,t1,t2]))
+      for t1 in argTypes for t2 in CDR sig for arg in parms]
+  $insideCompileBodyIfTrue := false
+  parms:= [:parms,'envArg]
+  body := ['SPADCALL,:argCode,['LIST,['function,imp]]]
+  minivectorName := makeInternalMapMinivectorName(name)
+  $minivectorNames := [[op,:minivectorName],:$minivectorNames]
+  body := SUBST(minivectorName,"$$$",body)
+  if $compilingInputFile then
+    $minivectorCode := [:$minivectorCode,minivectorName]
+  SET(minivectorName,LIST2REFVEC $minivector)
+  compileInteractive [name,['LAMBDA,parms,body]]
+  CAR sig
+
+depthOfRecursion(opName,body) ==
+  -- returns the "depth" of recursive calls of opName in body
+  mapRecurDepth(opName,nil,body)
+
+mapRecurDepth(opName,opList,body) ==
+  -- walks over the map body counting depth of recursive calls
+  --  expanding the bodies of maps called in body
+  atom body => 0
+  body is [op,:argl] =>
+    argc:=
+      atom argl => 0
+      argl => "MAX"/[mapRecurDepth(opName,opList,x) for x in argl]
+      0
+    op in opList => argc
+    op=opName => 1 + argc
+    (obj := get(op,'value,$e)) and objVal obj is ['MAP,:mapDef] =>
+      mapRecurDepth(opName,[op,:opList],getMapBody(op,mapDef))
+        + argc
+    argc
+  keyedSystemError("S2GE0016",['"mapRecurDepth",
+    '"unknown function form"])
+
+analyzeUndeclaredMap(op,argTypes,mapDef,$mapList) ==
+  -- Computes the signature of the map named op, and compiles the body
+  $freeVars:local := NIL
+  $localVars: local := NIL
+  $env:local:= [[NIL]]
+  $mapList := [op,:$mapList]
+  parms:=[var for var in $FormalMapVariableList for m in argTypes]
+  for m in argTypes for var in parms repeat
+    put(var,'autoDeclare,'T,$env)
+    put(var,'mode,m,$env)
+  body:= getMapBody(op,mapDef)
+  for lvar in parms repeat mkLocalVar($mapName,lvar)
+  for lvar in getLocalVars(op,body) repeat mkLocalVar($mapName,lvar)
+  (n:= depthOfRecursion(op,body)) = 0 =>
+    analyzeNonRecursiveMap(op,argTypes,body,parms)
+  analyzeRecursiveMap(op,argTypes,body,parms,n)
+
+analyzeNonRecursiveMap(op,argTypes,body,parms) ==
+  -- analyze and compile a non-recursive map definition
+  T := compileBody(body,$mapTarget)
+  if $mapThrowCount > 0 then
+    t := objMode T
+    b := and/[(t = rt) for rt in $mapReturnTypes]
+    not b =>
+      t := resolveTypeListAny [t,:$mapReturnTypes]
+      if not $mapTarget then $mapTarget := t
+      T := compileBody(body,$mapTarget)
+  sig := [objMode T,:argTypes]
+  name:= makeLocalModemap(op,sig)
+  putMapCode(op,objVal T,sig,name,parms,false)
+  genMapCode(op,objVal T,sig,name,parms,false)
+  objMode(T)
+
+analyzeRecursiveMap(op,argTypes,body,parms,n) ==
+  -- analyze and compile a non-recursive map definition
+  --  makes guess at signature by analyzing non-recursive part of body
+  --  then re-analyzes the entire body until the signature doesn't change
+  localMapInfo := saveDependentMapInfo(op, CDR $mapList)
+  tar := CATCH('interpreter,analyzeNonRecur(op,body,$localVars))
+  for i in 0..n until not sigChanged repeat
+    sigChanged:= false
+    name := makeLocalModemap(op,sig:=[tar,:argTypes])
+    code := compileBody(body,$mapTarget)
+    objMode(code) ^= tar =>
+      sigChanged:= true
+      tar := objMode(code)
+      restoreDependentMapInfo(op, CDR $mapList, localMapInfo)
+  sigChanged => throwKeyedMsg("S2IM0011",[op])
+  putMapCode(op,objVal code,sig,name,parms,true)
+  genMapCode(op,objVal code,sig,name,parms,true)
+  tar
+
+saveDependentMapInfo(op,opList) ==
+  not (op in opList) =>
+    lmml := [[op, :get(op, 'localModemap, $e)]]
+    gcl := [[op, :get(op, 'generatedCode, $e)]]
+    for [dep1,dep2] in getFlag("$dependencies") | dep1=op repeat
+      [lmml', :gcl'] := saveDependentMapInfo(dep2, [op, :opList])
+      lmms := nconc(lmml', lmml)
+      gcl := nconc(gcl', gcl)
+    [lmms, :gcl]
+  nil
+
+restoreDependentMapInfo(op, opList, [lmml,:gcl]) ==
+  not (op in opList) =>
+    clearDependentMaps(op,opList)
+    for [op, :lmm] in lmml repeat
+      $e := putHist(op,'localModemap,lmm,$e)
+    for [op, :gc] in gcl repeat
+      $e := putHist(op,'generatedCode,gc,$e)
+
+clearDependentMaps(op,opList) ==
+  -- clears the local modemaps of all the maps that depend on op
+  not (op in opList) =>
+    $e := putHist(op,'localModemap,nil,$e)
+    $e := putHist(op,'generatedCode,nil,$e)
+    for [dep1,dep2] in getFlag("$dependencies") | dep1=op repeat
+      clearDependentMaps(dep2,[op,:opList])
+
+analyzeNonRecur(op,body,$localVars) ==
+  -- type analyze the non-recursive part of a map body
+  nrp := nonRecursivePart(op,body)
+  for lvar in findLocalVars(op,nrp) repeat mkLocalVar($mapName,lvar)
+  objMode(compileBody(nrp,$mapTarget))
+
+nonRecursivePart(opName, funBody) ==
+  -- takes funBody, which is the parse tree of the definition of
+  --  a function, and returns a list of the parts
+  --  of the function which are not recursive in the name opName
+  body:= expandRecursiveBody([opName], funBody)
+  ((nrp:=nonRecursivePart1(opName, body)) ^= 'noMapVal) => nrp
+  throwKeyedMsg("S2IM0012",[opName])
+
+expandRecursiveBody(alreadyExpanded, body) ==
+  -- replaces calls to other maps with their bodies
+  atom body =>
+    (obj := get(body,'value,$e)) and objVal obj is ['MAP,:mapDef] and
+      ((numMapArgs mapDef) = 0) => getMapBody(body,mapDef)
+    body
+  body is [op,:argl] =>
+    not (op in alreadyExpanded) =>
+      (obj := get(op,'value,$e)) and objVal obj is ['MAP,:mapDef] =>
+        newBody:= getMapBody(op,mapDef)
+        for arg in argl for var in $FormalMapVariableList repeat
+          newBody:=MSUBST(arg,var,newBody)
+        expandRecursiveBody([op,:alreadyExpanded],newBody)
+      [op,:[expandRecursiveBody(alreadyExpanded,arg) for arg in argl]]
+    [op,:[expandRecursiveBody(alreadyExpanded,arg) for arg in argl]]
+  keyedSystemError("S2GE0016",['"expandRecursiveBody",
+    '"unknown form of function body"])
+
+nonRecursivePart1(opName, funBody) ==
+  -- returns a function body which contains only the parts of funBody
+  --  which do not call the function opName
+  funBody is ['IF,a,b,c] =>
+    nra:=nonRecursivePart1(opName,a)
+    nra = 'noMapVal => 'noMapVal
+    nrb:=nonRecursivePart1(opName,b)
+    nrc:=nonRecursivePart1(opName,c)
+    not (nrb in '(noMapVal noBranch)) => ['IF,nra,nrb,nrc]
+    not (nrc in '(noMapVal noBranch)) => ['IF,['not,nra],nrc,nrb]
+    'noMapVal
+  not containsOp(funBody,'IF) =>
+    notCalled(opName,funBody) => funBody
+    'noMapVal
+  funBody is [op,:argl] =>
+    op=opName => 'noMapVal
+    args:= [nonRecursivePart1(opName,arg) for arg in argl]
+    MEMQ('noMapVal,args) => 'noMapVal
+    [op,:args]
+  funBody
+
+containsOp(body,op) ==
+  -- true IFF body contains an op statement
+  body is [ =op,:.] => true
+  body is [.,:argl] => or/[containsOp(arg,op) for arg in argl]
+  false
+
+notCalled(opName,form) ==
+  -- returns true if opName is not called in the form
+  atom form => true
+  form is [op,:argl] =>
+    op=opName => false
+    and/[notCalled(opName,x) for x in argl]
+  keyedSystemError("S2GE0016",['"notCalled",
+    '"unknown form of function body"])
+
+mapDefsWithCorrectArgCount(n, mapDef) ==
+  [def for def in mapDef | (numArgs CAR def) = n]
+
+numMapArgs(mapDef is [[args,:.],:.]) ==
+  -- returns the number of arguemnts to the map whose body is mapDef
+  numArgs args
+
+numArgs args ==
+  args is ['_|,a,:.] => numArgs a
+  args is ['Tuple,:argl] => #argl
+  null args => 0
+  1
+
+combineMapParts(mapTail) ==
+  -- transforms a piece-wise function definition into an if-then-else
+  --  statement.  Uses noBranch to indicate undefined branch
+  null mapTail => 'noMapVal
+  mapTail is [[cond,:part],:restMap] =>
+    isSharpVarWithNum cond or (cond is ['Tuple,:args] and
+      and/[isSharpVarWithNum arg for arg in args]) or (null cond) => part
+    ['IF,mkMapPred cond,part,combineMapParts restMap]
+  keyedSystemError("S2GE0016",['"combineMapParts",
+    '"unknown function form"])
+
+mkMapPred cond ==
+  -- create the predicate on map arguments, derived from "when" clauses
+  cond is ['_|,args,pred] => mapPredTran pred
+  cond is ['Tuple,:vals] =>
+    mkValueCheck(vals,1)
+  mkValCheck(cond,1)
+
+mkValueCheck(vals,i) ==
+  -- creates predicate for specific value check (i.e f 1 == 1)
+  vals is [val] => mkValCheck(val,i)
+  ['and,mkValCheck(first vals,i),mkValueCheck(rest vals,i+1)]
+
+mkValCheck(val,i) ==
+  -- create equality check for map predicates
+  isSharpVarWithNum val => 'true
+  ['_=,mkSharpVar i,val]
+
+mkSharpVar i ==
+  -- create #i
+  INTERN CONCAT('"#",STRINGIMAGE i)
+
+mapPredTran pred ==
+  -- transforms "x in i..j" to "x>=i and x<=j"
+  pred is ['in,var,['SEGMENT,lb]] => mkLessOrEqual(lb,var)
+  pred is ['in,var,['SEGMENT,lb,ub]] =>
+    null ub => mkLessOrEqual(lb,var)
+    ['and,mkLessOrEqual(lb,var),mkLessOrEqual(var,ub)]
+  pred
+
+findLocalVars(op,form) ==
+  -- analyzes form for local and free variables, and returns the list
+  --  of locals
+  findLocalVars1(op,form)
+  $localVars
+
+findLocalVars1(op,form) ==
+  -- sets the two lists $localVars and $freeVars
+  atom form =>
+    not IDENTP form or isSharpVarWithNum form => nil
+    isLocalVar(form) or isFreeVar(form) => nil
+    mkFreeVar($mapName,form)
+  form is ['local, :vars] =>
+    for x in vars repeat
+      ATOM x => mkLocalVar(op, x)
+  form is ['free, :vars] =>
+    for x in vars repeat
+      ATOM x => mkFreeVar(op, x)
+  form is ['LET,a,b] =>
+    (a is ['Tuple,:vars]) and (b is ['Tuple,:vals]) =>
+      for var in vars for val in vals repeat
+        findLocalVars1(op,['LET,var,val])
+    a is ['construct,:pat] =>
+      for var in listOfVariables pat repeat mkLocalVar(op,var)
+      findLocalVars1(op,b)
+    (atom a) or (a is ['_:,a,.]) =>
+      mkLocalVar(op,a)
+      findLocalVars1(op,b)
+    findLocalVars(op,b)
+    for x in a repeat findLocalVars1(op,x)
+  form is ['_:,a,.] =>
+    mkLocalVar(op,a)
+  form is ['is,l,pattern] =>
+    findLocalVars1(op,l)
+    for var in listOfVariables CDR pattern repeat mkLocalVar(op,var)
+  form is [oper,:itrl,body] and MEMQ(oper,'(REPEAT COLLECT)) =>
+    findLocalsInLoop(op,itrl,body)
+  form is [y,:argl] =>
+    y is 'Record => nil
+    for x in argl repeat findLocalVars1(op,x)
+  keyedSystemError("S2IM0020",[op])
+
+findLocalsInLoop(op,itrl,body) ==
+  for it in itrl repeat
+    it is ['STEP,index,lower,step,:upperList] =>
+      mkLocalVar(op,index)
+      findLocalVars1(op,lower)
+      for up in upperList repeat findLocalVars1(op,up)
+    it is ['IN,index,s] =>
+      mkLocalVar(op,index) ; findLocalVars1(op,s)
+    it is ['WHILE,b] =>
+      findLocalVars1(op,b)
+    it is ['_|,pred] =>
+      findLocalVars1(op,pred)
+  findLocalVars1(op,body)
+  for it in itrl repeat
+    it is [op,b] and (op in '(UNTIL)) =>
+      findLocalVars1(op,b)
+
+isLocalVar(var) == member(var,$localVars)
+
+mkLocalVar(op,var) ==
+  -- add var to the local variable list
+  isFreeVar(var) => $localVars
+  $localVars:= insert(var,$localVars)
+
+isFreeVar(var) == member(var,$freeVars)
+
+mkFreeVar(op,var) ==
+  -- op here for symmetry with mkLocalVar
+  $freeVars:= insert(var,$freeVars)
+
+listOfVariables pat ==
+  -- return a list of the variables in pat, which is an "is" pattern
+  IDENTP pat => (pat='_. => nil ; [pat])
+  pat is ['_:,var] or pat is ['_=,var] =>
+    (var='_. => NIL ; [var])
+  PAIRP pat => REMDUP [:listOfVariables p for p in pat]
+  nil
+
+getMapBody(op,mapDef) ==
+  -- looks in $e for a map body; if not found it computes then stores it
+  get(op,'mapBody,$e) or
+    combineMapParts mapDef
+--    $e:= putHist(op,'mapBody,body:= combineMapParts mapDef,$e)
+--    body
+
+getLocalVars(op,body) ==
+  -- looks in $e for local vars; if not found, computes then stores them
+  get(op,'localVars,$e) or
+    $e:= putHist(op,'localVars,lv:=findLocalVars(op,body),$e)
+    lv
+
+--  DO NOT BELIEVE ALL OF THE FOLLOWING (IT IS OLD)
+
+--  VARIABLES.  Variables may or may not have a mode property.  If
+--  present, any value which is assigned or generated by that variable
+--  is first coerced to that mode before being assigned or returned.
+--
+--
+--  Variables are given a triple [val,m,e] as a "value" property on
+--  its property list in the environment.  The expression val has the
+--  forms:
+--
+--        (WRAPPED . y)       --value of x is y (don't re-evaluate)
+--        y --anything else   --value of x is obtained by evaluating y
+--
+--  A wrapped expression is created by an assignment.  In the second
+--  case, y can never contain embedded wrapped expressions.  The mode
+--  part m of the triple is the type of y in the wrapped case and is
+--  consistent with the declared mode if given.  The mode part of an
+--  unwrapped value is always $EmptyMode.  The e part is usually NIL
+--  but may be used to hold a partial closure.
+--
+--  Effect of changes.  A rule can be built up for a variable by
+--  successive rules involving conditional expressions.  However, once
+--  a value is assigned to the variable or an unconditional definition
+--  is given, any existing value is replaced by the new entry.  When
+--  the mode of a variable is declared, an wrapped value is coerced to
+--  the new mode; if this is not possible, the user is notified that
+--  the current value is discarded and why.  When the mode is
+--  redeclared and an upwrapped value is present, the value is
+--  retained; the only other effect is to coerce any cached values
+--  from the old mode to the new one.
+--
+--  Caches.  When a variable x is evaluated and re-evaluation occurs,
+--  the triple produced by that evaluation is stored under "cache" on
+--  the property list of x. This cached triple is cleared whenever any
+--  of the variables which x's value depend upon change.  Dependencies
+--  are stored on $dependencies whose value has the form [[a b ..] ..]
+--  to indicate that when a is changed, b .. must have all cached
+--  values destroyed.  In the case of parameterized forms which are
+--  represented by maps, we currently can cache values only when the
+--  compiler option is turned on by )on c s meaning "on compiler with
+--  the save option".  When f is compiled as f;1, it then has an alist
+--  f;1;AL which records these values.  If f depends globally on a's
+--  value, all cached values of all local functions defined for f have
+--  to be declared.  If a's mode should change, then all compilations
+--  of f must be thrown away.
+--
+--  PARAMETERIZED FORMS.  These always have values [val,m,e] where val
+--  are "maps".
+--
+--  The structure of maps:
+--   (MAP (pattern . rewrite) ...)   where
+--     pattern has forms:  arg-pattern
+--                         (Tuple arg-pattern ...)
+--     rewrite has forms:  (WRAPPED . value)      --don't re-evaluate
+--                         computational object   --don't (bother to)
+--                                                  re-evaluate
+--                         anything else          --yes, re-evaluate
+--
+--  When assigning values to a map, each new value must have a type
+--  which is consistent with those already assigned.  Initially, type
+--  of MAP is $EmptyMode.  When the map is first assigned a value, the
+--  type of the MAP is RPLACDed to be (Mapping target source ..).
+--  When the map is next assigned, the type of both source and target
+--  is upgraded to be consistent with those values already computed.
+--  Of course, if new and old source and target are identical, nothing
+--  need happen to existing entries.  However, if the new and old are
+--  different, all existing entries of the map are coerce to the new
+--  data type.
+--
+--  Mode analysis.  This is done on the bottomUp phase of the process.
+--  If a function has been given a mapping declaration, this map is
+--  placed in as the mode of the map under the "value" property of the
+--  variable.  Of course, these modes may be partial types in case a
+--  mode analysis is still necessary.  If no mapping declaration, a
+--  total mode analysis of the function, given its input arguments, is
+--  done.  This will result a signature involving types only.
+--
+--  If the compiler is on, the function is then compiled given this
+--  signature involving types.  If the map is value of a variable f, a
+--  function is given name f;1, f is given a "localModemap" property
+--  with modemap ((dummy target source ..) (T f;1)) so that the next
+--  time f is applied to arguments which coerce to the source
+--  arguments of this local modemap, f;1 will be invoked.
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}