From 3156d86ff1d99c2d5291f057bd3a4cb710756472 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Wed, 16 Mar 2011 16:39:22 +0000
Subject: 	* interp/i-syscmd.boot (compileSpad2Cmd): Remove experimental 
 support for Spad to Aldor translation. 	(convertSpasToAsFile): Remove.
 	* interp/mark.boot: Remove. 	* interp/nspadux.lisp: Likewise. 
 * interp/pspad1.boot: Likewise. 	* interp/pspad2.boot: Likewise. 
 * interp/wi1.boot: Likewise. 	* interp/wi2.boot: Likewise. 	*
 interp/spad.lisp: Don't register removed formatters. 	* interp/util.lisp:
 (TRANSLATE-FUNCTIONS): Remove. 	(BUILD-INTERPSYS): Now take only one
 argument. 	* src/share/doc/msgs/s2-us.msgs: Remove diagnostic S2IZ0085. 
 * interp/Makefile.in: Remove rules for building wi1.boot, 	wi2.boot,
 mark.boot, pspad1.boot pspad2.boot.

---
 src/interp/Makefile.in   |   19 +-
 src/interp/i-syscmd.boot |   39 +-
 src/interp/mark.boot     | 1543 ----------------------------------------------
 src/interp/nspadaux.lisp |  119 ----
 src/interp/pspad1.boot   |  745 ----------------------
 src/interp/pspad2.boot   |  663 --------------------
 src/interp/spad.lisp     |   18 -
 src/interp/util.lisp     |   11 +-
 src/interp/wi1.boot      | 1250 -------------------------------------
 src/interp/wi2.boot      | 1132 ----------------------------------
 10 files changed, 5 insertions(+), 5534 deletions(-)
 delete mode 100644 src/interp/mark.boot
 delete mode 100644 src/interp/nspadaux.lisp
 delete mode 100644 src/interp/pspad1.boot
 delete mode 100644 src/interp/pspad2.boot
 delete mode 100644 src/interp/wi1.boot
 delete mode 100644 src/interp/wi2.boot

(limited to 'src/interp')

diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index c751e8d3..8ee22543 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -155,13 +155,6 @@ BROBJS=	bc-matrix.$(FASLEXT)				\
 
 autoload_objects += $(BFOBJS)
 
-# Translator from `old Spad' to `new spad (Aldor)' code.
-# FIXME: is this still relevant?
-TRANOBJS= ${AUTO}/wi1.$(FASLEXT) ${AUTO}/wi2.$(FASLEXT) ${AUTO}/pspad1.$(FASLEXT) \
-	  ${AUTO}/pspad2.$(FASLEXT) ${AUTO}/mark.$(FASLEXT) ${AUTO}/nspadaux.$(FASLEXT)
-
-autoload_objects += $(TRANOBJS)
-
 ASCOMP= as.$(FASLEXT) axext_l.$(FASLEXT)
 
 ASAUTO= ${AUTO}/ax.$(FASLEXT)
@@ -231,7 +224,7 @@ makeint.lisp: Makefile
 	@ echo '(in-package "BOOT")' >> makeint.lisp
 	@ touch ${TIMESTAMP}
 	@ echo '${YEARWEEK}' >> makeint.lisp
-	@ echo '(unless (or |$$StandardLinking| (|%basicSystemIsComplete|)) (build-interpsys (quote ($(patsubst %, "%", ${TRANOBJS}))) (quote ($(patsubst %, "%", ${ASAUTO}))))(|clearClams|))' >> makeint.lisp
+	@ echo '(unless (or |$$StandardLinking| (|%basicSystemIsComplete|)) (build-interpsys (quote ($(patsubst %, "%", ${ASAUTO}))))(|clearClams|))' >> makeint.lisp
 	@ echo '#+:akcl (setq compiler::*suppress-compiler-notes* t)' >> makeint.lisp
 	@ echo '#+:akcl (si::gbc-time 0)' >> makeint.lisp
 	@ echo '#+:GCL (si::gbc t)' >> makeint.lisp
@@ -239,7 +232,7 @@ makeint.lisp: Makefile
 ${SAVESYS}: database.date \
 		$(axiom_targetdir)/algebra/exposed.$(FASLEXT) \
 		$(axiom_target_datadir)/msgs/s2-us.msgs \
-		$(ASAUTO) $(TRANOBJS) $(OBJS) makeint.$(LNKEXT)
+		$(ASAUTO) $(OBJS) makeint.$(LNKEXT)
 	$(DRIVER) --execpath=$(BOOTSYS) \
 		--syslib=$(axiom_target_libdir) \
 		--system="$(AXIOM)/" --system-algebra \
@@ -256,7 +249,7 @@ all-axiomsys: ${AXIOMSYS}
 ${AXIOMSYS}: database.date \
 		$(axiom_targetdir)/algebra/exposed.$(FASLEXT) \
 		$(axiom_target_datadir)/msgs/s2-us.msgs \
-		$(ASAUTO) $(TRANOBJS) $(OBJS) makeint.$(LNKEXT)
+		$(ASAUTO) $(OBJS) makeint.$(LNKEXT)
 	$(DRIVER) --execpath=$(BOOTSYS) \
 		--syslib=$(axiom_target_libdir) \
 		--system="$(AXIOM)/" \
@@ -344,8 +337,6 @@ record.$(FASLEXT): nlib.$(FASLEXT) pathname.$(FASLEXT)
 setvart.$(FASLEXT): macros.$(FASLEXT)
 
 ## OpenAxiom's compiler
-wi2.$(FASLEXT): macros.$(FASLEXT) define.$(FASLEXT)
-wi1.$(FASLEXT): macros.$(FASLEXT)
 compiler.$(FASLEXT): msgdb.$(FASLEXT) pathname.$(FASLEXT) define.$(FASLEXT) 
 nrunfast.$(FASLEXT): c-util.$(FASLEXT)
 nruncomp.$(FASLEXT): profile.$(FASLEXT) simpbool.$(FASLEXT) functor.$(FASLEXT)
@@ -386,7 +377,6 @@ server.$(FASLEXT): macros.$(FASLEXT)
 ## The old parser component roughtly is:
 ##
 spad-parser.$(FASLEXT): parse.$(FASLEXT)
-mark.$(FASLEXT): macros.$(FASLEXT)
 parse.$(FASLEXT): metalex.$(FASLEXT) postpar.$(FASLEXT)
 packtran.$(FASLEXT): sys-macros.$(FASLEXT)
 postpar.$(FASLEXT): macros.$(FASLEXT)
@@ -430,7 +420,6 @@ debug.$(FASLEXT): macros.$(FASLEXT) parsing.$(FASLEXT)
 spad.$(FASLEXT): bootlex.$(FASLEXT) postpar.$(FASLEXT) debug.$(FASLEXT)
 monitor.$(FASLEXT): macros.$(FASLEXT)
 property.$(FASLEXT): sys-macros.$(FASLEXT)
-nspadaux.$(FASLEXT): sys-macros.$(FASLEXT)
 sfsfun-l.$(FASLEXT): sys-macros.$(FASLEXT)
 trace.$(FASLEXT): debug.$(FASLEXT)
 termrw.$(FASLEXT): macros.$(FASLEXT)
@@ -447,8 +436,6 @@ g-error.$(FASLEXT): diagnostics.$(FASLEXT) g-util.$(FASLEXT)
 c-util.$(FASLEXT): g-opt.$(FASLEXT)
 pathname.$(FASLEXT): nlib.$(FASLEXT)
 hashcode.$(FASLEXT): g-util.$(FASLEXT)
-pspad2.$(FASLEXT): pspad1.$(FASLEXT)
-pspad1.$(FASLEXT): macros.$(FASLEXT)
 g-util.$(FASLEXT): ggreater.$(FASLEXT) macros.$(FASLEXT) sys-utility.$(FASLEXT)
 g-cndata.$(FASLEXT): sys-macros.$(FASLEXT)
 msg.$(FASLEXT): sys-macros.$(FASLEXT) astr.$(FASLEXT)
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index b3afc62a..527dc5ae 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -783,8 +783,6 @@ compileSpad2Cmd args ==
       report
         )
 
-    translateOldToNew        := nil
-
     $scanIfTrue              : local := false
     $compileOnlyCertainItems : local := nil
     $f                       : local := nil  -- compiler
@@ -803,7 +801,6 @@ compileSpad2Cmd args ==
 
         fullopt = 'new         => error "Internal error: compileSpad2Cmd got )new"
         fullopt = 'old         => NIL     -- no opt
-        fullopt = 'translate   => translateOldToNew := true
 
         fullopt = 'library     => fun.1 := 'lib
         fullopt = 'nolibrary   => fun.1 := 'nolib
@@ -836,11 +833,7 @@ compileSpad2Cmd args ==
     $InteractiveMode : local := nil
     -- avoid Boolean semantics transformations based on syntax only
     $normalizeTree: local := false
-    if translateOldToNew then
-        spad2AsTranslatorAutoloadOnceTrigger()
-        sayKeyedMsg("S2IZ0085", nil)
-        convertSpadToAsFile path
-    else if $compileOnlyCertainItems then
+    if $compileOnlyCertainItems then
         null constructor => sayKeyedMsg("S2IZ0040",NIL)
         compilerDoitWithScreenedLisplib(constructor, fun)
     else
@@ -851,36 +844,6 @@ compileSpad2Cmd args ==
     -- reset compiler optimization options
     setCompilerOptimizations 0
 
-convertSpadToAsFile path ==
-    -- can assume path has type = .spad
-    $globalMacroStack : local := nil       -- for spad -> as translator
-    $abbreviationStack: local := nil       -- for spad -> as translator
-    $macrosAlreadyPrinted: local := nil    -- for spad -> as translator
-    $abbreviationsAlreadyPrinted: local := nil    -- for spad -> as translator
-    $convertingSpadFile : local := true
-    $options: local := '((nolib))      -- translator shouldn't create nrlibs
-    SETQ(HT,hashTable 'EQUAL)
-
-    newName := fnameMake(pathnameDirectory path, pathnameName path, '"as")
-    canDoIt := true
-    if not fnameWritable? newName then
-        sayKeyedMsg("S2IZ0086", [NAMESTRING newName])
-        newName := fnameMake('".", pathnameName path, '"as")
-        if not fnameWritable? newName then
-            sayKeyedMsg("S2IZ0087", [NAMESTRING newName])
-            canDoIt := false
-    not canDoIt => 'failure
-
-    sayKeyedMsg("S2IZ0088", [NAMESTRING newName])
-
-    $outStream :local := MAKE_-OUTSTREAM newName
-    markSay('"#include _"axiom.as_"")
-    markTerpri()
-    CATCH($SpadReaderTag,compiler [path])
-    SHUT $outStream
-    mkCheck()
-    'done
-
 compilerDoit(constructor, fun) ==
     $byConstructors : local := []
     $constructorsSeen : local := []
diff --git a/src/interp/mark.boot b/src/interp/mark.boot
deleted file mode 100644
index 6915b4d8..00000000
--- a/src/interp/mark.boot
+++ /dev/null
@@ -1,1543 +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.
-
-
--- HOW THE TRANSLATOR WORKS
-
--- Unit of code is markedUp as follows (unit= item in a capsule pile, e.g.)
---   (WI/.. a b)            means    source code a --> markedUpCode b
---   (REPPER/.. . . a)      means    source code for a ---> (rep a) or (per a)
--- Source code is extracted, modified from markedUpCode, and stacked
--- Entire constructor is then assembled and prettyprinted
-
-
-import macros
-namespace BOOT
-
-REMPROP("and",'parseTran)
-REMPROP("or",'parseTran)
-REMPROP("not",'parseTran)
-property("and",'special) := 'compAnd
-property("or",'special) := 'compOr
-property("not",'special) := 'compNot
-SETQ($monitorWI,nil)
-SETQ($monitorCoerce,nil)
-SETQ($markPrimitiveNumbers,nil)  -- '(Integer SmallInteger))
-SETQ($markNumberTypes,'(Integer SmallInteger PositiveInteger NonNegativeInteger))
-
---======================================================================
---              Master Markup Function
---======================================================================
- 
-
-WI(a,b) == b
-
-mkWi(fn,:r) ==            
---  if $monitorWI and r isnt ['WI,:.] and not (r is ['AUTOSUBSET,p,.,y] and(MEMQ(KAR p,'(NonNegativeInteger PositiveInteger)) or y='_$fromCoerceable_$)) then
---    if $monitorWI and r isnt ['WI,:.] then
---    sayBrightlyNT ['"From ",fn,'": "]
---    pp r
-  r is ['WI,a,b] =>
-    a = b => a            --don't bother
-    b is ['WI,=a,.] => b
-    r
-  r
- 
---======================================================================
---        Capsule Function Transformations
---======================================================================
-tcheck T == 
-  if T isnt [.,.,.] then systemError 'tcheck
-  T
-  
-markComp(x,T) ==                                         --for comp
-  tcheck T
-  x ~= first T => [mkWi('comp,'WI,x,first T),:rest T]                  
-  T
-
-markAny(key,x,T) ==
-  tcheck T
-  x ~= first T => [mkWi(key,'WI,x,first T),:rest T]
-  T
-
-markConstruct(x,T) == 
-  tcheck T
-  markComp(x,T)
-
-markParts(x,T) ==  --x is ['PART,n,y]                     --for compNoStacking
-  tcheck T
-  [mkWi('makeParts,'WI,x,first T),:rest T]
-   
-yumyum kind == kind
-markCoerce(T,T',kind) ==                                 --for coerce
-  tcheck T
-  tcheck T'
-  if kind = 'AUTOSUBSET then yumyum(kind)
-  string? T.mode and T'.mode = '(String) => T'
-  markKillAll T.mode = T'.mode => T'
-  -- reduce (AUTOSUBSET a b (WI c (AUTOSUBSET b a c))) ==> c
-  u :=
-    $partExpression is [.,.,y] and T.expr = y => ['WI,y,$partExpression]
-    T.expr
-  res := [markCoerceChk mkWi('coerce,kind,T.mode,T'.mode,
-           mkWi('coerce,'WI,u,T'.expr)),:rest T']
-  res
-  
-markCoerceChk x ==
-  x is ['AUTOSUBSET,a,b,['WI,c,['AUTOSUBSET,=b, =a, =c]]] => c
-  x
-
-markMultipleExplicit(nameList, valList, T) ==
-  tcheck T
-  [mkWi('setqMultipleExplicit, 'WI,
-    ["%LET", ["%Comma",:nameList], ["%Comma",:valList]],
-    T.expr), :rest T]
-
-markRetract(x,T) ==
-  tcheck T
-  [mkWi('smallIntegerStep,'RETRACT,nil,['REPLACE,['retract,x]],T.expr),:rest T]
-
-markSimpleReduce(x,T) ==
-  tcheck T
-  [mkWi('compreduce,'LAMBDA, nil, ["REPLACE",x], T.expr), :rest T]
-
-markCompAtom(x,T) ==                                     --for compAtom
-  tcheck T
-  $convert2NewCompiler =>
-    [mkWi('compAtom,'ATOM,nil,['REPLACE,[x]],T.expr),:rest T]
-  T
-
-markCase(x, tag, T) ==
-  tcheck T
-  [mkWi('compCase1, 'LAMBDA, nil, ["REPLACE",["case",x,tag]], T.expr), 
-    :rest T]
-
-markCaseWas(x,T) == 
-  tcheck T
-  [mkWi('compCase1,'WI,x,T.expr),:rest T]
-
-markAutoWas(x,T) == 
-  tcheck T
-  [mkWi('autoCoerce,'WI,x,T.expr),:rest T]
-
-markCallCoerce(x,m,T) ==
-  tcheck T
-  [mkWi('%call,'WI,["::",x,m], T.expr),: rest T]
-
-markCoerceByModemap(x,source,target,T, killColonColon?) == 
-  tcheck T
-  source is ["Union",:l] and member(target,l) =>
-    tag := genCaseTag(target, l, 1) or return nil
-    markAutoCoerceDown(x, tag, markAutoWas(x,T), killColonColon?)
-  target is ["Union",:l] and member(source,l) =>
-    markAutoCoerceUp(x,markAutoWas(x, T))
-  [mkWi('markCoerceByModemap,'WI,x,T.expr),:rest T]
-   
-markAutoCoerceDown(x,tag,T,killColonColon?) ==
-  tcheck T
-  patch := ["dot",getSourceWI x,tag]
-  if killColonColon? then patch := ["REPLACE",["UNCOERCE",patch]]
-  [mkWi('coerceExtraHard,'LAMBDA, nil,patch,T.expr), :rest T]
-
-markAutoCoerceUp(x,T) ==
---  y := getSourceWI x
---  y := 
---    string? y => makeSymbol y
---    y   
-  tcheck T  
-  [mkWi('coerceExtraHard,'LAMBDA, nil,["REPLACE",['construct, "##1"]],T.expr),
-     -----want to capture by ##1 what is there                ------11/2/94
-    :rest T]
-
-markCompSymbol(x,T) ==                                   --for compSymbol
-  tcheck T
-  [mkWi('compSymbol,'ATOM,nil,['REPLACE,["@",x,$Symbol]],T.expr),:rest T]
-
-markStepSI(ostep,nstep) ==                               --for compIterator
-  ['STEP,:r] := ostep
-  ['ISTEP,i,:s] := nstep
---$localLoopVariables := insert(i,$localLoopVariables)
-  markImport 'SmallInteger
-  mkWi('markStepSI,'WI,ostep,['ISTEP,
-    mkWi('markStep,'FREESI,nil,['REPLACE,          ['PAREN,['free,i]]],i),:s])
---                                    i],i),:s])
-markStep(i) == mkWi('markStep,'FREE,nil,['REPLACE, ['PAREN,['free,i]]],i)
---                                    i],i)
-
-markPretend(T,T') ==
-  tcheck T
-  tcheck T'
-  [mkWi('pretend,'COLON,"pretend",T.mode,T.expr),:rest T']
-
-markAt(T) == 
-  tcheck T
-  [mkWi('compAtom,'COLON,"@",T.mode,T.expr),:rest T]
-
-markCompColonInside(op,T) ==                         --for compColonInside
-  tcheck T
-  $convert2NewCompiler =>
-    [mkWi('compColonInside,'COLON,op,T.mode,T.expr),:rest T]
-  T
-
-markLisp(T,m) ==                                     --for compForm1
-  tcheck T
-  $convert2NewCompiler =>
-    [mkWi('compForm1,'COLON,'Lisp,T.mode,T.expr),:rest T]
-  T
-
-markLambda(vl,body,mode,T) ==                       --for compWithMappingMode
-  tcheck T
-  if mode isnt ['Mapping,:ml] then error '"markLambda"
-  args := [[":",$PerCentVariableList.i,t] for i in 0.. for t in rest ml]
-  left := [":",['PAREN,:args],first ml]
-  fun := ['_+_-_>,left,SUBLISLIS($PerCentVariableList,vl,body)] 
-  [mkWi('compWithMappingMode,'LAMBDA,nil,['REPLACE,fun],T.expr),:rest T]
-
-markMacro(before,after) ==                            --for compMacro
-  $convert2NewCompiler => 
-    if before is [x] then before := x
-    $def := ['MDEF,before,'(NIL),'(NIL),after]
-    if $insideFunctorIfTrue 
-      then $localMacroStack := [[before,:after],:$localMacroStack]
-      else $globalMacroStack:= [[before,:after],:$globalMacroStack]
-    mkWi('macroExpand,'MI,before,after) 
-  after
-
-markInValue(y ,e) ==
-  y1 := markKillAll y
-  [y', m, e] := T := comp(y1, $EmptyMode, e) or return nil
-  markImport m
-  m = "$" and LASSOC('value,getProplist('Rep,e)) is [a,:.] and 
-         opOf a in '(List Vector) => [markRepper('rep, y'), 'Rep, e]
-  T
-
-markReduceIn(it, pr)       ==   markReduceIterator("in",it,pr)
-markReduceStep(it, pr)     ==   markReduceIterator("step", it, pr)
-markReduceWhile(it, pr)    ==   markReduceIterator("while", it, pr)
-markReduceUntil(it, pr)    ==   markReduceIterator("until", it, pr)
-markReduceSuchthat(it, pr) == markReduceIterator("suchthat", it, pr)
-markReduceIterator(kind, it, pr) == [mkWi(kind, 'WI, it, first pr), :rest pr]
-markReduceBody(body,T)     ==  
-  tcheck T
-  [mkWi("reduceBody",'WI,body,first T), :rest T]
-markReduce(form, T)        ==  
-  tcheck T
-  [SETQ($funk,mkWi("reduce", 'WI,form,first T)), :rest T]
-
-markRepeatBody(body,T)     ==  
-  tcheck T
-  [mkWi("repeatBody",'WI,body,first T), :rest T]
-
-markRepeat(form, T)        ==  
-  tcheck T
-  [mkWi("repeat", 'WI,form,first T), :rest T]
-  
-markTran(form,form',[dc,:sig],env) ==  --from compElt/compFormWithModemap
-  dc ~= 'Rep or not ('_$ in sig) => mkWi('markTran,'WI,form,['%call,:form'])
-  argl := [u for t in rest sig for arg in rest form'] where u() ==
-    t='_$ => 
-      argSource := getSourceWI arg
-      IDENTP argSource and getmode(argSource,env) = 'Rep => arg
-      markRepper('rep,arg)
-    arg
-  form' := ['%call,first form',:argl]
-  wi := mkWi('markTran,'WI,form,form')
-  first sig = '_$ => markRepper('per,wi)
-  wi
- 
-markRepper(key,form) == ['REPPER,nil,key,form]
- 
-markDeclaredImport d == markImport(d,true)
-
-markImport(d,:option) ==   --from compFormWithModemap/genDeltaEntry/compImport
-  if CONTAINED('PART,d) then pause d
-  declared? := IFCAR option
-  null d or d = $Representation => nil
-  d is [op,:.] and op in '(Boolean Mapping Void Segment UniversalSegment) => nil
-  string? d or (IDENTP d and stringchar(symbolName d,0) = char '_#) => nil
-  d in '(_$ _$NoValueMode _$EmptyMode Void) => nil
--------=======+> WHY DOESN'T THIS WORK????????????
---if (d' := macroExpand(d,$e)) ~= d then markImport(d',declared?)
-  dom := markMacroTran d
---if IDENTP dom and dom = d and not getmode(dom,$e) then dom := ['MyENUM, d]
-  categoryForm? dom => nil
-  $insideCapsuleFunctionIfTrue => 
-    $localImportStack := insert(dom,$localImportStack)
-    if IFCAR option then $localDeclareStack := insert(dom,$localDeclareStack)
-  if $globalImportStack then
-    $globalImportStack := insert(dom,$globalImportStack)
-    if IFCAR option then $globalDeclareStack := insert(dom,$globalDeclareStack)
-
-markMacroTran name ==     --called by markImport
-  atom name => name
-  u := or/[x for [x,:y] in $globalMacroStack | y = name] => u
-  u := or/[x for [x,:y] in $localMacroStack  | y = name] => u
-  [op,:argl] := name
-  op in '(Record Union) => 
---  pp ['"Cannot find: ",name]
-    name
-  [op,:[markMacroTran x for x in argl]]
-   
-markSetq(originalLet,T) ==                                --for compSetq
-  $convert2NewCompiler => 
-    $coerceList : local := nil
-    ["%LET",form,originalBody] := originalLet
-    id := markLhs form
-    not $insideCapsuleFunctionIfTrue =>
-      $from : local := '"Setq"
-      code := T.expr
-      markEncodeChanges(code,nil)
-      noriginalLet := markSpliceInChanges originalBody
-      if IDENTP id then $domainLevelVariableList := insert(id,$domainLevelVariableList) 
-      nlet := ["%LET",id,noriginalLet]
-      entry := [originalLet,:nlet]
-      $importStack := [nil,:$importStack]
-      $freeStack   := [nil,:$freeStack]
-      capsuleStack('"Setq", entry)
---    [markKillMI T.expr,:rest T]
-      [code,:rest T]
-    if MEMQ(id,$domainLevelVariableList) then 
-      $markFreeStack := insert(id,$markFreeStack)
-    T
-  T
-
-markCapsuleExpression(originalExpr, T) ==
-  $coerceList: local := nil
-  $from: local := '"Capsule expression"
-  code := T.expr
-  markEncodeChanges(code, nil)
-  noriginal := markSpliceInChanges originalExpr
-  nexpr := noriginal
-  entry := [originalExpr,:nexpr]
-  $importStack := [nil,:$importStack]
-  $freeStack   := [nil,:$freeStack]
-  capsuleStack('"capsuleExpression", entry)
-  [code,:rest T]
-
-markLhs x ==
-  x is [":",a,.] => a
-  atom x => x
-  x                  --ignore
-
-capsuleStack(name,entry) ==
---  if $monitorWI then
---    sayBrightlyNT ['"Stacking ",name,'": "]
---    pp entry
-  $capsuleStack := [COPY entry,:$capsuleStack] 
-  $predicateStack := [$predl, :$predicateStack]
-  signature := 
-    $insideCapsuleFunctionIfTrue => $signatureOfForm
-    nil
-  $signatureStack := [signature, :$signatureStack]
- 
-foobar(x) == x 
- 
-foobum(x) == x         --from doIT
-
-
---======================================================================
---        Capsule Function Transformations
---======================================================================
---called from compDefineCapsuleFunction
-markChanges(originalDef,T,sig) == 
-  $convert2NewCompiler => 
-    if $insideCategoryIfTrue and $insideFunctorIfTrue then
-      originalDef := markCatsub(originalDef)
-      T := [markCatsub(T.expr),
-             markCatsub(T.mode),T.env]
-      sig := markCatsub(sig)
-      $importStack := markCatsub($importStack)
---  T := coerce(T,first sig)         ---> needed to wrap a "per" around a Rep type
-    code := T.expr
-    $e : local := T.env
-    $coerceList : local := nil
-    $hoho := code
-    ['DEF,form,.,.,originalBody] := originalDef
-    signature := markFindOriginalSignature(form,sig)
-    $from : local := '"compDefineFunctor1"
-    markEncodeChanges(code,nil)
-    frees := 
-      null $markFreeStack => nil
-      [['free,:mySort removeDuplicates $markFreeStack]]
-    noriginalBody := markSpliceInChanges originalBody
-    nbody := augmentBodyByLoopDecls noriginalBody
-    ndef := ['DEF,form,signature,[nil for x in form],nbody]
-    $freeStack   := [frees,:$freeStack]
-    --------------------> import code <------------------
-    imports      := $localImportStack
-    subtractions := union($localDeclareStack,union($globalDeclareStack,
-                      union($globalImportStack,signature)))
-    if $insideCategoryIfTrue and $insideFunctorIfTrue then
-      imports      := markCatsub imports
-      subtractions := markCatsub subtractions
-    imports      := [markMacroTran d for d in imports]
-    subtractions := [markMacroTran d for d in subtractions]
-    subtractions := union(subtractions, getImpliedImports imports)
-    $importStack := [reduceImports SETDIFFERENCE(imports,subtractions),:$importStack]
-    -------------------> import code <------------------
-    entry := [originalDef,:ndef]
-    capsuleStack('"Def",entry)
-  nil
-
-reduceImports x ==
-  [k, o] := reduceImports1 x
-  SETDIFFERENCE(o,k)
-
-reduceImports1 x ==
-  kills := nil
-  others:= nil
-  for y in x repeat 
-    y is ['List,a] =>
-      [k,o] := reduceImports1 [a]
-      kills := union(y,union(k,kills))
-      others:= union(o, others)
-    rassoc(y,$globalImportDefAlist) => kills := insert(y,kills)
-    others := insert(y, others)
-  [kills, others]
-
-getImpliedImports x ==
-  x is [[op,:r],:y] => 
-    op in '(List Enumeration) => union(r, getImpliedImports y)
-    getImpliedImports y
-  nil  
- 
-augmentBodyByLoopDecls body ==
-  null $localLoopVariables => body
-  lhs := 
-    $localLoopVariables is [.] => first $localLoopVariables
-    ['LISTOF,:$localLoopVariables]
-  form := [":",lhs,$SmallInteger]
-  body is ['SEQ,:r] => ['SEQ,form,:r]
-  ['SEQ,form,['exit,1,body]]
-    
-markFindOriginalSignature(form,sig) ==
-  target := $originalTarget
-  id     := opOf form
-  n      := #form
-  cat :=
-    target is ['Join,:.,u] => u
-    target
-  target isnt ['CATEGORY,.,:v] => sig
-  or/[sig' for x in v | x is ['SIGNATURE,=id,sig'] and #sig' = n 
-    and markFindCompare(sig',sig)] or sig
-
-markFindCompare(sig',sig) ==
-  macroExpand(sig',$e) = sig
-       
---======================================================================
---        Capsule Function: Encode Changes on $coerceList
---======================================================================
---(WI a b) mean Was a Is b
---(WI c (WI d e) b) means Was d Is b
---(AUTOxxx p q (WI a b))     means a::q for reason xxx=SUBSET or HARD
---(ATOM nil (REPLACE (x)) y) means replace y by x
---(COLON :: A B)             means rewrite as A :: B  (or A @ B or A : B)
---(LAMBDA nil (REPLACE fn) y)means replace y by fn
---(REPPER nil per form)      means replace form by per(form)
---(FREESI nil (REPLACE decl) y) means replace y by fn
-
-markEncodeChanges(x,s) ==
---x is a piece of target code
---s is a stack [a, b, ..., c] such that a < b < ...
---calls ..markPath.. to find the location of i in a in c (the orig expression),
---  where i is derived from x (it is the source component of x);
---  if markPath fails to find a path for i in c, then x is wrong!
-
---first time only: put ORIGNAME on property list of operators with a ; in name
-  if null s then markOrigName x
-  x is [fn,a,b,c] and MEMQ(fn,$markChoices) =>
-    x is ['ATOM,.,['REPLACE,[y],:.],:.] and y in '(false true) => 'skip
-    ---------------------------------------------------------------------- 
-    if c then   ----> special case: DON'T STACK A nil!!!!
-      i := getSourceWI c
-      t := getTargetWI c
-  --  sayBrightly ['"=> ",i,'" ---> "]
-  --  sayBrightly ['" from ",a,'" to ",b]
-      s := [i,:s]
---    pp '"==========="
---    pp x
-    markRecord(a,b,s)
-    markEncodeChanges(t,s)
-  x is ['WI,p,q] or x is ['MI,p,q] =>
-    i := getSourceWI p
-    r := getTargetWI q
-    r is [fn,a,b,c] and MEMQ(fn,$markChoices) =>
-      t := getTargetWI c
---      sayBrightly ['"==> ",i,'" ---> "]
---      sayBrightly ['" from ",a,'" to ",b]
-      s := [i,:s]
-      markRecord(a,b,s)
-      markEncodeChanges(t,s)
-    i is [fn,:.] and fn in '(REPEAT COLLECT) => markEncodeLoop(i,r,s)
-    t := getTargetWI r
-    markEncodeChanges(t,[i,:s])
-  x is ['PROGN,a,:.] and s is [[op,:.],:.] and op in '(REPEAT COLLECT) =>
-    markEncodeChanges(a,s)
-  x is ['TAGGEDreturn,a,[y,:.]] => markEncodeChanges(y,s)
-  x is ['CATCH,a,y] => markEncodeChanges(y,s)
-  atom x => nil
---  first x = IFCAR IFCAR s =>
---    for y in x for r in first s repeat markEncodeChanges(y,[r,:s])
-  for y in x repeat markEncodeChanges(y,s)
-
-markOrigName x ==
-  x is [op,:r] =>
-    op = 'TAGGEDreturn and x is [.,a,[y,:.]] => markOrigName y
-    for y in r repeat markOrigName y     
-    IDENTP op =>
-      s := symbolName op
-      k := charPosition(char '_;, s, 0)
-      k > MAXINDEX s => nil
-      origName := makeSymbol subString(s, k + 1)
-      property(op, 'ORIGNAME) := origName
-      REMPROP(op,'PNAME)
-    markOrigName op
-  nil
-
-markEncodeLoop(i, r, s) ==  
-  [.,:itl1, b1] := i   --op is REPEAT or COLLECT
-  if r is ["%LET",.,a] then r := a
-  r is [op1,:itl2,b2] and op1 in '(REPEAT COLLECT) =>
-    for it1 in itl1 for it2 in itl2 repeat markEncodeChanges(it2,[it1,:s])
-    markEncodeChanges(b2, [b1,:s])
-  markEncodeChanges(r, [i,:s])
-  
-getSourceWI x ==
---Subfunction of markEncodeChanges
-  x is ['WI,a,b] or x is ['MI,a,b] =>
-    a is ['WI,:.] or a is ['MI,:.] => getSourceWI a
-    markRemove a
-  markRemove x
-
-markRemove x ==
-  atom x => x
-  x is ['WI,a,b] or x is ['MI,a,b]  => markRemove a
-  x is [fn,a,b,c] and MEMQ(fn,$markChoices) => 
-    markRemove c
---x is ['TAGGEDreturn,:.] => x
-  x is ['TAGGEDreturn,a,[x,m,t]] => ['TAGGEDreturn,a,[markRemove x,m,t]]
-  [markRemove y for y in x]
- 
-getTargetWI x ==
---Subfunction of markEncodeChanges
-  x is ['WI,a,b] or x is ['MI,a,b] => getTargetWI b
-  x is ['PART,.,a] => getTargetWI a
-  x
-
-$shout1 := false
-$shout2 := false
-  
-markRecord(source,target,u) ==
---Record changes on $coerceList
-  if source='_$ and target='Rep then 
-    target := 'rep
-  if source='Rep and target='_$ then
-    target := 'per
-  item := first u
-  integer? item or item = $One or item = $Zero => nil
-  item is ["-",a] and (integer? a or a = $One or a = $Zero) => nil
-  string? item => nil
-  item is [op,.,t] and op in '( _:_: _@ _pretend)
-    and macroExpand(t,$e) = target => nil
-  $source: local := source
-  $target: local := target
-  path := markPath u or return nil       -----> early exit
-  path := 
-    path = 0 => nil     --wrap the WHOLE thing
-    path
-  if $shout2 then
-      pp '"========="
-      pp path
-      ipath := reverse path
-      for x in u repeat
-        pp x
-        ipath => 
-           pp first ipath
-           ipath := rest ipath
-  entry := [source,target,:path]
-  if $monitorCoerce then
-    sayBrightlyNT ['"From ",$from,'": "]
-    pp entry
-  $coerceList := [COPY entry,:$coerceList]
-
---======================================================================
---  Capsule Function: Find dewey decimal path across a list
---======================================================================
-markPath u ==        --u has nested structure: u0 < u1 < u2 ...
-  whole := last u
-  part  := first u
-  $path := u
-  u is [.] => 0      --means THE WHOLE THING
-  v := reverse markPath1 u
---  pp '"======mark path======"
---  foobar v
---  pp v
---  pp markKillAll part
---  pp markKillAll whole
---  pp $source
---  pp $target
-  null v => nil
-  $pathStack := [[v,:u],:$pathStack]
---  pp '"----------------------------"
---  ppFull v
---  pp '"----------------------------"
-  v
-
-markPath1 u ==   
--- u is a list [a, b, ... c]
--- This function calls markGetPath(a,b) to find the location of a in b, etc.
--- The result is the successful path from a to c
--- A error printout occurs if no such path can be found
-  u is [a,b,:r] =>  -- a < b < ...
-    a = b => markPath1 rest u       ---> allow duplicates on path
-    path := markGetPath(a,b) or return nil    -----> early exit
-    if $shout1 then
-      pp '"========="
-      pp path
-      pp a
-      pp b
-    [:first path,:markPath1 rest u]
-  nil
-
-$pathErrorStack := nil
-
-markGetPath(x,y) ==    -- x < y  ---> find its location
-  u := markGetPaths(x,y) 
-  u is [w] => u
-  $amb := [u,x,y]
-  key :=
-    null u => '"no match"
-    '"ambiguous"
-  sayBrightly ['"-----",key,'"--------"]
-  $pathErrorStack := [$path,:$pathErrorStack]
-  pp "CAUTION: this can cause RPLAC errors"
-  pp "Paths are: "
-  pp u
-  for p in $path for i in 1..3 repeat pp p
-  $x: local := x
-  $y: local := y
-  pp '"---------------------"
-  pp x
-  pp y
-  foobar key
---  pp [key, $amb]
-  null u => [1729] --return something that will surely fail if no path
-  [first u]
-
-markTryPaths() == markGetPaths($x,$y)
-
-markPaths(x,y,s) ==    --x < y; find location s of x in y (initially s=nil)
---NOTES: This location is what it will be in the source program with
---  all PART information removed. 
-  if $shout then
-    pp '"-----"
-    pp x
-    pp y
-    pp s
-  x = y => s         --found it!  exit
-  markPathsEqual(x,y) => s
-  y is [['elt,.,op],:r] and (u := markPaths(x,[op,:r],s)) => u
-  x is ['elt,:r] and (u := markPaths(r,y,s)) => u
-  y is ['elt,:r] and (u := markPaths(x,r,s)) => u
-  x is [op,:u] and op in '(LIST VECTOR) and y is ['construct,:v] and
-    (p := markPaths(['construct,:u],y,s)) => p
-  atom y => nil
-  y is ["%LET",a,b] and IDENTP a => 
-    markPaths(x,b,markCons(2,s)) --and IDENTP x
-  y is ["%LET",a,b] and GENSYMP a => markPaths(x,b,s)     --for loops
-  y is ['IF,a,b,:.] and GENSYMP a => markPaths(x,b,s)   --for loops
-  y is ['IF,a,b,c] and (p := (markPathsEqual(x,b) => 2;
-                              markPathsEqual(x,c) => 3;
-                              nil)) => markCons(p,s)
---  x is ['exit,a,b] and y is ['exit,a,c] and (p := mymy markPathsEqual(b,c)) =>
---     markCons(p,s)
-  y is ['%call,:r] => markPaths(x,r,s)                 --for loops
-  y is [fn,m,y1] and fn in '(PART CATCH THROW) => markPaths(x,y1,s) or
-    append/[markPaths(x,u,markCons(i,s)) for u in y1 for i in 0..]
-  append/[markPaths(x,u,markCons(i,s)) for u in y for i in 0..]
-
-mymy x == x
-
-markCons(i,s) == [[i,:x] for x in s]
-
-markPathsEqual(x,y) ==
-  x = y => true
-  x is ["::",.,a] and y is ["::",.,b] and 
-    a = $Integer and b = $NonNegativeInteger => true
-  y is [fn,.,z] and fn in '(PART CATCH THROW) and markPathsEqual(x,z) => true
-  y is ["%LET",a,b] and GENSYMP a and markPathsEqual(x,b) => true
-  y is ['IF,a,b,:.] and GENSYMP a => markPathsEqual(x,b)  -------> ??? 
-  y is ['%call,:r] => markPathsEqual(IFCDR x,r)
-  x is ['REDUCE,.,.,c,:.] and c is ['COLLECT,:u] and 
-    y is ['PROGN,.,repeet,:.] and repeet is ['REPEAT,:v] => markPathsEqual(u,v)
-  atom y or atom x => 
-    IDENTP y and IDENTP x and y = GETL(x,'ORIGNAME)  => true --> see 
---  IDENTP y and IDENTP x and anySubstring?(symbolName y,symbolName x,0) => true
-    IDENTP y and (z := markPathsMacro y) => markPathsEqual(x,z)
-    false
-  "and"/[markPathsEqual(u,v) for u in x for v in y]
-
-markPathsMacro y ==
-  LASSOC(y,$localMacroStack) or LASSOC(y,$globalMacroStack)
---======================================================================
---      Capsule Function: DO the transformations
---======================================================================
---called by markChanges (inside capsule), markSetq (outside capsule)
-$hohum := false
-markSpliceInChanges body ==
---  pp '"before---->"
---  pp $coerceList
-  $coerceList := reverse SORTBY('CDDR,$coerceList)
---  pp '"after----->"
---  pp $coerceList
-  $cl := $coerceList
---if CONTAINED('REPLACE,$cl) then hoho $cl
-  body :=
-    body is ['WI,:.] => 
---      hehe body
-      markKillAll body
-    markKillAll body
---NOTE!! Important that $coerceList be processed in this order
---since it must operate from the inside out. For example, a progression
---u --> u::Rep --> u :: Rep :: $ can only be correct. Here successive
---entries can have duplicate codes
-  for [code,target,:loc] in $coerceList repeat
-    $data: local := [code, target, loc]
-    if $hohum then 
-      pp '"---------->>>>>"
-      pp $data
-      pp body
-      pp '"-------------------------->"
-    body := markInsertNextChange body
-  body
-
---pause() == 12
-markInsertNextChange body ==
---  if BOUNDP '$sayChanges and $sayChanges then 
---    sayBrightlyNT '"Inserting change: "
---    pp $data
---    pp body
---    pause()
-  [code, target, loc] := $data
-  markInsertChanges(code,body,target,loc)
-
-markInsertChanges(code,form,t,loc) ==
---RePLACe x at location "loc" in form as follows:
---  t is ['REPLACE,r]:   by r
---  t is 'rep/per:       by (rep x) or (per x)
---  code is @ : ::       by (@ x t) (: x t) (:: x t)
---  code is Lisp         by (pretend form t)
---  otherwise            by (:: form t)
-  loc is [i,:r] =>
-    x := form
-    for j in 0..(i-1) repeat 
-      if cons? x then x := rest x
-    atom x => 
-        pp '"Translator RPLACA error"
-        pp $data
-        foobum form
-        form
-    if $hohum then pp [i, '" >>> ", x]
-    SETQ($CHANGE,COPY x)
-    if x is ['elt,:y] and r then x := y
-    x.first := markInsertChanges(code,first x,t,rest loc)
-    chk(x,100)
-    form
---  pp ['"Making change: ",code,form,t]
-  t is ['REPLACE,r] => SUBST(form,"##1",r)
-  form is ['SEQ,:y,['exit,1,z]] => 
-    ['SEQ,:[markInsertSeq(code,x,t) for x in y],
-      ['exit,1,markInsertChanges(code,z,t,nil)]]
-  code = '_pretend or code = '_: => 
-    form is [op,a,.] and op in '(_@ _: _:_: _pretend) => ['_pretend,a,t]
-    [code,form,t]
-  code in '(_@ _:_: _pretend) =>  
-    form is [op,a,b] and op in '(_@ _: _:_: _pretend) =>
-      op in '(_: _pretend) => form
-      op = code and b = t => form
-      markNumCheck(code,form,t)
-    integer? form and MEMQ(opOf t,$markPrimitiveNumbers) => ['_@,form,t]
-    [code,form,t]
-  code in '(_@ _:_: _:) and form is [op,a] and 
-    (op='rep and t = 'Rep or op='per and t = "$") => form
-  code = 'Lisp => 
-    t = $EmptyMode => form
-    ["pretend",form,t]
-  t in '(rep per) => 
-    t = 'rep and form is ["per",:.] => second form
-    t = 'per and form is ["rep",:.] => second form
-    [t,form]
-  code is [op,x,t1] and op in '(_@ _: _:_: _pretend) and t1 = t => form
-  integer? form and MEMQ(opOf t,$markPrimitiveNumbers) => ['_@,form,t]
-  markNumCheck("::",form,t)
-
-markNumCheck(op,form,t) ==
-  op = "::" and opOf t in '(Integer) =>
-     s := form = $One and 1 or form = $Zero and 0 => ['DOLLAR, s , t]
-     integer? form                   => ["@", form, t]
-     form is ["-", =$One]            => ['DOLLAR, -1,   t]
-     form is ["-", n] and integer? n => ["@", MINUS n, t]
-     [op, form, t]
-  [op,form,t]
-
-markInsertSeq(code,x,t) ==
-  x is ['exit,y] => ['exit,markInsertChanges(code,y,t,nil)]
-  atom x => x
-  [markInsertSeq(code,y,t) for y in x]
---======================================================================
---               Prettyprint of translated program
---======================================================================
-markFinish(body,T) ==
---called by compDefineCategory2, compDefineFunctor1 (early jumpout)
-  SETQ($cs,$capsuleStack)
-  SETQ($ps,$predicateStack)
-  SETQ($ss,$signatureStack)
-  SETQ($os,$originalTarget)
-  SETQ($gis,$globalImportStack)
-  SETQ($gds,$globalDeclareStack)
-  SETQ($gms,$globalMacroStack)
-  SETQ($as, $abbreviationStack)
-  SETQ($lms,$localMacroStack)
-  SETQ($map,$macrosAlreadyPrinted)
-  SETQ($gs,$importStack)
-  SETQ($fs,$freeStack)
-  SETQ($b,body)
-  SETQ($t,T)
-  SETQ($e,T.env)
---if $categoryTranForm then SETQ($t,$categoryTranForm . 1)
-  atom CDDR T => systemError()
-  T.rest.rest.first := $EmptyEnvironment
-  chk(CDDR T,101)
-  markFinish1()
-  T
-
-reFinish() ==
-  $importStack := $gs
-  $freeStack := $fs
-  $capsuleStack := $cs
-  $predicateStack := $ps
-  $signatureStack := $ss
-  $originalTarget := $os
-  $globalMacroStack := $gms
-  $abbreviationStack:= $as
-  $globalImportStack := $gis
-  $globalDeclareStack := $gds
-  $localMacroStack := $lms
-  $macrosAlreadyPrinted := $map
-  $abbreviationsAlreadyPrinted := nil
-  markFinish1()
- 
-markFinish1() ==
-  body := $b
-  T    := $t
-  $predGensymAlist: local := nil
---$capsuleStack := $cs
---$predicateStack := $ps
-  form := T. expr
-  ['Mapping,:sig] := T.mode
-  if $insideCategoryIfTrue and $insideFunctorIfTrue then
-     $importStack       := [delete($categoryNameForDollar,x) for x in $importStack]
-     $globalImportStack := delete($categoryNameForDollar,$globalImportStack)
-  $commonImports : local := getCommonImports()
-  globalImports := 
-    reverse orderByContainment removeDuplicates [:$commonImports,:$globalImportStack]
-  $finalImports: local := SETDIFFERENCE(globalImports,$globalDeclareStack)
-  $capsuleStack := 
-    [mkNewCapsuleItem(freepart,imports,x) for freepart in $freeStack 
-       for imports in $importStack for x in $capsuleStack] 
-  $extraDefinitions := combineDefinitions()
-  addDomain := nil
-  initbody :=
-    $b is ['add,a,b] => 
-      addDomain := a
-      b
-    $b is [op,:.] and constructor? op =>
-      addDomain := $b
-      nil
-    $b
-  body := markFinishBody initbody
-  importCode := [['import,x] for x in $finalImports]
-  leadingMacros := markExtractLeadingMacros(globalImports,body)
-  body := markRemImportsAndLeadingMacros(leadingMacros,body)
-  initcapsule := 
-    body => ['CAPSULE,:leadingMacros,:importCode,:body]
-    nil
-  capsule := 
---  null initcapsule => addDomain
-    addDomain => ['add,addDomain,initcapsule]
-    initcapsule
-  nsig :=
-    $categoryPart => sig
-    ['Type,:rest sig]
-  for x in reverse $abbreviationStack |not member(x,$abbreviationsAlreadyPrinted) repeat 
-     markPrintAbbreviation x
-     $abbreviationsAlreadyPrinted := insert(x,$abbreviationsAlreadyPrinted)
-  for x in reverse $globalMacroStack|not member(x,$macrosAlreadyPrinted) repeat
-    $def := ['MDEF,first x,'(NIL),'(NIL),rest x]
-    markPrint(true)
-    $macrosAlreadyPrinted := insert(x,$macrosAlreadyPrinted)
-  if $insideCategoryIfTrue and not $insideFunctorIfTrue then
-    markPrintAttributes $b
-  $def := ['DEF,form,nsig,[nil for x in form],capsule]
-  markPrint()
-
-stop x == x
-
-getNumberTypesInScope() ==
-  union([y for x in $localImportStack | MEMQ(y := opOf x,$markNumberTypes)], 
-        [y for x in $globalImportStack| MEMQ(y := opOf x,$markNumberTypes)])
-
-getCommonImports() ==
-  importList := [x for x in $importStack for y in $capsuleStack |
-                   KAR KAR y = 'DEF]
-  hash := hashTable 'EQUAL
-  for x in importList repeat
-    for y in x repeat HPUT(hash,y,1 + (HGET(hash,y) or 0))
-  threshold := FLOOR (.5 * #importList)
-  [x for x in HKEYS hash | HGET(hash,x) >= threshold]
-  
-markPrintAttributes addForm ==
-  capsule :=
-    addForm is ['add,a,:.] => 
-      a is ['CATEGORY,:.] => a
-      a is ['Join,:.] => first lastNode a
-      first lastNode addForm
-    addForm
-  if capsule is ['CAPSULE,:r] then
-    capsule := first lastNode r
-  capsule isnt ['CATEGORY,.,:lst] => nil
-  for x in lst | x is ['ATTRIBUTE,att] repeat
-    markSay(form2String att)
-    markSay('": Category == with")
-    markTerpri()
-    markTerpri()
-
-getCommons u ==
-  common := KAR u
-  while common and u is [x,:u] repeat common := intersection(x,common)
-  common
-
-markExtractLeadingMacros(globalImports,body) ==
-  [x for x in body | x is ['MDEF,[a],:.] and member(a,globalImports)]
-  
-markRemImportsAndLeadingMacros(leadingMacros,body) ==
-  [x for x in body | x isnt ['import,:.] and not member(x,leadingMacros)]
-
-mkNewCapsuleItem(frees,i,x) ==
-  [originalDef,:ndef] := x
-  imports := reverse orderByContainment removeDuplicates SETDIFFERENCE(i,$finalImports)
-  importPart := [["import",d] for d in imports]
-  nbody := 
-    ndef is ["%LET",.,x] => x
-    ndef is ['DEF,.,.,.,x] => x
-    ndef
-  newerBody :=
-    newPart := [:frees,:importPart] =>
-      nbody is ['SEQ,:y] => ['SEQ,:newPart,:y]
-      ['SEQ,:newPart,['exit,1,nbody]]
-    nbody
-  newerDef := 
-    ndef is ["%LET",a,x] => ["%LET",a,newerBody]
-    ndef is ['DEF,a,b,c,x] => ['DEF,a,b,c,newerBody]
-    newerBody
-  entry := [originalDef,:newerDef]
-  entry
-
-markFinishBody capsuleBody ==
-  capsuleBody is ['CAPSULE,:itemlist] =>
-    if $insideCategoryIfTrue and $insideFunctorIfTrue then
-       itemlist := markCatsub itemlist
-    [:[markFinishItem x for x in itemlist],:$extraDefinitions]
-  nil
-
-markCatsub x == SUBST("$",$categoryNameForDollar,x)
- 
-markFinishItem x ==
-  $macroAlist : local := [:$localMacroStack,:$globalMacroStack]
-  if $insideCategoryIfTrue and $insideFunctorIfTrue then
-    $macroAlist := [["$",:$categoryNameForDollar],:$macroAlist]
-  x is ['DEF,form,.,.,body] =>
-    "or"/[new for [old,:new] in $capsuleStack |
-        old is ['DEF,oform,.,.,obody] 
-          and markCompare(form,oform) and markCompare(body,obody)] or
-            pp '"------------MISSING----------------"
-            $f := form
-            $b := body
-            newform := "or"/[x for [old,:new] in $capsuleStack | 
-              old is ['DEF,oform,.,.,obody] and oform = $f]
-            $ob:= (newform => obody; nil)
-            pp $f
-            pp $b
-            pp $ob
-            foobum x
-            pp x
-            x
-  x is ["%LET",lhs,rhs] =>
-    "or"/[new for [old,:new] in $capsuleStack |
-        old is ["%LET",olhs,orhs]
-          and markCompare(lhs,olhs) and markCompare(rhs,orhs)]
-            or x
-  x is ['IF,p,a,b] => ['IF,p,markFinishItem a,markFinishItem b]
-  x is ['SEQ,:l,['exit,n,a]] =>
-    ['SEQ,:[markFinishItem y for y in l],['exit,n,markFinishItem a]]
-  "or"/[new for [old,:new] in $capsuleStack | markCompare(x,old)] =>
-    new
-  x
- 
-markCompare(x,y) == 
-  markKillAll(SUBLIS($macroAlist,x)) = markKillAll(SUBLIS($macroAlist,y))
-
-diffCompare(x,y) == diff(SUBLIS($macroAlist,x),markKillAll(SUBLIS($macroAlist,y)))
- 
---======================================================================
---               Print functions
---======================================================================
-markPrint(:options) ==   --print $def 
-  noTrailingSemicolonIfTrue := IFCAR options
---$insideCategoryIfTrue and $insideFunctorIfTrue => nil
-  $DEFdepth : local := 0
-  [op,form,sig,sclist,body] := markKillAll $def
-  if $insideCategoryIfTrue then
-    if op = 'DEF and $insideFunctorIfTrue then
-      T := $categoryTranForm . 1
-      form := T . expr
-      sig  := rest (T . mode)
-    form := SUBLISLIS(rest markConstructorForm opOf form,
-              $TriangleVariableList,form)
-    sig  := SUBLISLIS(rest markConstructorForm opOf form,
-              $TriangleVariableList,sig)
-  nbody := body
-  if $insideCategoryIfTrue then
-    if $insideFunctorIfTrue then
-      nbody := replaceCapsulePart body
-      nbody :=
-        $catAddForm => ['withDefault, $catAddForm, nbody]
-        nbody
-    else      
-      ['add,a,:r] := $originalBody
-      xtraLines := 
-        "append"/[[strconc(name,'": Category == with"),'""] 
-           for name in markCheckForAttributes a]
-      nbody :=
-        $originalBody is ['add,a,b] =>
-          b isnt ['CAPSULE,:c] => error(false)
-          [:l,x] := c
-          [:markTranCategory a,['default,['SEQ,:l,['exit,1,x]]]]
-        markTranCategory $originalBody      
-  signature :=
-    $insideFunctorIfTrue => [markTranJoin $originalTarget,:rest sig]
-    $insideCategoryIfTrue => ['Category,:rest sig]
-    '(NIL)
-  $bootForm:= 
-    op = 'MDEF => [op,form,signature,sclist,body]
-    [op,form,signature,sclist,nbody]
-  bootLines:= lisp2Boot $bootForm
-  $bootLines:= [:xtraLines,:bootLines]
-  moveAroundLines()
-  markSay $bootLines
-  markTerpri()
-  'done
-
-replaceCapsulePart body == 
-  body isnt ['add,['CAPSULE,:c]] => body
-  $categoryTranForm . 0 isnt ['add,exports,['CAPSULE,:.]] => error(false) 
-  [:l,x] := c
-  [:markTranCategory exports,['default,['SEQ,:l,['exit,1,x]]]]
-
-foo(:x) == 
- arg := IFCAR x or $bootForm
- markSay lisp2Boot arg
-
-markPrintAbbreviation [kind,a,:b] == 
-  markSay '"--)abbrev "
-  markSay kind
-  markSay '" "
-  markSay a
-  markSay '" "
-  markSay b
-  markTerpri()
-
-markSay s == 
-  cons? s =>
-    for x in s repeat
-      (markSay(lispStringList2String x); markTerpri())
-  PRINTEXP s
-  if $outStream then PRINTEXP(s,$outStream)
-
-markTerpri() ==
-  TERPRI()
-  if $outStream then TERPRI($outStream)
-
-markTranJoin u ==                      --subfunction of markPrint
-  u is ['Join,:.] => markTranCategory u
-  u
-
-markTranCategory cat ==               
-  cat is ['CATEGORY,:.] => cat
-  cat is ['Join,:r] =>
-    r is [:s,b] and b is ['CATEGORY,k,:t] => ['CATEGORY,k,:s,:markSigTran t] 
-    ['CATEGORY,'domain,:markSigTran r]
-  ['CATEGORY,'domain,cat]
-
-markSigTran t == [markElt2Apply x for x in t]
-
-markElt2Apply x ==
-  x is ["SIGNATURE", "elt", :r] => ['SIGNATURE, 'apply, :r]
-  x
-
-markCheckForAttributes cat ==          --subfunction of markPrint
-  cat is ['Join,:r] => markCheckForAttributes last r
-  cat is ['CATEGORY,.,:r] => [u for x in r | u := fn(x)] where fn(x) ==
-    x is ['ATTRIBUTE,form,:.] => 
-      name := opOf form
-      MEMQ(name,$knownAttributes) => nil
-      $knownAttributes := [name,:$knownAttributes]
-      name
-    nil
-  nil
-
---======================================================================
---        Put in PARTs in code
---======================================================================
-$partChoices := '(construct IF)
-$partSkips   := '(CAPSULE with add)
-unpart x ==
-  x is ['PART,.,y] => y
-  x
-
-markInsertParts df ==
-  $partNumber := 0
-  ["DEF",form,a,b,body] := df
---if form is [op,:r] and (u := LASSOC(op,$opRenameAlist)) 
---  then form := [u,:r]
-  ['DEF,form,a,b,markInsertBodyParts body]
-  
-markInsertBodyParts u ==
-  u is ['Join,:.] or u is ['CATEGORY,:.] => u
-  u is ['DEF,f,a,b,body] => ['DEF,f,a,b,markInsertBodyParts body]
-  u is ['SEQ,:l,['exit,n,x]] =>
-    ['SEQ,:[markInsertBodyParts y for y in l],
-           ['exit,n,markInsertBodyParts x]]
-  u is [op,:l] and op in '(REPEAT COLLECT) => markInsertRepeat u
-  u is ["%LET",["%Comma",:s],b] =>
-    ["%LET",["%Comma",:[markWrapPart x for x in s]],markInsertBodyParts b]
---u is ["%LET",a,b] and constructor? opOf b => u
-  u is ["%LET",a,b] and a is [op,:.] =>
-    ["%LET",[markWrapPart x for x in a],markInsertBodyParts b]
-  u is [op,a,b] and op in '(add with IN %LET) =>
-    [op,markInsertBodyParts a,markInsertBodyParts b]
-  u is [op,a,b] and op in '(_: _:_: pretend _@) =>
-    [op,markInsertBodyParts a,b]
-  u is [op,a,:x] and op in '(STEP _return _leave exit reduce) => 
-    [op,a,:[markInsertBodyParts y for y in x]]
-  u is [op,:x] and markPartOp? op => [op,:[markWrapPart y for y in x]]
-  u is [op,:.] and constructor? op => u
-  atom u => markWrapPart u
-            ------------           <--------------94/10/11
-  [markInsertBodyParts x for x in u]
-
-markPartOp? op ==
-  MEMQ(op,$partChoices) => true
-  MEMQ(op,$partSkips)   => false
-  if op is ['elt,.,o] then op := o
-  GETL(op,'special) => false
-  true
-
-markWrapPart y ==
-----------------new definition----------94/10/11
-  atom y => 
-    y = '%noBranch => y
-    GETL(y, 'SPECIAL) => y 
-    $partNumber := $partNumber + 1
-    ['PART,$partNumber, y] 
-  ['PART,$partNumber := $partNumber + 1,markInsertBodyParts y]
-
-markInsertRepeat [op,:itl,body] ==
-  nitl := [markInsertIterator x for x in itl]
-  nbody := 
---->IDENTP body => markWrapPart body
-----------------new definition----------94/10/11
-    markInsertBodyParts body
-  [op,:nitl,nbody]
-
-markInsertIterator x ==
-  x is ['STEP,k,:r]  => ['STEP,markWrapPart k,:[markWrapPart x for x in r]]
-  x is ['IN,p,q]     => ['IN,markWrapPart p,markWrapPart q]
-  x is ["|",p]       => ["|",markWrapPart p]
-  x is ['WHILE,p]    => ['WHILE,markWrapPart p]
-  x is ['UNTIL,p]    => ['UNTIL,markWrapPart p]
-  systemError()
-  
---======================================================================
---        Kill Function: MarkedUpCode --> Code
---======================================================================
-
-markKillExpr m ==    --used to kill all but PART information for compilation
-  m is [op,:.] =>
-    op in '(MI WI) => markKillExpr third m
-    op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillExpr fourth m
-    m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillExpr x,m,e]]
-    [markKillExpr x for x in m]
-  m
- 
-markKillButIfs m ==    --used to kill all but PART information for compilation
-  m is [op,:.] =>
-    op = 'IF => m
-    op = 'PART        => markKillButIfs third m
-    op in '(MI WI) => markKillButIfs third m
-    op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillButIfs fourth m
-    m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillButIfs x,m,e]]
-    [markKillButIfs x for x in m]
-  m
- 
-markKillAll m ==      --used to prepare code for compilation
-  m is [op,:.] =>
-    op = 'PART        => markKillAll third m
-    op in '(MI WI) => markKillAll third m
-    op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillAll fourth m
-    m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillAll x,m,e]]
-    [markKillAll x for x in m]
-  m
- 
---======================================================================
---                Moving lines up/down 
---======================================================================
-moveAroundLines() ==
-  changeToEqualEqual $bootLines
-  $bootLines := moveImportsAfterDefinitions $bootLines  
-
-changeToEqualEqual lines ==
---rewrite A := B as A == B whenever A is an identifier and
---                                  B is a constructor name (after macro exp.)
-  origLines := lines
-  while lines is [x, :lines] repeat
-    N := MAXINDEX x
-    (n := charPosition($blank, x, 8)) > N => nil
-    n = 0 => nil
-    not alphabetic? (x . (n - 1)) => nil
-    not substring?('":= ", x, n+1) => nil
-    m := n + 3
-    while (m := m + 1) <= N and alphabetic? (x . m) repeat nil
-    m = n + 2 => nil
-    not upperCase? (x . (n + 4)) => nil
-    word := makeSymbol subString(x, n + 4, m - n - 4)
-    expandedWord := macroExpand(word,$e)
-    not (word in '(Record Union Mapping)
-      or getConstructorFormFromDB opOf expandedWord) => nil
-    sayMessage '"Converting input line:"
-    sayMessage ['"WAS: ", x]
-    x . (n + 1) := char '_= ;
-    sayMessage ['"IS:  ", x]
-    TERPRI()
-  origLines
-    
-sayMessage x == 
-  u := 
-    atom x => ['">> ", x]
-    ['">> ",: x]
-  sayBrightly u
-  
-moveImportsAfterDefinitions lines ==
-  al := nil
-  for x in lines for i in 0.. repeat
-    N := MAXINDEX x
-    m := firstNonBlankPosition x
-    m < 0 => nil
-    ((n := charPosition($blank ,x,1 + m)) < N) and
-      substring?('"== ", x, n+1) => 
-        name := subString(x, m, n - m)
-        defineAlist := [[name, :i], :defineAlist]
-    (k := leadingSubstring?('"import from ",x, 0)) =>
-      importAlist := [[subString(x,k + 12), :i], :importAlist]
---  pp defineAlist
---  pp importAlist
-  for [name, :i] in defineAlist repeat
-    or/[fn for [imp, :j] in importAlist] where fn() ==
-      substring?(name,imp,0) =>
-        moveAlist := [[i,:j], :moveAlist]
-      nil
-  null moveAlist => lines
-  moveLinesAfter(mySort moveAlist, lines)
-
-leadingSubstring?(part, whole, :options) ==
-  after := IFCAR options or 0
-  substring?(part, whole, k := firstNonBlankPosition(whole, after)) => k
-  false
-
-stringIsWordOf?(s, t, startpos) ==
-  maxindex := MAXINDEX t
-  (n := stringPosition(s, t, startpos)) > maxindex => nil
-  wordDelimiter? t . (n - 1)
-  n = maxindex or wordDelimiter? t . (n + #s)
-
-wordDelimiter? c == or/[CHAR_=(c,('"() ,;").i) for i in 0..4]
-
-moveLinesAfter(alist, lines) ==
-  n := #lines
-  acc := nil
-  for i in 0..(n - 1) for x in lines repeat
-    (p :=  ASSOC(i, alist)) and string? rest p => acc := [rest p, x, :acc]
-    (p :=  lookupRight(i, alist)) and (first p) > i => p.rest := x
-    acc := [x, :acc]
-  reverse acc  
-  
-lookupRight(x, al) == 
-  al is [p, :al] =>
-    x = rest p => p
-    lookupRight(x, al)
-  nil
-
---======================================================================
---                Utility Functions
---======================================================================
-  
-ppEnv [ce,:.] ==
-  for env in ce repeat
-    for contour in env repeat
-      pp contour
-    
-diff(x,y) ==
-  for [p,q] in (r := diff1(x,y)) repeat 
-    pp '"------------"
-    pp p
-    pp q
-  #r
- 
-diff1(x,y) ==
-  x = y => nil
-  atom x or atom y => [[x,y]]
-  #x ~= #y => [x,y]
-  append/[diff1(u,v) for u in x for v in y]
-    
-markConstructorForm name ==  --------> same as getConstructorForm
-  name = 'Union   => '(Union  (_: a A) (_: b B))
-  name = 'UntaggedUnion => '(Union A B)
-  name = 'Record  => '(Record (_: a A) (_: b B))
-  name = 'Mapping => '(Mapping T S)
-  getConstructorFromDB name
-
---======================================================================
---                new path functions
---======================================================================
-
-$newPaths := false
-  
-markGetPaths(x,y) == 
-  $newPaths => 
---  res := reverseDown mkGetPaths(x, y)
-    res := mkGetPaths(x, y)
---    oldRes := markPaths(x,y,[nil])
---    if res ~= oldRes then $badStack := [[x, :y], :$badStack]
---    oldRes
-  markPaths(x,y,[nil])
- 
-mkCheck() ==
-  for [x, :y] in removeDuplicates $badStack repeat
-    pp '"!!-------------------------------!!"
-    res := mkGetPaths(x, y)
-    oldRes := markPaths(x, y, [nil])
-    pp x
-    pp y
-    sayBrightlyNT '"new: "
-    pp res
-    sayBrightlyNT '"old: "
-    pp oldRes
-
-reverseDown u == [reverse x for x in u]
-
-mkCheckRun() ==
-  for [x, :y] in removeDuplicates $badStack repeat
-    pp mkGetPaths(x,y)
-
-mkGetPaths(x,y) ==
-  u := removeDuplicates mkPaths(x,y) => getLocationsOf(u,y,nil)
-  nil   
-
-mkPaths(x,y) ==   --x < y; find location s of x in y (initially s=nil)
-  markPathsEqual(x,y) => [y]
-  atom y => nil
-  x is [op, :u] and op in '(LIST VECTOR) and y is ['construct,:v] 
-    and markPathsEqual(['construct,:u],y) => [y]
-  (y is ["%LET",a,b] or y is ['IF,a,b,:.]) and GENSYMP a and markPathsEqual(x,b) => [y]
-  y is ['%call,:r] => 
---  markPathsEqual(x,y1) => [y]
-    mkPaths(x,r) => [y]
-  y is ['PART,.,y1] => mkPaths(x,y1)
-  y is [fn,.,y1] and fn in '(CATCH THROW) =>
---  markPathsEqual(x,y1) => [y]
-    mkPaths(x,y1) => [y]
-  y is [['elt,.,op],:r] and (u := mkPaths(x,[op,:r])) => u
-  x is ['elt,:r] and (u := mkPaths(r,y)) => u
-  y is ['elt,:r] and (u := mkPaths(x,r)) => u
-  append/[u for z in y | u := mkPaths(x,z)]
-
-getLocationsOf(u,y,s) == [getLocOf(x,y,s) for x in u]
-
-getLocOf(x,y,s) ==
-  x = y or x is ['elt,:r] and r = y => s
-  y is ['PART,.,y1] => getLocOf(x,y1,s)
-  if y is ['elt,:r] then y := r
-  atom y => nil
-  or/[getLocOf(x,z,[i, :s]) for i in 0.. for z in y]
-
-  
---======================================================================
---           Combine Multiple Definitions Into One
---======================================================================
-
-combineDefinitions() ==
---$capsuleStack has form   (def1  def2  ..)
---$signatureStack has form (sig1  sig2  ..) where sigI = nil if not a def
---$predicateStack has form (pred1 pred2 ..)
---record in $hash: alist of form [[sig, [predl, :body],...],...] under each op
-  $hash  := MAKE_-HASH_-TABLE()
-  for defs in $capsuleStack 
-    for sig in $signatureStack 
-      for predl in $predicateStack | sig repeat
---      pp [defs, sig, predl]
-        [["DEF",form,:.],:.] := defs
-        item := [predl, :defs]
-        op := opOf form
-        oldAlist := HGET($hash,opOf form) 
-        pair := ASSOC(sig, oldAlist) => pair.rest := [item,:rest pair]
-        HPUT($hash, op, [[sig, item], :oldAlist])
---extract and combine multiple definitions
-  Xdeflist := nil
-  for op in HKEYS $hash repeat
-    $acc: local := nil
-    for [sig,:items] in HGET($hash,op) | (k := #items) > 1 repeat
-      for i in 1.. for item in items repeat
-        [predl,.,:def]    := item
-        ['DEF, form, :.] := def
-        ops := PNAME op
-        opName := makeSymbol(strconc(ops,'"X",STRINGIMAGE i))
-        form.first := opName
---      rplacaSubst(op, opName, def)
-        $acc := [[form,:predl], :$acc]
-      Xdeflist := [buildNewDefinition(op,sig,$acc),:Xdeflist]
-  reverse Xdeflist
-               
-rplacaSubst(x, y, u) == (fn(x, y, u); u) where fn(x,y,u) ==
-  atom u => nil
-  while u is [p, :q] repeat
-    if EQ(p, x) then u.first := y
-    if cons? p then fn(x, y, p)
-    u := q
-    
-buildNewDefinition(op,theSig,formPredAlist) ==
-  newAlist := [fn for item in formPredAlist] where fn() ==
-    [form,:predl] := item
-    pred :=
-      null predl => 'T
-      boolBin simpHasPred markKillAll MKPF(predl,"and") 
-    [pred, :form]
-  --make sure that T comes as last predicate
-  outerPred := boolBin simpHasPred MKPF(ASSOCLEFT newAlist,"or")
-  theForm := CDAR newAlist
-  alist := moveTruePred2End newAlist
-  theArgl := rest theForm
-  theAlist := [[pred, first form, :theArgl] for [pred,:form] in alist]
-  theNils := [nil for x in theForm]
-  thePred :=
-     outerPred in '(T %true) => nil
-     outerPred
-  def := ['DEF, theForm, theSig, theNils, ifize theAlist]
-  value :=
-    thePred => ['IF, thePred, def, '%noBranch]
-    def
-  stop value 
-  value
-
-boolBin x ==
-  x is [op,:argl] =>
-    op in '(AND OR) and argl is [a, b, :c] and c => boolBin [op, boolBin [op, a, b], :c]
-    [boolBin y for y in x]
-  x
-
-ifize [[pred,:value],:r] ==
-  null r => value
-  ['IF, pred, value, ifize r]
-  
-moveTruePred2End alist ==
-  truthPair := or/[pair for pair in alist | pair is ["T",:.]] =>
-    [:delete(truthPair, alist), truthPair]      
-  [:a, [lastPair, lastValue]] := alist
-  [:a, ["T", lastValue]]
-
-PE e ==
-  for x in CAAR e for i in 1.. repeat
-    ppf [i, :x]
-
-ppf x ==
-  _*PRETTYPRINT_* : local := true
-  PRINT_-FULL x
-
-
---%
-for x in [["%LET", :"compSetq"],_
-          ["Join", :"compJoin"],_
-          ["Record", :"compCat"],_
-          ["Union", :"compCat"],_
-          ["_:", :"compColon"],_
-          ["_:_:", :"compCoerce"],_
-          ["CAPSULE", :"compCapsule"],_
-          ["has", :"compHas"],_
-          ["is", :"compIs"],_
-          ["add", :"compAdd"],_
-          ["CONS", :"compCons"],_
-          ["IF", :"compIf"],_
-          ["exit", :"compExit"],_
-          ["return", :"compReturn"],_
-          ["return", :"compLeave"],_
-          ["elt", :"compElt"],_
-          ["DEF", :"compDefine"],_
-          ["MDEF", :"compMacro"],_
-          ["SubsetCategory", :"compSubsetCategory"],_
-          ["SubDomain", :"compSubDomain"],_
-          ["case", :"compCase"],_
-          ["RecordCategory", :"compConstructorCategory"],_
-          ["ListCategory", :"compConstructorCategory"],_
-          ["VectorCategory", :"compConstructorCategory"],_
-          ["UnionCategory", :"compConstructorCategory"],_
-          ["CATEGORY", :"compCategory"],_
-          ["COLLECT", :"compRepeatOrCollect"],_
-          ["COLLECTV", :"compCollectV"],_
-          ["REPEAT", :"compRepeatOrCollect"],_
-          ["REDUCE", :"compReduce"],_
-          ["where", :"compWhere"],_
-          ["_|", :"compSuchthat"],_
-          ["construct", "compConstruct"],_
-          ["SEQ", :"compSeq"],_
-          ["SETQ", :"compSetq"],_
-          ["VECTOR", :"compVector"]] repeat
-  property(first x, 'special) := rest x
diff --git a/src/interp/nspadaux.lisp b/src/interp/nspadaux.lisp
deleted file mode 100644
index 99f7dd50..00000000
--- a/src/interp/nspadaux.lisp
+++ /dev/null
@@ -1,119 +0,0 @@
-;; Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-;; All rights reserved.
-;; Copyright (C) 2007-2008, 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-module "sys-macros")
-(in-package "BOOT")
-
-(defvar |$DEFdepth| 0)
-(defvar |$localMacroStack| nil)
-(defvar |$globalMacroStack| nil)
-(defvar |$abbreviationStack| nil)
-(defvar |$knownAttributes| nil "cumulative list of known attributes of a file") 
-
-(defparameter |$underscoreChar| (|char| '_))
-(defvar |$back| nil) 
-
-(defparameter |$markChoices| '(ATOM COLON LAMBDA AUTOSUBSET AUTOHARD AUTOREP REPPER FREESI RETRACT))
-(defparameter |$convert2NewCompiler| 'T)
-(defparameter |$AnalyzeOnly| NIL)
-(defparameter |$categoryPart| 'T)
-(defparameter |$insideCAPSULE| nil)
-(defparameter |$insideEXPORTS| nil)
-(defparameter |$originalSignature| nil)
-(defparameter |$insideDEF| nil)
-(defparameter |$insideTypeExpression| nil)
-(defparameter |$spadTightList| '(\.\. \# \'  \:\  \: \:\:))
-
-(defparameter |$PerCentVariableList| '(%1 %2 %3 %4 %5 %6 %7 %8 %9 %10))
-
-(mapcar #'(lambda (X) (MAKEPROP (CAR X) 'SPECIAL (CADR X)))
-        '((PART |compPART|)
-          (WI |compWI|)
-          (MI |compWI|)))
-        
-(mapcar #'(lambda (X) (MAKEPROP (CAR X) 'PSPAD (CADR X)))
-        '((|default| |formatDefault|)
-          (|local| |formatLocal|)
-          (COMMENT   |formatCOMMENT|)
-          (CAPSULE |formatCAPSULE|)
-          (LISTOF |formatPAREN|)
-          (DEF    |formatDEF|)
-          (SEQ    |formatSEQ|)
-          (LET    |formatLET|)
-          (\:    |formatColon|)
-          (ELT    |formatELT|)
-          (QUOTE |formatQUOTE|)
-          (SEGMENT |formatSEGMENT|)
-          (DOLLAR |formatDOLLAR|)
-          (BRACE  |formatBrace|)
-          (|dot|  |formatDot|)
-          (MDEF |formatMDEF|)
-          (|free| |formatFree|)
-          (|elt|  |formatElt|)
-          (PAREN |formatPAREN|)
-          (PROGN |formatPROGN|)
-          (|exit| |formatExit|)
-          (|leave| |formatLeave|)
-          (|void|  |formatvoid|)
-          (MI   |formatMI|)
-          (IF   |formatIF|)
-          (\=\> |formatFATARROW|)
-          (\+\-\> |formatMap|)
-          (|Enumeration| |formatEnumeration|)
-          (|import| |formatImport|)
-          (UNCOERCE |formatUNCOERCE|)
-          (CATEGORY |formatCATEGORY|)
-          (SIGNATURE |formatSIGNATURE|)
-          (|where| |formatWHERE|)
-          (COLLECT   |formatCOLLECT|)
-          (|MyENUM|    |formatENUM|)
-          (REDUCE    |formatREDUCE|)
-          (REPEAT    |formatREPEAT|)
-          (ATTRIBUTE |formatATTRIBUTE|)
-          (CONS      |formatCONS|)
-          (|construct| |formatConstruct|)
-          (|Union| |formatUnion|)
-          (|Record| |formatRecord|)
-          (|Mapping| |formatMapping|)
-          (|Tuple|   |formatTuple|)
-          (|with|  |formatWith|)
-          (|withDefault| |formatWithDefault|)
-          (|defaultDefs| |formatDefaultDefs|)
-          (|add|   |formatAdd|)))
-
-(remprop 'cons   '|Led|)
-(remprop 'append 'format)
-(remprop 'cons   'format)
-
-
diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot
deleted file mode 100644
index cd3a08dd..00000000
--- a/src/interp/pspad1.boot
+++ /dev/null
@@ -1,745 +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 macros
-namespace BOOT
-
-$escapeWords := ["always", "assert", "but", "define", 
-  "delay", "do", "except", "export", "extend", "fix", "fluid",
-    "from", "generate", "goto", "import", "inline", "never", "select",
-       "try", "yield"]
-$pileStyle := false
-$commentIndentation := 8
-$braceIndentation := 8
-$doNotResetMarginIfTrue := true
-$marginStack := nil
-$numberOfSpills := 0
-$lineFragmentBuffer:= nil
-$pspadRelationAlist := '((_= . _~_=) (_< . _>_=) (_<_= . _>)(_~_= . _=)(_>_= . _<) (_> . _<_=))
-$lineBuffer := nil
-$formatForcePren := nil
-$underScore := char ('__)
-$rightBraceFlag := nil 
-$semicolonFlag := nil
-$newLineWritten := nil
-$comments := nil
-$noColonDeclaration := false
-$renameAlist := '(
-  (SmallInteger . SingleInteger)
-  (SmallFloat . DoubleFloat)
-  (Void . _(_))
-  (xquo . exquo)
-  (setelt . set_!)
-  (_$ . _%)
-  (_$_$ . _$)
-  (_*_* . _^)
-  (_^_= . _~_=)
-  (_^ . _~))
-
---$opRenameAlist := '(
---  (and . AND)
---  (or  . OR)
---  (not . NOT))
-
-
---======================================================================
---               Main Translator Function
---======================================================================
---% lisp-fragment to boot-fragment functions
-lisp2Boot x ==
-                  --entry function
-  $fieldNames := nil
-  $pilesAreOkHere: local:= true
-  $commentsToPrint: local:= nil
-  $lineBuffer: local := nil
-  $braceStack: local := nil
-  $marginStack: local:= [0]
-  --$autoLine is true except when inside a try---if true, lines are allowed to break
-  $autoLine:= true
-  $lineFragmentBuffer:= nil
-  $bc:=0     --brace count
-  $m:= 0
-  $c:= $m
-  $numberOfSpills:= 0
-  $lineLength:= 80
-  format x
-  formatOutput reverse $lineFragmentBuffer
-  [fragmentsToLine y for y in reverse $lineBuffer]
- 
-fragmentsToLine fragments ==
-  string:= lispStringList2String fragments
-  line:= GETSTR 240
-  for i in 0..MAXINDEX string repeat line:= SUFFIX(string.i,line)
-  line
- 
-lispStringList2String x ==
-  null x => '""
-  atom x => STRINGIMAGE x
-  rest x => apply(function strconc,MAPCAR(function lispStringList2String,x))
-  lispStringList2String first x
- 
---% routines for buffer and margin adjustment
- 
-formatOutput x ==
-  for [currentColumn,start,end,stack] in reverse $commentsToPrint repeat
-    startY:= rest start
-    for [loc,comment] in stack repeat
-      commentY:= rest loc
-      gap:= startY-commentY
-      gap>0 => before:= [[commentY,first loc,gap,comment],:before]
-      gap=0 => same:= [[startY,1,gap,comment],:same]
-      true => after:= [[startY,first loc,-gap,comment],:after]
-  if before then putOut before
-  if same then
-    [y,:extraLines]:= "append"/[mkCommentLines u for u in orderList same]
-    line:= fragmentsToLine x
-    x:=
-      #line+#y>$lineLength =>
-        (y:= strconc(nBlanks $m,y); extraLines:= [y,:extraLines]; x)
-      [line,y]
-  consLineBuffer x
-  for y in extraLines repeat consLineBuffer [y]
-  if after then putOut after
-  $commentsToPrint:= nil
- 
-consLineBuffer x ==  $lineBuffer := [x,:$lineBuffer]
-
-putOut x ==
-  eject ("min"/[gap for [.,.,gap,:.] in x])
-  for u in orderList x repeat addComment u
- 
-eject n == for i in 2..n repeat consLineBuffer nil
- 
-addComment u ==
-  for x in mkCommentLines u repeat consLineBuffer [x]
- 
-mkCommentLines [.,n,.,s] ==
-  lines:= breakComments s
-  lines1:= [fragmentsToLine [nBlanks n,"_{",first lines],:rest lines]
-  [:l,last]:= lines1
-  [:l,fragmentsToLine [last,"_}"]]
- 
-breakComments s ==
-  n:= containsString(s,PNAME "ENDOFLINECHR") =>
-    #s>n+12 => [subString(s,0,n),:breakComments subString(s,n+12)]
-    [subString(s,0,n)]
-  [s]
- 
-containsString(x,y) ==
-                       --if string x contains string y, return start index
-  for i in 0..MAXINDEX x-MAXINDEX y repeat
-    and/[x.(i+j)=y.j for j in 0..MAXINDEX y] => return i
- 
---======================================================================
---               Character/String Buffer Functions
---======================================================================
-consBuffer item ==
-  if item = '"failed" then item := 'failed
-  n:=
-    string? item => 2+#item
-    IDENTP item => #symbolName item
-    #STRINGIMAGE item
-  columnsLeft:= $lineLength-$c
-  if columnsLeft <= 0 and isCloseDelimiter item then $lineLength := $lineLength + 2
-  columnsLeft:= $lineLength-$c
-  --cheat for semicolons, strings, and delimiters: they are NEVER too long
-  not isSpecialBufferItem item and (n>columnsLeft or columnsLeft < 0) =>
-    $autoLine =>
-                   --is true except within try
-      formatOutput reverse $lineFragmentBuffer
-      $c:= ($m+2*($numberOfSpills:= $numberOfSpills+1)) rem $lineLength
-      $lineFragmentBuffer:= [nBlanks $c]
-      consBuffer item
-    nil
-  $lineFragmentBuffer:=
-    null item or IDENTP item => [symbolName item,:$lineFragmentBuffer]
-    integer? item or CHARP item => [STRINGIMAGE item,:$lineFragmentBuffer]
-    string? item => ["_"",string2PrintImage item,"_"",:$lineFragmentBuffer]
-    sayBrightly ['"Unexpected line buffer item: ", STRINGIMAGE item]
-    $lineFragmentBuffer
-  $rightBraceFlag := item = "}"
-  $semicolonFlag  := item = "; "   --prevents consecutive semicolons
-  $c:= $c+n
- 
-isSpecialBufferItem item ==
-  item = "; " or string? item => true
-  false
-
-isCloseDelimiter item ==
-  item = ")" or item = "]" or item = "}" 
-
---======================================================================
---               Formatting/Line Control Functions
---======================================================================
-newLine() ==
-  null $autoLine => nil
-  $newLineWritten := true
-  formatOutput reverse $lineFragmentBuffer
-  $lineFragmentBuffer:= [nBlanks $m]
-  $c:= $m
- 
-optNewLine() ==
-  $newLineWritten => newLine()
-  $c
-
-spillLine() ==
-  null $autoLine => nil
-  formatOutput reverse $lineFragmentBuffer
-  $c:= $m+2*($numberOfSpills:= $numberOfSpills+1)
-  $lineFragmentBuffer:= [nBlanks $c]
-  $c
- 
-indent() ==
-  $m:= $m+2*($numberOfSpills+1)
-  $marginStack:= [$m,:$marginStack]
-  $numberOfSpills:= 0
-  $m
- 
-undent() ==
---  $doNotResetMarginIfTrue=true => 
---    pp '"hoho"
---    $c
-  $marginStack is [m,:r] =>
-    $marginStack := r
-    $m := m
-  0
-
-spill(fn,a) == 
-  u := tryLine FUNCALL(fn,a) => u
-  (nearMargin() or spillLine()) and FUNCALL(fn,a)
- 
-formatSpill(fn,a) ==
-  u := tryLine FUNCALL(fn,a) => u
-  v := (stay:= nearMargin() or indent() and newLine()) and FUNCALL(fn,a) 
-  w := stay or undent()
-  v and w
- 
-formatSpill2(fn,f,a) ==
-  u := tryLine FUNCALL(fn,f,a) => u
-  v := (stay:= nearMargin() or indent() and newLine()) and FUNCALL(fn,f,a) 
-  w := stay or undent()
-  v and w
- 
-nearMargin() ==
-  $c=$m or $c=$m+1 => $c
- 
---======================================================================
---               Main Formatting Functions
---======================================================================
-format(x,:options) ==
-  oldC:= $c
-  qualification := IFCAR options
-  newCOrNil:=
-    x is [op,:argl] =>
-      if op = "return" then argl := rest argl
-      n := #argl
-      op is ['elt,y,"construct"] => formatDollar(y,'construct,argl)
-      op is ['elt,name,p] and upperCase? STRINGIMAGE(opOf name).0 => 
-        formatDollar(name,p,argl)
-      op = 'elt and upperCase? STRINGIMAGE(opOf first argl).0 => 
-        formatDollar1(first argl,second argl)
-      fn:= GETL(op,"PSPAD") => formatFn(fn,x,$m,$c)
-      if op in '(AND OR NOT) then op:= DOWNCASE op
-      n=1 and GETL(op,'Nud) and (lbp:= formatOpBindingPower(op,"Nud","left")) =>
-        formatPrefix(op,first argl,lbp,formatOpBindingPower(op,"Nud","right"),qualification)
-      n=2 and (op = '_$ or getOp(op,'Led)) and (lbp:= formatOpBindingPower(op,"Led","left")) =>
-        formatInfix(op,argl,lbp,formatOpBindingPower(op,"Led","right"),qualification)
-      formatForm x
-    formatAtom x
-  null newCOrNil => ($c:= oldC; nil)
-  not integer? newCOrNil => error()
-  $c:= newCOrNil
- 
-
-getOp(op,kind) ==
-  kind = 'Led =>
-    op in '(_div _exquo) => nil
-    GETL(op,'Led)
-  GETL(op,'Nud)
-
-formatDollar(name,p,argl) ==
-  name := markMacroTran name
-  n := #argl
-  kind := (n=1 => "Nud"; "Led")
-  IDENTP name and GETL(p,kind) => format([p,:argl],name)
-  formatForcePren [p,:argl] and 
-    (tryLine (format "$$" and formatForcePren name) 
-      or (indent() and format "$__" and formatForcePren name and undent()))
- 
-formatMacroCheck name ==
-  atom name => name
-  u := or/[x for [x,:y] in $globalMacroStack | y = name] => u
-  u := or/[x for [x,:y] in $localMacroStack  | y = name] => u
-  [op,:argl] := name
-  op in '(Record Union) => 
-    pp ['"Cannot find: ",name]
-    name
-  [op,:[formatMacroCheck x for x in argl]]
-  
-formatDOLLAR ['DOLLAR,x,y] == formatDollar1(y, x)
-
-formatDollar1(name,arg) ==
-  id :=
-    IDENTP name => name
-    name is [p] and GETL(p,"NILADIC") => p
-    name
-  format arg and format "$$" and formatForcePren id
- 
- 
-formatForcePren x ==
-  $formatForcePren: local := true
-  format x
- 
-formatAtom(x,:options) ==
-  if u := LASSOC(x,$renameAlist) then x := u
-  null x or isIdentifier x => 
-    if MEMQ(x,$escapeWords) then 
-      consBuffer $underScore
-    consBuffer ident2PrintImage PNAME x
-  consBuffer x
- 
-formatFn(fn,x,$m,$c) == FUNCALL(fn,x)
-
-formatFree(['free,:u]) ==
-  format 'free and format " " and formatComma u
-
-formatUnion(['Union,:r]) == 
-  $count : local := 0
-  formatFormNoColonDecl formatTestForPartial ['Union,:[fn x for x in r]] where fn x ==
-    x is [":",y,'Branch] => fn STRINGIMAGE y
-    string? x => [":", makeSymbol x, ['Enumeration,x]]
-    x is [":",:.] => x
-    tag := makeSymbol strconc('"value",STRINGIMAGE ($count := $count + 1))
-    [":", tag, x]      
-
-formatTestForPartial u ==
-  u is ['Union,a,b] and b is [":","failed",:.] and a is [":",.,S] =>
-    ['Partial, S]
-  u
-
-formatEnumeration(y is ['Enumeration,:r]) ==
-  r is [x] => format "'" and format makeSymbol STRINGIMAGE x and format "'"
-  formatForm y
-
-formatRecord(u) == formatFormNoColonDecl u
-
-formatFormNoColonDecl u ==
-  $noColonDeclaration: local := true
-  formatForm u  
-
-formatElt(u) ==  
-  u is ["elt",a,b] => formatApplication rest u
-  formatForm u
- 
-formatForm (u) ==
-  [op,:argl] := u
-  if op in '(Record Union) then 
-    $fieldNames := union(getFieldNames argl,$fieldNames)
-  op in '(true %true) => format "true"
-  op in '(false nil) => format op
-  u=$Zero => format 0
-  u=$One => format 1
-  1=#argl => formatApplication u
-  formatFunctionCall u
- 
-formatFunctionCall u ==
-  $pilesAreOkHere: local
-  spill("formatFunctionCall1",u)
- 
-formatFunctionCall1 [op,:argl] ==
---null argl and getConstructorProperty(op,'niladic) => formatOp op
-  null argl => 
-    GETL(op,"NILADIC") => formatOp op
-    formatOp op and format "()"
-  formatOp op and formatFunctionCallTail argl 
- 
-formatFunctionCallTail argl == format "_(" and formatComma argl and format "_)"
-
-formatComma argl == 
-  format first argl and (and/[format "," and formatCut x for x in rest argl]) and $c
- 
-formatOp op ==
-  atom op => formatAtom op
-  formatPren op
- 
-formatApplication u ==
-  [op,a] := u
-  MEMQ(a, $fieldNames) => formatSelection u
-  atom op => 
-    formatHasDotLeadOp a => formatOpPren(op,a)
-    formatApplication0 u
-  formatSelection u
-
-formatHasDotLeadOp u ==
-  u is [op,:.] and (op = "." or cons? op)
-
-formatApplication0 u ==
---format as f(x) as f x if possible
-  $pilesAreOkHere: local
-  formatSpill("formatApplication1",u)
- 
-formatApplication1 u ==
-  [op,x] := u
-  formatHasDollarOp x or $formatForcePren or 
-    pspadBindingPowerOf("left",x) < 1000  => formatOpPren(op,x)
-  tryLine (formatOp op and format " ") and 
-    (tryLine formatApplication2 x or
-      format "(" and formatApplication2 x and format ")")
-
-formatHasDollarOp x ==
-  x is ["elt",a,b] and isTypeProbably? a 
-
-isTypeProbably? x ==
-  IDENTP x and upperCase? stringChar(symbolName x,0)
-
-formatOpPren(op,x) == formatOp op and formatPren x
-
-formatApplication2 x ==
-  leadOp := 
-    x is [['elt,.,y],:.] => y
-    opOf x
-  leadOp in '(COLLECT LIST construct) or
-    pspadBindingPowerOf("left",x)<1000 => formatPren x
-  format x
-
-formatDot ["dot",a,x] ==
-  tryLine (formatOp a and format ".") and
-    atom x => format x
-    formatPren x
- 
-formatSelection u ==
-  $pilesAreOkHere: local
-  formatSpill("formatSelection1",u)
- 
-formatSelection1 [f,x] == formatSelectionOp f and format "." and 
-    atom x => format x
-    formatPren x
- 
-formatSelectionOp op ==
-  op is [f,.] and not GETL(f,'Nud) or 
-    1000 < pspadBindingPowerOf("right",op) => formatSelectionOp1 op
-  formatPren1("formatSelectionOp1",op)
- 
-formatSelectionOp1 f ==
-  f is [op,:argl] => 
-    argl is [a] => 
-      cons? op and atom a => formatSelection1 [op,a]
-      formatPren f
-    format f
-  formatOp f
- 
-formatPren a ==
-  $pilesAreOkHere: local
-  formatSpill("formatPrenAux",a)
- 
-formatPrenAux a == format "_(" and format a and format "_)"
- 
-formatPren1(f,a) ==
-  $pilesAreOkHere: local
-  formatSpill2("formatPren1Aux",f,a)
- 
-formatPren1Aux(f,a) == format "_(" and FUNCALL(f,a) and format "_)"
- 
-formatLeft(fn,x,op,key) ==
-  lbp:= formatOpBindingPower(op,key,"left")
-  formatOpBindingPower(opOf x,key,"right")<lbp => formatPren1(fn,x)
-  FUNCALL(fn,x)
- 
-formatRight(fn,x,op,key) ==
-  --are there exceptional cases where piles are ok?
-  x is ["%LET",:.] => FUNCALL(fn,x)
-  --decide on basis of binding power whether prens are needed
-  rbp := formatOpBindingPower(op,key,"right")
-  lbp := formatOpBindingPower(opOf x,key,"left")
-  lbp < rbp => formatPren1(fn,x)
-  FUNCALL(fn,x)
- 
-formatCut a == formatSpill("format",a)
- 
---======================================================================
---               Prefix/Infix Operators
---======================================================================
-formatPrefix(op,arg,lbp,rbp,:options) ==
-  qualification := IFCAR options
-  $pilesAreOkHere: local
-  formatPrefixOp(op,qualification) and
-    (rbp>formatGetBindingPowerOf("left",arg) => formatPren arg; format arg)
- 
-formatPrefixOp(op,:options) ==
-  qualification := IFCAR options
-  op = char " " => format " ="
-  qualification or GETL(op,"Nud") and not MEMQ(op,$spadTightList) => 
-    formatQual(op,qualification) and format " "
-  format op
-
-formatQual(op,D) ==
-  null D => format op
-  format op and format "$$" and format D
-
-formatInfix(op,[a,b],lbp,rbp,:options) ==
-  qualification  := IFCAR options
-  $pilesAreOkHere: local
-  (if formatGetBindingPowerOf("right",a)<lbp then formatPren a else format a) and
-    formatInfixOp(op,qualification) and (if rbp>formatGetBindingPowerOf("left",b) 
-      then formatPren b else format b)
- 
-formatGetBindingPowerOf(leftOrRight,x) ==
---  this function is nearly identical with getBindingPowerOf
---    leftOrRight = "left" => 0
---    1
-  pspadBindingPowerOf(leftOrRight,x)
- 
-pspadBindingPowerOf(key,x) ==
-  --binding powers can be found in file NEWAUX LISP
-  x is ['REDUCE,:.] => (key='left => 130; key='right => 0)
-  x is ["REPEAT",:.] => (key="left" => 130; key="right" => 0)
-  x is ['%when,:.] => (key="left" => 130; key="right" => 0)
-  x is [op,:argl] =>
-    if op is [a,:.] then op:= a
-    op = 'SLASH => pspadBindingPowerOf(key,["/",:argl]) - 1
-    op = 'OVER  => pspadBindingPowerOf(key,["/",:argl])
-    (n:= #argl)=1 =>
-      key="left" and (m:= pspadOpBindingPower(op,"Nud","left")) => m
-      key="right" and (m:= pspadOpBindingPower(op,"Nud","right")) => m
-      1000
-    n>1 =>
-      key="left" and (m:= pspadOpBindingPower(op,"Led","left")) => m
-      key="right" and (m:= pspadOpBindingPower(op,"Led","right")) => m
-      op="ELT" => 1002
-      1000
-    1000
-  1002
-
-pspadOpBindingPower(op,LedOrNud,leftOrRight) ==
-  if op in '(SLASH OVER) then op := "/"
-  op in '(_:) and LedOrNud = 'Led =>
-    leftOrRight = 'left => 195
-    196
-  exception:=
-    leftOrRight="left" => 0
-    105
-  bp:=
-    leftOrRight="left" => leftBindingPowerOf(op,LedOrNud)
-    rightBindingPowerOf(op,LedOrNud)
-  bp ~= exception => bp
-  1000
-
-formatOpBindingPower(op,key,leftOrRight) ==
-  if op in '(SLASH OVER) then op := "/"
-  op = '_$ => 1002
-  op in '(_:) and key = 'Led =>
-    leftOrRight = 'left => 195
-    196
-  op in '(_~_= _>_=) => 400
-  op = "not" and key = "Nud" =>
-    leftOrRight = 'left => 1000
-    1001
-  GETL(op,key) is [.,.,:r] =>
-    leftOrRight = 'left => KAR r or 0
-    KAR KDR r or 1
-  1000
- 
-formatInfixOp(op,:options) ==
-  qualification := IFCAR options
-  qualification or 
-    (op ~= '_$) and not MEMQ(op,$spadTightList) => format " " and formatQual(op,qualification) and format " "
-  format op
- 
---======================================================================
---            Special Handlers: DEF forms
---======================================================================
-
-formatDEF def == formatDEF0(def,$DEFdepth + 1)
-
-formatDEF0(["DEF",form,tlist,sclist,body],$DEFdepth) ==
-  if not (KAR form in '(Exports Implementation)) then 
-    $form := 
-      form is [":",a,:.] => a
-      form
-  con := opOf $form
-  $comments: local := SUBST('_$,'_%,getConstructorDocumentationFromDB con)
-  $abb :local := getConstructorAbbreviationFromDB opOf $form
-  if $DEFdepth < 2 then
-    condoc := (u := LASSOC('constructor,$comments)) and KDR KAR u or ['""]
-    $numberOfSpills := -1
-    consComments(condoc,'"+++ ")
-  form := formatDeftranForm(form,tlist)
-  u := ["DEF",form,tlist,sclist,body]
-  v := formatDEF1 u => v
-  $insideDEF: local := $DEFdepth > 1
-  $DEFdepth = 1 =>
-    exname := 'Exports
-    impname := 'Implementation
-    form is [":",.,=exname] or body = impname => nil
-    exports :=
-      form is [":",a,b] => 
-        form := a
-        [["MDEF",exname,'(NIL),'(NIL),b]]
-      nil
-    [op,:argl] := form
---  decls := [x for x in argl | x is [":",:.]]
---  form := [op,:[(a is [":",b,t] => b; a) for a in argl]]
---  $DEFdepth := $DEFdepth - 1  
-    formatWHERE(["where",
-      ["DEF",[":",form,exname],[nil for x in form],sclist,impname],
-        ['PROGN,:exports,["MDEF",impname,'(NIL),'(NIL),body]]])
-  $insideTypeExpression: local := true
-  body := formatDeftran(body,false)
-  body is ["add",a,:b] => formatAddDef(form,a,b) 
---body is ["with",a,:b] => formatWithDef(form,a,b)
-  tryBreakNB(format form and format " == ",body,"==","Led") 
-
-formatDEF1 ["DEF",form,tlist,b,body] ==
-  $insideDEF: local := $DEFdepth > 1
-  $insideEXPORTS: local := form = 'Exports
-  $insideTypeExpression: local := true
-  form := formatDeftran(form,false)
-  body := formatDeftran(body,false)
-  ---------> terrible, hideous, but temporary, hack
-  if not $insideDEF and body is ['SEQ,:.] then body := ["add", body]
-  prefix := (opOf tlist = 'Category => "define "; nil)
-  body is ["add",a,b] => formatAddDef(form,a,b)
-  body is ["with",a,:b] => formatWithDef(form,a,b,"==",prefix)
-  prefix => 
-    tryBreak(format prefix and format form and format " == ",body,"==","Led") 
-  tryBreak(format form and format " == ",body,"==","Led") 
-
-formatDefForm(form,:options) ==
-  prefix := IFCAR options 
-  $insideTypeExpression : local := true
-  form is [":",form1,["with",a,:b]] => formatWithDef(form1,a,b,":",prefix)
-  prefix => format prefix and format form
-  format form
-
-formatAddDef(form,a,b) ==
-  $insideCAPSULE : local := true
-  $insideDEF     : local := false
-  formatDefForm form or return nil
-  $marginStack := [0]
-  $m := $c := 0
-  $insideTypeExpression : local := false
-  cap := (b => b; "")
-  tryBreakNB(newLine() and format "== " and formatLeft("format",a,"add","Led") 
-      and format " add ", cap,"add","Led")
-
-formatWithDef(form,a,b,separator,:options) ==
-  prefix := IFCAR options
-  $insideEXPORTS : local := true
-  $insideCAPSULE : local := true
-  $insideDEF     : local := false
-  $insideTypeExpression : local := false
-  a1 := formatWithKillSEQ a
-  b => tryBreakNB(formatDefForm(form,prefix) and format separator and format " with " and formatLeft("format",a,"with","Led") 
-      and format " with ",first b,"with","Led")
-  tryBreak(formatDefForm(form,prefix) and format separator and format " with ",a1,"with","Nud")
- 
-formatWithKillSEQ x ==
-  x is ['SEQ,['exit,.,y]] => ['BRACE, y]
-  x
-
-formatBrace ['BRACE, x]  == format "{" and format x and format "}"
-
-formatWith ["with",a,:b] ==
-  $pilesAreOkHere: local := true
-  b => 
-    tryBreakNB(formatLeft("format",a,"with","Led") and format " with ",first b,"with","Led")
-  tryBreak(format "with ",a,"with","Nud")
-
-formatWithDefault ["withDefault",a,b] ==
-  if a is ['with,:init,["SEQ",:items,["exit",.,x]]] then
-    part2 := ["SEQ",:items,x,["exit", nil,["defaultDefs", b]]]
-    if IFCAR init then
-      a:= IFCAR init
-      b:= [part2]
-    else
-      a := part2
-      b := nil
-  $pilesAreOkHere: local := true
-  b => 
-    tryBreakNB(formatLeft("format",a,"with","Led") and format " with ",first b,"with","Led")
-  tryBreak(format "with ",a,"with","Nud")
-
-formatDefaultDefs ["default",a, :b] ==
-  $insideCAPSULE : local := true
-  $insideDEF     : local := false
-  $insideTypeExpression : local := false
-  b => 
-    tryBreak(formatLeft("format",a,"default","Led") and 
-      format " default ", first b,"default","Led")
-  tryBreak(format "default ",a,"default","Nud")
---format "add " and formatRight("formatPreferPile",a,"add","Nud")   --==> brace
-
-formatAdd ["add",a,:b] ==
-  $insideCAPSULE : local := true
-  $insideDEF     : local := false
-  $insideTypeExpression : local := false
-  b => 
-    tryBreakNB(formatLeft("format",a,"and","Led") and 
-      format " and ", first b,"and","Led")
-  tryBreakNB(format "add ",a,"and","Nud")
---format "add " and formatRight("formatPreferPile",a,"add","Nud")   --==> brace
-
-formatMDEF ["MDEF",form,.,.,body] ==
-  form is '(Rep) => formatDEF ["DEF",form,nil,nil,body]
-  $insideEXPORTS: local := form = 'Exports
-  $insideTypeExpression: local := true
-  body := formatDeftran(body,false)
-  name := opOf form
-  tryBreakNB(format name and format " ==> ",body,"==","Led") 
-   and ($insideCAPSULE and $c or format(";"))
-
-insideCat() == $insideCategoryIfTrue and not $insideFunctorIfTrue 
-   or $noColonDeclaration
-
-formatImport ["import",a] == 
-  addFieldNames a
-  addFieldNames macroExpand(a,$e)
-  format "import from " and formatLocal1 a
-
-addFieldNames a ==
-  a is [op,:r] and op in '(Record Union) =>
-        $fieldNames := union(getFieldNames r,$fieldNames)
-  a is ['List,:b] => addFieldNames b
-  nil
-
-getFieldNames r ==
-  r is [[":",a,b],:r] => [a,:getFieldNames r]
-  nil
-
-formatLocal ["local",a] == format "local " and formatLocal1 a
- 
-formatLocal1 a ==
-  $insideTypeExpression: local := true
-  format a
-
diff --git a/src/interp/pspad2.boot b/src/interp/pspad2.boot
deleted file mode 100644
index b0a0250a..00000000
--- a/src/interp/pspad2.boot
+++ /dev/null
@@ -1,663 +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 pspad1
-namespace BOOT
-
---======================================================================
---                Constructor Transformation Functions
---======================================================================
-formatDeftranForm(form,tlist) ==
-  [ttype,:atypeList] := tlist
-  if form is [":",f,t] then 
-    form := f
-    ttype := t
-  if form is ['elt,a,b] then    ----> a.b ====> apply(b,a)
-    form := 
-      isTypeProbably? a =>
-        atypeList := reverse atypeList
-        ["$$", b, a]
-      ["apply",a, b]
-  op   := KAR form
-  argl := KDR form
-  if or/[t for t in atypeList] then
-    form := [op,:[(t => [":",a,t]; a) for a in argl for t in atypeList]]
-  if ttype then form := [":",form,ttype]
-  form
- 
-formatDeftran(u,SEQflag) ==
-  u is ['Join,:x] => formatDeftranJoin(u,SEQflag)
-  u is ['CATEGORY,kind,:l,x] => formatDeftran(['with,['SEQ,:l,['exit,n,x]]],SEQflag)
-  u is ['CAPSULE,:l,x] => formatDeftranCapsule(l,x,SEQflag)
-  u is [op,:.] and op in '(rep per) => formatDeftranRepper(u,SEQflag)
-  u is [op,:.] and op in '(_: _:_: _pretend _@) => 
-    formatDeftranColon(u,SEQflag)
-  u is ['PROGN,:l,x] => formatDeftran(['SEQ,:l,['exit,1,x]],SEQflag)
-  u is ['SEQ,:l,[.,n,x]] => 
-    v := [:l,x]
-    a := append/[formatDeftranSEQ(x,true) for x in l]
-    b := formatDeftranSEQ(x,false)
-    if b is [:.,c] and c = '(void) then b := DROP(-1, b)
-    [:m,y] := [:a,:b]
-    ['SEQ,:m,['exit,n,y]]
---  u is ['not,arg] and (op := LASSOC(KAR arg,'((_= . _~_=) (_< . _>_=)))) =>
---    formatDeftran([op,:rest arg],nil)
-  u is ["^",a] => formatDeftran(['not,a],SEQflag)
-  u is ["exquo",a,b] => formatDeftran(['xquo,a,b],SEQflag)
-  u is ['IF,a,b,c] => 
-    a := formatDeftran(a,nil)
-    b := formatDeftran(b,nil)
-    c := formatDeftran(c,nil)
-    null SEQflag and $insideDEF =>
-      [:y,last] := formatDeftranIf(a,b,c)
-      ['SEQ,:y,['exit,1,last]]
-    ['IF,a,b,c]
-  u is ['Union,:argl] => 
-    ['Union,:[x for a in argl 
-      | x := (string? a => [":",makeSymbol a,'Branch]; formatDeftran(a,nil))]]
-  u is [op,:itl,body] and op in '(REPEAT COLLECT) and
-    ([nitl,:nbody] := formatDeftranREPEAT(itl,body)) =>
-      formatDeftran([op,:nitl,nbody],SEQflag)
-  u is [":",a,b] => [":",formatDeftran(a,nil),formatDeftran(markMacroTran(b),nil)]
-  u is ["DEF",:.] => formatCapsuleFunction(u)
-  u is [op,:argl]=>[formatDeftran(op,nil),:[formatDeftran(x,nil) for x in argl]]
-  u = 'nil => 'empty
-  u
-
-formatCapsuleFunction ["DEF",form,tlist,b,body] ==
-  $insideDEF : local := true
-  ["DEF", formatDeftran(form,nil),tlist,b,formatDeftran(body,nil)]
- 
-formatDeftranCapsule(l,x,SEQflag) ==
-  $insideCAPSULE: local := true
-  formatDeftran(['SEQ,:l,['exit,1,x]],SEQflag)
-
-formatDeftranRepper([op,a],SEQflag) ==
-    a is [op1,b] and op1 in '(rep per) =>
-        op = op1 => formatDeftran(a,SEQflag)
-        formatDeftran(b,SEQflag)
-    a is ["::",b,t] =>
-      b := formatDeftran(b,SEQflag)
-      t := formatDeftran(t,SEQflag)
-      a := ["::",b,t]
-      op = "per" and t = "$" or op = "rep" and t = "Rep" => a
-      [op,a]
-    a is ['SEQ,:r] => ['SEQ,:[formatSeqRepper(op,x) for x in r]]
-    a is ['IF,p,b,c] => 
-      formatDeftran(['IF,p,[op,b],[op, c]], SEQflag)
-    a is ["%LET",a,b] => formatDeftran(["%LET",a,[op,b]],SEQflag)
-    a is ['not,[op,a,b]] and (op1 := LASSOC(op,$pspadRelationAlist)) =>
-      formatDeftran([op1,a,b],SEQflag)
-    a is ["return",n,r] => 
-      opOf r in '(true false) => a
-      ["return",n,[op,formatDeftran(r,SEQflag)]]
-    a is ['error,:.] => a
-    [op,formatDeftran(a,SEQflag)]
-
-formatDeftranColon([op,a,t],SEQflag) ==  --op is one of :  ::  pretend  @
-    a := formatDeftran(a,SEQflag)
-    t := formatDeftran(t,SEQflag)
-    a is ["UNCOERCE",b] => b
-    a is [op1,b,t1] and t1 = t and op in '(_: _:_: _pretend _@) =>
-      op1 = "pretend" or op = "pretend" => ["pretend",b,t]
-      null SEQflag and op1 = ":" or op = ":" => ["pretend",b,t]
-      a
-    a is [=op,b,t1] =>
-      t1 = t => a
-      [op,b,t]
-    t = "$" =>
-      a is ['rep,b] => b
-      a is ['per,b] => a
-      [op,a,t]
-    t = "Rep" =>
-      a is ['per,b] => b
-      a is ['rep,b] => a
-      [op,a,t]
-    [op,a,t]
-
-formatSeqRepper(op,x) ==
-  x is ['exit,n,y] => ['exit,n,[op,formatDeftran(y,nil)]]
-  x is ["=>",a,b] => ["=>",formatDeftran(a,nil),[op,formatDeftran(b,nil)]]
-  atom x => x
-  [formatSeqRepper(op,y) for y in x]
-  
-formatDeftranJoin(u,SEQflag) ==
-  ['Join,:cats,lastcat] := u
-  lastcat is ['CATEGORY,kind,:l,x] =>
-    cat := 
-      rest cats => ['Join,:cats]
-      first cats
-    formatDeftran(['with,cat,['SEQ,:l,['exit,1,x]]],SEQflag)
-  u
- 
-formatENUM ['MyENUM, x] == format "'" and format x and format "'"
-
-formatDeftranREPEAT(itl,body) == 
---do nothing unless "itl" contains UNTIL statements
-  u := [x for x in itl | x is ["UNTIL",p]] or return nil
-  nitl := SETDIFFERENCE(itl,u)
-  pred := MKPF([p for ['UNTIL,p] in u],'or)
-  cond := ['IF,pred,["leave",n,nil],'%noBranch]
-  nbody :=
-    body is ['SEQ,:l,[.,n,x]] => ['SEQ,:l,x,['exit,n,cond]]
-    ['SEQ,body,['exit,n,cond]]
-  [nitl,:nbody]
-
-formatDeftranSEQ(x,flag) ==
-  u := formatDeftran(x,flag)
-  u is ['SEQ,:.] => rest u
-  [u]
-
-formatDeftranIf(a,b,c) ==
-  b = '%noBranch =>
-    a is [op,:r] and (al := '((_= . _~_=) (_< . _>_=) (_> . _<_=));
-                      iop := LASSOC(op, al) or rassoc(op, al)) =>
-      [["=>",[iop, :r],c]]
-    a is [op,r] and op in '(NOT not NULL null) =>
-      [["=>", r, c]]
-    [["=>", ['not, a], c]]
-  post := 
-    c = '%noBranch => nil
-    c is ['SEQ,:.] => rest c
-    [c]
-  [["=>",a,b],:post]
-
-formatWHERE ["where",a,b] ==
-  $insideTypeExpression: local := nil
-  $insideCAPSULE: local := false
-  tryBreak(formatLeft("format",a,"where","Led") and format " where ",b,"where","Led")
- 
---======================================================================
---              Special Handlers:  Categories
---======================================================================
-formatATTRIBUTE ['ATTRIBUTE,att] == format att
- 
-formatDeftranCategory ['CATEGORY,kind,:items,item] == ["SEQ",:items,["exit",1,item]]
-
-formatCategory ['Category] == format " " and format "Category"
-  
-formatCATEGORY cat == 
-  con := opOf $form
-  $comments: local := SUBST('_$,'_%,getConstructorDocumentationFromDB con)
-  $insideEXPORTS : local := true
-  format ["with",formatDeftranCategory cat]
- 
-formatSIGNATURE ['SIGNATURE,op,types,:r] ==
-  'constant in r => format op and format ": " and (u := format first types) and 
-    formatSC() and formatComments(u,op,types)
-  format op and format ": " and (u := format ['Mapping,:types]) and formatSC() and
-    formatComments(u,op,types) 
-  
-formatDefault ["default",a] ==
-  $insideCategoryIfTrue : local := false
-  $insideCAPSULE: local := true
-  $insideTypeExpression: local := false
-  tryBreak(format "default ",a,"with","Nud")
---======================================================================
---              Special Handlers:  Control Structures
---======================================================================
-formatUNCOERCE ['UNCOERCE,x] == format x
- 
-formatIF ['IF,a,b,c] == 
-  c = '%noBranch => formatIF2(a,b,"if ")
-  b = '%noBranch => formatIF ['IF,['not,a],c,'%noBranch]
-  formatIF2(a,b,"if ") and newLine() and formatIF3 c
-
-formatIF2(a,b,prefix) ==  
-  tryBreakNB(format prefix and format a and format " then ",b,"then","Nud")
-
-formatIF3 x == 
-  x is ['IF,a,b,c] => 
-    c = '%noBranch => tryBreak(format "else if " 
-      and format a and format " then ",b,"then","Nud")
-    formatIF2(a,b,"else if ") and newLine() and formatIF3 c
-  tryBreak(format "else ",x,"else","Nud")
-    
-formatBlock(l,x) ==
-  null l => format x
-  $pilesAreOkHere: local
-  format "{ " and format first l and
-    (and/[formatSC() and format y for y in rest l]) 
-      and formatSC() and format x and format " }"
- 
-formatExit ["exit",.,u] == format u
-
-formatvoid ["void"] == format "()"
-
-formatLeave ["leave",.,u] == format "break"
- 
-formatCOLLECT u == formatSpill("formatCOLLECT1",u)
- 
-formatCOLLECT1 ["COLLECT",:iteratorList,body] ==
-  $pilesAreOkHere: local
-  format "[" and format body and format " " and
-    formatSpill("formatIteratorTail",iteratorList)
- 
-formatIteratorTail iteratorList ==
-  formatIterator first iteratorList and
-    (and/[format " " and formatIterator x for x in rest iteratorList]) and format "]"
-
---======================================================================
---                  Special Handlers:  Keywords
---======================================================================
- 
-formatColon [":",a,b] ==
-  b is ['with,c,:d] => formatColonWith(a,c,d)
-  if not $insideTypeExpression then 
-    insideCat() => nil
-    format
-      $insideDEF => "local "
-      "default "
-  op := 
-    $insideCAPSULE and not $insideDEF => ": "
-    insideCat() => ": "
-    ":"
-  b := (atom b => b; markMacroTran b)
-  a is ['LISTOF,:c] => formatComma c and format ": " and formatLocal1 b
-  formatInfix(op,[a, b],formatOpBindingPower(":","Led","left"),
-                              formatOpBindingPower(":","Led","right"))
-
-formatColonWith(form,a,b) ==
-  con := opOf $form
-  $comments: local := SUBST('_$,'_%,getConstructorDocumentationFromDB con)
-  $insideEXPORTS : local := true
-  $pilesAreOkHere: local := true
-  $insideTypeExpression : local := false
-  b => tryBreak(formatDefForm form and format ": " 
-        and format a and format " with ",first b,"with","Led")
-  tryBreak(formatDefForm form and format ": with ",a,"with","Nud")
-
-formatCOND ['%when,:l] ==
-  originalC:= $c
-  and/[x is [a,[.,.,b]] for x in l] =>
-    (originalC=$m or indent() and newLine()) and first l is [a,[.,.,b]] and
-      formatIfExit(a,b) and
-        (and/[newLine() and formatIfExit(a,b) for [a,[.,.,b]] in rest l]) and (originalC=$m or undent()) and originalC
-  formatIfThenElse l
-
-formatPROGN ["PROGN",:l] ==
-  l is [:u,x] => formatPiles(u,x)
-  error '"formatPROGN"
-  
-formatELT ["ELT",a,b] == formatApplication [a,b]
- 
-formatCONS ["CONS",a,b] ==
-  $pilesAreOkHere: local
-  format "[" and formatConstructItem a and formatTail b
- 
-formatTail x ==
-  null x => format "]"
-  format "," and formatTail1 x 
- 
-formatTail1 x ==
-  x is ["CONS",a,b] => formatConstructItem a and formatTail b
-  x is ["APPEND",a,b] =>
-    null b => formatConstructItem a and format "]"
-    format ":" and formatConstructItem a and formatTail b
-  format ":" and formatConstructItem x and format "]"
- 
-formatConstructItem x == format x
- 
-formatLET ["%LET",a,b] == 
-  $insideTypeExpression: local := true
-  a = "Rep" or atom a and constructor? opOf b =>
-    tryBreakNB(formatAtom a and format " == ",b,":=","Led")
-  tryBreakNB((IDENTP a => formatAtom a; format a) and format " := ",b,":=","Led")
- 
-formatIfExit(a,b) ==
-                       --called from SCOND or COND only
-  $numberOfSpills: local:= 0
-  curMargin:= $m
-  curMarginStack:= $currentMarginStack
-  $doNotResetMarginIfTrue:= true
-  format a and format " => " and formatRight("formatCut",b,"=>","Led") =>
-    ($currentMarginStack:= curMarginStack; $m:= curMargin)
- 
-formatIfThenElse x == formatSpill("formatIf1",x)
- 
-formatIf1 x ==
-  x is [[a,:r],:c] and null c =>
-    b:=
-      r is [:l,s] and l => ['SEQ,:l,['exit,nil,s]]
-      first r
-    isTrue a => format b
-    format "if " and format a and format " then " and format b
-  format "if " and format a and
-    (tryLine
-      (format " then " and format b and format " else "
-        and formatIfThenElse c) or spillLine()
-          and format " then " and format b and
---           ($c:= $m:= $m+6) and
-            ($numberOfSpills:= $numberOfSpills-1)
-              and spillLine() and format " else " and formatIfThenElse c)
- 
-formatQUOTE ["QUOTE",x] == format "('" and format x and format ")"
-
-formatMI ["MI",a,b] == format a
-
-formatMapping ['Mapping,target,:sources] ==
-  $noColonDeclaration: local := true
-  formatTuple ['Tuple,:sources] and format " -> " and format target
- 
-formatTuple ['Tuple,:types] ==
-  null types => format "()"
-  null rest types => format first types
-  formatFunctionCallTail types
- 
-formatConstruct(['construct,:u]) == 
-  format "[" and (null u or format first u and
-    "and"/[format "," and formatCut x for x in rest u]) and format "]"
- 
-formatNextConstructItem x ==
-  tryLine format x or ($m := $m + 2) and newLine() and format x
- 
-formatREPEAT ["REPEAT",:iteratorList,body] ==
-  tryBreakNB(null iteratorList or (formatIterator first iteratorList and
-    (and/[format " " and formatIterator x for x in rest iteratorList]) and format " ")
-      and format "repeat ",body,"repeat","Led")
- 
-formatFATARROW ["=>",a,b] == tryBreak(format a and format " => ",b,"=>","Led")
-
-formatMap ["+->",a,b] == 
-  $noColonDeclaration: local := true
-  tryBreak(format a and format " +-> ", b, "+->","Led") 
-
-formatREDUCE ["REDUCE",op,.,u] == formatReduce1(op,u)
-
-formatreduce ["reduce",op,u] == formatReduce1(op,u)
-
-formatReduce1(op,u) ==
-  if string? op then op := makeSymbol op
-  id := LASSOC(op,
-    '((_+ Zero)(_* One)(append . NIL)(gcd Zero) (lcm One) (strconc . "")(lcm One)))
-  formatFunctionCall
-    id => ['reduce,op,u,id]
-    ['reduce,op,u]
-
-formatIterator u ==
-  $noColonDeclaration : local := true
-  u is ["IN",x,y] =>
-    format "for " and formatLeft("format",x,"in","Led") and format " in " and
-      formatRight("format",y,"in","Led")
-  u is ["WHILE",x] => format "while " and formatRight("format",x,"while","Nud")
-  u is ["UNTIL",x] => format "until " and formatRight("format",x,"until","Nud")
-  u is ["|",x] => format "| " and formatRight("format",x,"|","Led")
-  u is ["STEP",i,init,step,:v] =>
-    final := IFCAR v
-    format "for " and formatLeft("format",i,"in","Led") and format " in " and
-      (seg := ['SEGMENT,init,final]) and (formatStepOne? step => format seg; formatBy ['by,seg,step])
-  error "formatIterator"
-
-formatStepOne? step ==
-  step = 1 or step = '(One) => true
-  step is [op,n,.] and op in '(_:_:  _@) => n = 1 or n = '(One)
-  false
- 
-formatBy ['by,seg,step] == format seg and format " by " and format step
- 
-formatSCOND ["SCOND",:l] ==
-  $pilesAreOkHere =>
-                            --called from formatPileLine or formatBlock
-                     --if from formatPileLine
-    initialC:= $c
-    and/[x is [a,["exit",.,b]] for x in l] =>
-      first l is [a,["exit",.,b]] and formatIfExit(a,b) and
-        (and/[newLine() and formatIfExit(a,b) for [a,["exit",.,b]] in rest l]) and initialC
-    formatIfThenElse l and initialC
-  and/[x is [a,["exit",.,b]] for x in l] =>
-    first l is [a,["exit",.,b]] and formatIfExit(a,b) and
-      (and/[format "; " and formatIfExit(a,b) for [a,["exit",.,b]] in rest l]) and $c
-   --warning: and/(...) returns T if there are no entries
-  formatIfThenElse l
- 
-formatSEGMENT ["SEGMENT",a,b] ==
-  $pilesAreOkHere: local
-  (if pspadBindingPowerOf("right",a)<750 then formatPren a else format a) and
-    formatInfixOp ".." and
-      (null b and $c or
-        (if 750>pspadBindingPowerOf("left",b) then formatPren b else format b))
- 
-formatSexpr x ==
-  atom x =>
-    null x or IDENTP x => consBuffer ident2PrintImage symbolName x
-    consBuffer x
-  spill("formatNonAtom",x)
- 
-formatNonAtom x ==
-  format "_(" and formatSexpr first x and
-    (and/[format " " and formatSexpr y for y in rest x])
-      and (y:= LASTATOM x => format " . "
-        and formatSexpr y; true) and format "_)"
- 
-formatCAPSULE ['CAPSULE,:l,x] == 
-  $insideCAPSULE: local := true
-  tryLine formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x)
-
-formatPAREN [.,:argl] == formatFunctionCallTail argl
- 
-formatSEQ ["SEQ",:l,[.,.,x]] == 
-  tryLine formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x)
- 
---======================================================================
---              Comment Handlers
---======================================================================
-formatCOMMENT ["COMMENT",x,marg,startXY,endXY,commentStack] ==
-  $commentsToPrint:= [[marg,startXY,endXY,commentStack],:$commentsToPrint]
-  format x
- 
-formatComments(u,op,types) ==
-  $numberOfSpills :local := $commentIndentation/2 - 1
-  not $insideEXPORTS => u
-  alist := LASSOC(op,$comments) or
-    sayBrightly ['"No documentation for ",op]
-    return u
-  ftypes := SUBLISLIS($FormalMapVariableList,rest $form,types)
-  consComments(LASSOC(ftypes,alist),'"++ ")
-  u   
- 
-consComments(s,plusPlus) ==
-  s is [word,:r] and cons? r => consComments(r, plusPlus)
-  s := first s
-  null s => nil
-  s := consCommentsTran s
-  indent() and newLine() or return nil
-  columnsLeft := $lineLength - $m - 2
-  while (m := MAXINDEX s) >= columnsLeft repeat
-    k := or/[i for i in (columnsLeft - 1)..1 by -1 | s.i = $charBlank] 
-    k := (k => k + 1; columnsLeft)
-    piece := subString(s,0,k)
-    formatDoCommentLine [plusPlus,piece]
-    s := subString(s,k)
-  formatDoCommentLine [plusPlus,s]
-  undent()
-  $m
-
-consCommentsTran s ==
-  m := MAXINDEX s 
-  k := or/[i for i in 0..(m - 7) | substring?('"\spad{",s,i)] =>
-    r := charPosition(char '_},s,k + 6)
-    r = m + 1 => s
-    strconc(subString(s,0,k),'"`",subString(s,k+6,r-k-6),'"'",consCommentsTran subString(s,r+1))
-  s
-  
-formatDoCommentLine line ==
-  $lineBuffer := consLineBuffer [nBlanks $c,:line]
-  $c := $m+2*$numberOfSpills
-
---======================================================================
---                  Pile Handlers
---======================================================================
-formatPreferPile y ==
-  y is ["SEQ",:l,[.,.,x]] => 
-    (u:= formatPiles(l,x)) => u 
-    formatSpill("format",y) 
-  formatSpill("format",y)
- 
-formatPiles(l,x) ==
-  $insideTypeExpression : local := false
-  not $pilesAreOkHere => nil                  
-  originalC:= $c
-  lines:= [:l,x]
-                                                --piles must begin at margin
-  originalC=$m or indent() and newLine() or return nil
-  null (formatPileLine($m,first lines,false)) => nil
-  not (and/[formatPileLine($m,y,true) for y in rest lines]) => nil
-  (originalC=$m or undent()) and originalC          --==> brace
- 
-formatPileLine($m,x,newLineIfTrue) ==
-  if newLineIfTrue then newLine() or return nil
-  $numberOfSpills: local:= 0
-  $newLineWritten := nil
-  format x and (x is ['SIGNATURE,:.] or $rightBraceFlag => $c; formatSC())
-    and (x is ['DEF,:.] and optNewLine() or $c)
-
---======================================================================
---                       Utility Functions
---======================================================================
-nBlanks m == strconc/['" " for i in 1..m]
- 
-isNewspadOperator op == GETL(op,"Led") or GETL(op,"Nud")
- 
-isTrue x == x="true" or x = '%true
- 
-nary2Binary(u,op) ==
-  u is [a,b,:t] => (t => nary2Binary([[op,a,b],:t],op); [op,a,b])
-  errhuh()
- 
-string2PrintImage s ==
-  u:= GETSTR (2*# s)
-  for i in 0..MAXINDEX s repeat
-    (if s.i in '(_( _{ _) _} _! _") then
-      SUFFIX('__,u); u:= SUFFIX(s.i,u))
-  u
- 
-ident2PrintImage s ==
-  m := MAXINDEX s
-  if m > 1 and s.(m - 1) = $underScore then s := strconc(subString(s,0,m-1),s.m)
-  u:= GETSTR (2*# s)
-  if not (alphabetic? s.0 or s.0 = char "$") then SUFFIX('__,u)
-  u:= SUFFIX(s.0,u)
-  for i in 1..MAXINDEX s repeat
-    if not (digit? s.i or alphabetic? s.i or ((c := s.i) = char '?) 
-      or (c = char '_!)) then SUFFIX('__,u)
-    u:= SUFFIX(s.i,u)
-  makeSymbol u
- 
-isIdentifier x ==
-  IDENTP x =>
-    s:= symbolName x
-    #s = 0 => nil
-    alphabetic? s.0 => and/[s.i ~= char " " for i in 1..MAXINDEX s]
-    #s>1 =>
-      or/[alphabetic? s.i for i in 1..(m:= MAXINDEX s)] =>
-        and/[s.i ~= char " " for i in 1..m] => true
- 
-isGensym x == 
-  s := STRINGIMAGE x
-  n := MAXINDEX s
-  s.0 = char '_G and and/[digit? s.i for i in 1..n]
- 
---======================================================================
---                       Macro Helpers
---======================================================================
-tryToFit(s,x) ==
---% try to format on current line; see macro tryLine in file PSPADAUX LISP
-  --returns nil if unable to format stuff in x on a single line
-  x => ($back:= rest $back; $c)
-  restoreState()
-  nil
- 
-restoreState(:options) ==
-  back := IFCAR options or $back
-  [
-    [$lineBuffer, $lineFragmentBuffer,$comments,$marginStack,$braceStack,$DEFdepth,
-      $bc,$c,$m,$commentsToPrint,$numberOfSpills,flags], :back]
-        := back
-  if null options then $back := back
-  [$newLineWritten, $autoLine, $rightBraceFlag,
-      $semicolonFlag,$insideDEF,$insideTypeExpression,$pilesAreOkHere,
-       $insideEXPORTS, $insideCAPSULE, $insideCategoryIfTrue,
-         $doNotResetMarginIfTrue,$noColonDeclaration]
-           := flags
-  nil
- 
-saveState(:options) ==
-  flags := 
-    [$newLineWritten, $autoLine, $rightBraceFlag,
-      $semicolonFlag,$insideDEF,$insideTypeExpression,$pilesAreOkHere,
-       $insideEXPORTS, $insideCAPSULE, $insideCategoryIfTrue,
-         $doNotResetMarginIfTrue,$noColonDeclaration]
-  newState := 
-   [
-    [$lineBuffer, $lineFragmentBuffer,$comments,$marginStack,$braceStack,$DEFdepth,
-      $bc,$c,$m,$commentsToPrint,$numberOfSpills,flags], :$back]
-  if not KAR options then $back := newState
-  newState
- 
-formatSC() ==
-  $pileStyle or $semicolonFlag => $c
-  format "; "
-
-wrapBraces(x,y,z) == y
-
-formatLB() ==
-  $pileStyle => $c
-  $numberOfSpills := 
-    $c > $lineLength / 2 => $braceIndentation/3 - 1 
-    $braceIndentation/2 - 1
-  format "{"
-
-restoreC() == --used by macro "embrace"
-  originalC := first $braceStack
-  $braceStack := rest $braceStack
-  formatRB originalC
- 
-saveC() ==  --used by macro "embrace"
-  $braceStack := [$c,:$braceStack]
-
-saveD() ==  --used by macro "embrace"
-  $braceStack := [$c,:$braceStack]
-
-restoreD() == --used by macro "indentNB"
-  originalC := CAR $braceStack
-  $braceStack := rest $braceStack
-  originalC
- 
-formatRB(originalC) == --called only by restoreC
-  while $marginStack and $m > originalC repeat undent()
-  if $m < originalC then $marginStack := [originalC,:$marginStack]
-  $m := originalC
-  $pileStyle => $m
-  newLine() and format "}" and $m    --==> brace
-
diff --git a/src/interp/spad.lisp b/src/interp/spad.lisp
index 8410f52e..2c2a01ee 100644
--- a/src/interp/spad.lisp
+++ b/src/interp/spad.lisp
@@ -325,24 +325,6 @@
         (declare (special |$autoLine|))
         (|tryToFit| (|saveState|) ,X)))
 
-(mapcar #'(lambda (X) (MAKEPROP (CAR X) 'format (CADR X)))
-        '((COMMENT |formatCOMMENT|)
-          (SEQ |formatSEQ|)
-          (DEF |formatDEF|)
-          (%LET |formatLET|)
-          (\: |formatColon|)
-          (ELT |formatELT|)
-          (SEGMENT |formatSEGMENT|)
-          (COND |formatCOND|)
-          (SCOND |formatSCOND|)
-          (QUOTE |formatQUOTE|)
-          (CONS |formatCONS|)
-          (|where| |formatWHERE|)
-          (APPEND |formatAPPEND|)
-          (REPEAT |formatREPEAT|)
-          (COLLECT |formatCOLLECT|)
-          (REDUCE |formatREDUCE|)))
-
 (defun SETELTFIRST (A B C) (declare (ignore b)) (RPLACA A C))
 
 (defun SETELTREST (A B C) (declare (ignore b)) (RPLACD A C))
diff --git a/src/interp/util.lisp b/src/interp/util.lisp
index dac184e8..9ba4839e 100644
--- a/src/interp/util.lisp
+++ b/src/interp/util.lisp
@@ -243,14 +243,6 @@
 ;; directory from the current {\bf AXIOM} shell variable.
 (defvar $relative-library-directory-list '("/algebra/"))
 
-;; This is a little used subsystem to generate {\bf ALDOR} code
-;; from {\bf Spad} code. Frankly, I'd be amazed if it worked.
-(defparameter translate-functions '(
-;; .spad to .as translator, in particular
-;;      loadtranslate
-        |spad2AsTranslatorAutoloadOnceTrigger|
-        ))
-
 ;; This is part of the {\bf ALDOR subsystem}. These will be loaded
 ;; if you compile a {\bf .as} file rather than a {\bf .spad} file.
 ;; {\bf ALDOR} is an external compiler that gets automatically called
@@ -356,7 +348,7 @@
 ;; loads the databases, sets up autoload triggers and clears out hash tables.
 ;; After this function is called the image is clean and can be saved.
 
-(defun build-interpsys (translate-files asauto-files)
+(defun build-interpsys (asauto-files)
   (reroot)
   (|resetWorkspaceVariables|)
   (|AxiomCore|::|%sysInit|)
@@ -368,7 +360,6 @@
   (create-initializers)
   (|start| :fin)
   (setq *load-verbose* nil)
-  (|setBootAutloadProperties| translate-functions translate-files)
   (|setBootAutloadProperties| asauto-functions asauto-files)
   (|fillDatabasesInCore|) ; the databases into core, then close the streams
   (|closeAllDatabaseStreams|)
diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot
deleted file mode 100644
index a584b351..00000000
--- a/src/interp/wi1.boot
+++ /dev/null
@@ -1,1250 +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 macros
-namespace BOOT
-
--- !! do not delete the next function !
-
-spad2AsTranslatorAutoloadOnceTrigger() == nil
-
---======================================================================
---    Temporary definitions---for tracing and debugging
---======================================================================
-$convertingSpadFile := false
-tr fn ==
-  $convertingSpadFile : local := true
-  $options: local := nil
-  sfn  := STRINGIMAGE fn
-  newname := strconc(sfn,'".as")
-  $outStream :local := MAKE_-OUTSTREAM newname
-  markSay '"#pile"
-  markSay('"#include _"axiom.as_"")
-  markTerpri()
-  CATCH($SpadReaderTag,compiler [makeSymbol sfn])
-  SHUT $outStream
-
-ppFull x ==
-  SETQ(_*PRINT_-LEVEL_*,nil)
-  SETQ(_*PRINT_-LENGTH_*,nil)
-  pp x
-
-put(x,prop,val,e) ==
---if prop = 'mode and CONTAINED('PART,val) then foobar val
-  $InteractiveMode and not EQ(e,$CategoryFrame) =>
-    putIntSymTab(x,prop,val,e)
-  --e must never be $CapsuleModemapFrame
-  cons? x => put(first x,prop,val,e)
-  newProplist:= augProplistOf(x,prop,val,e)
-  prop="modemap" and $insideCapsuleFunctionIfTrue=true =>
-    SAY ["**** modemap PUT on CapsuleModemapFrame: ",val]
-    $CapsuleModemapFrame:=
-      addBinding(x,augProplistOf(x,"modemap",val,$CapsuleModemapFrame),
-        $CapsuleModemapFrame)
-    e
-  addBinding(x,newProplist,e)
-
-addBinding(var,proplist,e is [[curContour,:tailContour],:tailEnv]) ==
---if CONTAINED('PART,proplist) then foobar proplist
-  EQ(proplist,getProplist(var,e)) => e
-  $InteractiveMode => addBindingInteractive(var,proplist,e)
-  if curContour is [[ =var,:.],:.] then curContour:= rest curContour
-                 --Previous line should save some space
-  [[[lx,:curContour],:tailContour],:tailEnv] where lx:= [var,:proplist]
-
-
-pmatch(s,p) == pmatchWithSl(s,p,"ok")
-
-pmatchWithSl(s,p,al) ==
-  s=$EmptyMode => nil
-  s=p => al
-  v:= assoc(p,al) => s=rest v or al
-  MEMQ(p,$PatternVariableList) => [[p,:s],:al]
-  cons? p and cons? s and (al':= pmatchWithSl(first s,first p,al)) and
-    pmatchWithSl(rest s,rest p,al')
-
---======================================================================
---                    From define.boot
---======================================================================
-compJoin(["Join",:argl],m,e) ==
-  catList:= [(compForMode(x,$Category,e) or return 'failed).expr for x in argl]
-  catList='failed => stackSemanticError(["cannot form Join of: ",argl],nil)
-  catList':=
-    [extract for x in catList] where
-      extract() ==
-        x := markKillAll x
-        isCategoryForm(x,e) =>
-          parameters:=
-            union("append"/[getParms(y,e) for y in rest x],parameters)
-              where getParms(y,e) ==
-                atom y =>
-                  isDomainForm(y,e) => [y]
-                  nil
-                y is ['LENGTH,y'] => [y,y']
-                LIST y
-          x
-        x is ["DomainSubstitutionMacro",pl,body] =>
-          (parameters:= union(pl,parameters); body)
-        x is ["mkCategory",:.] => x
-        atom x and getmode(x,e)=$Category => x
-        stackSemanticError(["invalid argument to Join: ",x],nil)
-        x
-  T:= [wrapDomainSub(parameters,["Join",:catList']),$Category,e]
-  convert(T,m)
-
-
-compDefineFunctor(dfOriginal,m,e,prefix,fal) ==
-  df := markInsertParts dfOriginal
-  $domainShell: local -- holds the category of the object being compiled
-  $profileCompiler: local := true
-  $profileAlist:    local := nil
-  $LISPLIB => compDefineLisplib(df,m,e,prefix,fal,'compDefineFunctor1)
-  compDefineFunctor1(df,m,e,prefix,fal)
-
-compDefineLisplib(df,m,e,prefix,fal,fn) ==
-  ["DEF",[op,:.],:.] := df
-  --fn= compDefineCategory OR compDefineFunctor
-  sayMSG fillerSpaces(72,'"-")
-  $LISPLIB: local := 'T
-  $op: local := op
-  $lisplibAttributes: local := NIL
-  $lisplibPredicates: local := NIL -- set by makePredicateBitVector
-  $lisplibForm: local := NIL
-  $lisplibKind: local := NIL
-  $lisplibModemap: local := NIL
-  $lisplibModemapAlist: local := NIL
-  $lisplibSlot1 : local := NIL   -- used by NRT mechanisms
-  $lisplibOperationAlist: local := NIL
-  $lisplibSuperDomain: local := NIL
-  $libFile: local := NIL
-  $lisplibVariableAlist: local := NIL
-  $lisplibRelatedDomains: local := NIL   --from ++ Related Domains: see c-doc
-  $lisplibCategory: local := nil
-  --for categories, is rhs of definition; otherwise, is target of functor
-  --will eventually become the "constructorCategory" property in lisplib
-  --set in compDefineCategory if category, otherwise in finalizeLisplib
-  libName := getConstructorAbbreviation op
-  $compileDocumentation => compileDocumentation libName
-  sayMSG ['"   initializing ",$spadLibFT,:bright libName,
-    '"for",:bright op]
-  initializeLisplib libName
-  sayMSG ['"   compiling into ",$spadLibFT,:bright libName]
-  res:= FUNCALL(fn,df,m,e,prefix,fal)
-  sayMSG ['"   finalizing ",$spadLibFT,:bright libName]
---finalizeLisplib libName
-  FRESH_-LINE $algebraOutputStream
-  sayMSG fillerSpaces(72,'"-")
-  unloadOneConstructor(op,libName)
-  res
-
-compTopLevel(x,m,e) ==
---+ signals that target is derived from lhs-- see NRTmakeSlot1Info
-  $NRTderivedTargetIfTrue: local := false
-  $killOptimizeIfTrue: local:= false
-  $forceAdd: local:= false
-  -- The next line allows the new compiler to be tested interactively.
-  compFun := 'compOrCroak
-  if x is ["where",:.] then x := markWhereTran x
-  def :=
-    x is ["where",a,:.] => a
-    x
-  $originalTarget : local :=
-    def is ["DEF",.,[target,:.],:.] => target
-    'sorry
-  x is ["DEF",:.] or x is ["where",["DEF",:.],:.] =>
-    ([val,mode,.]:= FUNCALL(compFun,x,m,e); [val,mode,e])
-        --keep old environment after top level function defs
-  FUNCALL(compFun,x,m,e)
-
-markWhereTran ["where",["DEF",form,sig,clist,body],:tail] ==
-  items :=
-    tail is [['SEQ,:l,['exit,n,x]]] => [:l,x]
-    [first tail]
-  [op,:argl] := form
-  [target,:atypeList] := sig
-  decls := [[":",a,b] for a in argl for b in atypeList | b]
---  not (and/[null x for x in atypeList]) =>
---    systemError ['"unexpected WHERE argument list: ",:atypeList]
-  for x in items repeat
-    x is [":",a,b] =>
-      a is ['LISTOF,:r] =>
-        for y in r repeat decls := [[":",y,b],:decls]
-      decls := [x,:decls]
-    x is [key,fn,p,q,bd] and key in '(DEF MDEF) and p='(NIL) and q='(NIL) =>
-      fn = target or fn is [=target] => ttype := bd
-      fn = body   or fn is [=body]   => body  := bd
-      macros := [x,:macros]
-    systemError ['"unexpected WHERE item: ",x]
-  nargtypes := [p for arg in argl |
-                  p := or/[t for d in decls | d is [.,=arg,t]] or
-                    systemError ['"Missing WHERE declaration for :", arg]]
-  nform := form
-  ntarget := ttype or target
-  ndef := ['DEF,nform,[ntarget,:nargtypes],clist,body]
-  result :=
-    reverse macros is [:m,e] =>
-      mpart :=
-        m => ['SEQ,:m,['exit,1,e]]
-        e
-      ['where,ndef,mpart]
-    ndef
-  result
-
-compPART(u,m,e) ==
---------new------------------------------------------94/10/11
-  ['PART,.,x] := u
-  T := comp(x,m,e) => markAny('compPART,u, T)
-  nil
-
-xxxxx x == x
-
-qt(n,T) ==
-  null T => nil
-  if null getProplist('R,T.env) then xxxxx n
-  T
-
-qe(n,e) ==
-  if null getProplist('R,e) then xxxxx n
-  e
-
-comp(x,m,e) ==
-  qe(7,e)
-  T := qt(8,comp0(x,m,e)) => qt(9,markComp(x,T))
---T := m = "$" and comp(x,$EmptyMode,e) => coerce(T, m)
-  --------------------------------------------------------94/11/10
-  nil
-
-comp0(x,m,e) ==
-  qe(8,e)
---version of comp which skips the marking (see compReduce1)
-  T:= compNoStacking(x,m,e) =>
-    $compStack:= nil
-    qt(10,T)
-  $compStack:= [[x,m,e,$exitModeStack],:$compStack]
-  nil
-
-compNoStacking(xOrig,m,e) ==
-  $partExpression: local := nil
-  xOrig := markKillAllRecursive xOrig
--->xOrig is ['PART,n,x] => compNoStackingAux(xOrig,m,e)
-----------------------------------------------------------94/10/11
-  qt(11,compNoStacking0(xOrig,m,e))
-
-markKillAllRecursive x ==
-  x is [op,:r] =>
---->op = 'PART => markKillAllRecursive second r
-    op = 'PART => ['PART, first r, markKillAllRecursive second r]
-----------------------------------------------------------94/10/11
-    constructor? op => markKillAll x
-    op = 'elt and constructor? opOf first r =>
-      ['elt,markKillAllRecursive first r,second r]
-    x
-  x
-
-compNoStackingAux($partExpression,m,e) ==
------------------not used---------------------94/10/11
-  x := third $partExpression
-  T := compNoStacking0(x,m,e) or return nil
-  markParts($partExpression,T)
-
-compNoStacking0(x,m,e) ==
-  qe(1,e)
-  T := compNoStacking01(x,m,qe(51,e))
-  qt(52,T)
-
-compNoStacking01(x,m,e) ==
---compNoStacking0(x,m,e) ==
-  if CONTAINED('MI,m) then m := markKillAll(m)
-  T:= comp2(x,m,e) =>
-    (m=$EmptyMode and T.mode=IFCAR(get('Rep,'value,e)) => 
-       [T.expr,"Rep",T.env]; qt(12,T))
-         --$Representation is bound in compDefineFunctor, set by doIt
-         --this hack says that when something is undeclared, $ is
-         --preferred to the underlying representation -- RDJ 9/12/83
-  T := compNoStacking1(x,m,e,$compStack)
-  qt(13,T)
-
-compNoStacking1(x,m,e,$compStack) ==
-  u:= get(if m="$" then "Rep" else m,"value",e) =>
-    m1 := markKillAll u.expr
---------------------> new <-------------------------
-    T:= comp2(x,m1,e) => coerce(T,m)
-    nil
---------------------> new <-------------------------
-  nil
-
-compWithMappingMode(x,m,oldE) ==
-  ["Mapping",m',:sl] := m
-  $killOptimizeIfTrue: local:= true
-  e:= oldE
-  x := markKillAll x
-  ------------------
-  m := markKillAll m
-  ------------------
---if x is ['PART,.,y] then x := y
----------------------------------
-  isFunctor x =>
-    if get(x,"modemap",$CategoryFrame) is [[[.,target,:argModeList],.],:.] and
-      (and/[extendsCategoryForm("$",s,mode) for mode in argModeList for s in sl]
-        ) and extendsCategoryForm("$",target,m') then return [x,m,e]
-  if string? x then x:= makeSymbol x
-  for m in sl for v in (vl:= take(#sl,$FormalMapVariableList)) repeat
-    [.,.,e]:= compMakeDeclaration(v,m,e)
-  not null vl and not hasFormalMapVariable(x, vl) => return
-    [u,.,.] := comp([x,:vl],m',e) or return nil
-    extractCodeAndConstructTriple(u, m, oldE)
-  null vl and (t := comp([x], m', e)) => return
-    [u,.,.] := t
-    extractCodeAndConstructTriple(u, m, oldE)
-  [u,.,.]:= comp(x,m',e) or return nil
-  originalFun := u
-  if originalFun is ['WI,a,b] then u := b
-  uu := ['LAMBDA,vl,u]
-  T := [uu,m,oldE]
-  originalFun is ['WI,a,b] => markLambda(vl,a,m,T)
-  markLambda(vl,originalFun,m,T)
-
-compAtom(x,m,e) ==
-  T:= compAtomWithModemap(x,m,e,get(x,"modemap",e)) => markCompAtom(x,T)
-  x="nil" =>
-    T:=
-      modeIsAggregateOf('List,m,e) is [.,R]=> compList(x,['List,R],e)
-      modeIsAggregateOf('Vector,m,e) is [.,R]=> compVector(x,['Vector,R],e)
-    T => convert(T,m)
--->
-  integer? x and opOf m in '(Integer NonNegativeInteger PositiveInteger SmallInteger) => markAt [x,m,e]
---  integer? x and (T := [x, $Integer,e]) and (T' := convert(T,m)) => markAt(T, T')
-  t:=
-    IDENTP x => compSymbol(x,m,e) or return nil
-    m = $OutputForm and primitiveType x => [x,m,e]
-    string? x => 
-      x ~= '"failed" and (member($Symbol, $localImportStack) or
-        member($Symbol, $globalImportStack)) => markAt [x, '(String), e]
-      [x, x, e]
-    [x,primitiveType x or return nil,e]
-  convert(t,m)
-
-extractCodeAndConstructTriple(u, m, oldE) ==
-  u := markKillAll u
-  u is ['%call,fn,:.] =>
-    if fn is ["applyFun",a] then fn := a
-    [fn,m,oldE]
-  [op,:.,env] := u
-  [["CONS",["function",op],env],m,oldE]
-
-compSymbol(s,m,e) ==
-  s="$NoValue" => ["$NoValue",$NoValueMode,e]
-  isFluid s => [s,getmode(s,e) or return nil,e]
-  s="true" => ['%true,$Boolean,e]
-  s="false" => ['%false,$Boolean,e]
-  s=m or isLiteral(s,e) => [["QUOTE",s],s,e]
-  v:= get(s,"value",e) =>
---+
-    MEMQ(s,$functorLocalParameters) =>
-        NRTgetLocalIndex s
-        [s,v.mode,e] --s will be replaced by an ELT form in beforeCompile
-    [s,v.mode,e] --s has been SETQd
-  m':= getmode(s,e) =>
-    if not MEMQ(s,$formalArgList) and not MEMQ(s,$FormalMapVariableList) and
-      not isFunction(s,e) and null ($compForModeIfTrue=true) then errorRef s
-    [s,m',e] --s is a declared argument
-  MEMQ(s,$FormalMapVariableList) => stackMessage ["no mode found for",s]
---->
-  m = $Symbol or m = $OutputForm => [['QUOTE,s],m,e]
-                                   ---> was ['QUOTE, s]
-  not isFunction(s,e) => errorRef s
-
-compForm(form,m,e) ==
-  if form is [['PART,.,op],:r] then form := [op,:r]
-  ----------------------------------------------------- 94/10/16
-  T:=
-    compForm1(form,m,e) or compArgumentsAndTryAgain(form,m,e) or return
-      stackMessageIfNone ["cannot compile","%b",form,"%d"]
-  T
-
-compForm1(form,m,e) ==
-  [op,:argl] := form
-  op="error" =>
-    [[op,:[([.,.,e]:=outputComp(x,e)).expr
-      for x in argl]],m,e]
-  op is ['MI,a,b] => compForm1([markKillExpr b,:argl],m,e)
-  op is ["elt",domain,op'] =>
-    domain := markKillAll domain
-    domain="Lisp" =>
-      --op'='QUOTE and null rest argl => [first argl,m,e]
-      val := [op',:[([.,.,e]:= compOrCroak(x,$EmptyMode,e)).expr for x in argl]]
-      markLisp([val,m,e],m)
--------> new <-------------
---    foobar domain
---    markImport(domain,true)
--------> new <-------------
-    domain=$OutputForm and op'="construct" => compExpressionList(argl,m,e)
-    (op'="COLLECT") and coerceable(domain,m,e) =>
-      (T:= comp([op',:argl],domain,e) or return nil; coerce(T,m))
--------> new <-------------
-    domain= 'Rep and
-      (ans := compForm2([op',:argl],SUBST('Rep,'_$,m),e:= addDomain(domain,e),
-        [SUBST('Rep,'_$,x) for x in getFormModemaps([op',:argl],e)
-          | x is [[ =domain,:.],:.]])) => ans
--------> new <-------------
-    ans := compForm2([op',:argl],m,e:= addDomain(domain,e),
-      [x for x in getFormModemaps([op',:argl],e) | x is [[ =domain,:.],:.]]) => ans
-    (op'="construct") and coerceable(domain,m,e) =>
-      (T:= comp([op',:argl],domain,e) or return nil; coerce(T,m))
-    nil
-
-  e:= addDomain(m,e) --???unneccessary because of comp2's call???
-  (mmList:= getFormModemaps(form,e)) and (T:= compForm2(form,m,e,mmList)) => T
-  compToApply(op,argl,m,e)
-
---% WI and MI
-
-compForm3(form is [op,:argl],m,e,modemapList) ==
---order modemaps so that ones from Rep are moved to the front
-  modemapList := compFormOrderModemaps(modemapList,m = "$")
-  qe(22,e)
-  T:=
-    or/
-      [compFormWithModemap(form,m,e,first (mml:= ml))
-        for ml in tails modemapList] or return nil
-  qt(14,T)
-  result := 
-    $compUniquelyIfTrue =>
-      or/[compFormWithModemap(form,m,e,mm) for mm in rest mml] =>
-        THROW("compUniquely",nil)
-      qt(15,T)
-    qt(16,T)
-  qt(17,markAny('compForm3,form,result))
-
-compFormOrderModemaps(mml,targetIsDollar?) ==
---order modemaps so that ones from Rep are moved to the front
---exceptions: if $ is the target and there are 2 modemaps with
---            identical signatures, move the $ one ahead
-  repMms := [mm for (mm:= [[dc,:.],:.]) in mml | dc = 'Rep]
-  if repMms and targetIsDollar? then 
-    dollarMms := [mm for (mm := [[dc,:sig],:.]) in mml | dc = "$"
-       and or/[mm1 for (mm1:= [[dc1,:sig1],:.]) in repMms | sig1 = sig]]
-    repMms := [:dollarMms, :repMms]
-  null repMms => mml
-  [:repMms,:SETDIFFERENCE(mml,repMms)]
-
-compWI(["WI",a,b],m,E) ==
-  u := comp(b,m,E)
-  pp (u => "====> ok"; 'NO)
-  u
-
-compMI(["MI",a,b],m,E) ==
-  u := comp(b,m,E)
-  pp (u => "====> ok"; 'NO)
-  u
-
-compWhere([.,form,:exprList],m,eInit) ==
-  $insideExpressionIfTrue: local:= false
-  $insideWhereIfTrue: local:= true
---  if not $insideFunctorIfTrue then
---   $originalTarget :=
---    form is ['DEF,a,osig,:.] and osig is [otarget,:.] =>
---      exprList is [['SEQ,:l,['exit,n,y]]] and (u := [:l,y]) and
---        (ntarget := or/[def for x in u | x is [op,a',:.,def] and ([op,a',otarget]) and
---          op in '(DEF MDEF) and (a' = otarget or a' is [=otarget])]) =>
---            [ntarget,:rest osig]
---      osig
---    nil
---  foobum exprList
-  e:= eInit
-  u:=
-    for item in exprList repeat
-      [.,.,e]:= comp(item,$EmptyMode,e) or return "failed"
-  u="failed" => return nil
-  $insideWhereIfTrue:= false
-  [x,m,eAfter]:= comp(macroExpand(form,eBefore:= e),m,e) or return nil
-  eFinal:=
-    del:= deltaContour(eAfter,eBefore) => addContour(del,eInit)
-    eInit
-  [x,m,eFinal]
-
-compMacro(form,m,e) ==
-  $macroIfTrue: local:= true
-  ["MDEF",lhs,signature,specialCases,rhs]:= form := markKillAll form
-  firstForm := ["MDEF",first lhs,'(NIL),'(NIL),rhs]
-  markMacro(first lhs,rhs)
-  if $verbose then
-    rhs :=
-      rhs is ['CATEGORY,:.] => ['"-- the constructor category"]
-      rhs is ['Join,:.]     => ['"-- the constructor category"]
-      rhs is ['CAPSULE,:.]  => ['"-- the constructor capsule"]
-      rhs is ['add,:.]      => ['"-- the constructor capsule"]
-      formatUnabbreviated rhs
-    sayBrightly ['"   processing macro definition",'"%b",
-      :formatUnabbreviated lhs,'" ==> ",:rhs,'"%d"]
-  ["MDEF",lhs,signature,specialCases,rhs]:= form:= macroExpand(form,e)
-  m=$EmptyMode or m=$NoValueMode =>
-    ["/throwAway",$NoValueMode,putMacro(lhs.op,rhs,e)]
-
---compMacro(form,m,e) ==
---  $macroIfTrue: local:= true
---  ["MDEF",lhs,signature,specialCases,rhs]:= form
---  rhs :=
---    rhs is ['CATEGORY,:.] => ['"-- the constructor category"]
---    rhs is ['Join,:.]     => ['"-- the constructor category"]
---    rhs is ['CAPSULE,:.]  => ['"-- the constructor capsule"]
---    rhs is ['add,:.]      => ['"-- the constructor capsule"]
---    formatUnabbreviated rhs
---  sayBrightly ['"   processing macro definition",'"%b",
---    :formatUnabbreviated lhs,'" ==> ",:rhs,'"%d"]
---  ["MDEF",lhs,signature,specialCases,rhs]:= form:= macroExpand(form,e)
---  m=$EmptyMode or m=$NoValueMode =>
---    rhs := markMacro(lhs,rhs)
---    ["/throwAway",$NoValueMode,putMacro(lhs.op,rhs,e)]
-
-compSetq(oform,m,E) ==
-  ["%LET",form,val] := oform
-  T := compSetq1(form,val,m,E) => markSetq(oform,T)
-  nil
-
-compSetq1(oform,val,m,E) ==
-  form := markKillAll oform
-  IDENTP form => setqSingle(form,val,m,E)
-  form is [":",x,y] =>
-    [.,.,E']:= compMakeDeclaration(x,y,E)
-    compSetq(["%LET",x,val],m,E')
-  form is [op,:l] =>
-    op="CONS"  => setqMultiple(uncons form,val,m,E)
-    op="%Comma" => setqMultiple(l,val,m,E)
-    setqSetelt(oform,form,val,m,E)
-
-setqSetelt(oform,[v,:s],val,m,E) ==
-  T:= comp0(["setelt",:oform,val],m,E) or return nil
---->                  -------
-  markComp(oform,T)
-
-setqSingle(id,val,m,E) ==
-  $insideSetqSingleIfTrue: local:= true
-    --used for comping domain forms within functions
-  currentProplist:= getProplist(id,E)
-  m'':= get(id,'mode,E) or getmode(id,E) or 
-       (if m=$NoValueMode then $EmptyMode else m)
------------------------> new <-------------------------
-  trialT := m'' = "$" and get("Rep",'value,E) and comp(val,'Rep,E)
------------------------> new <-------------------------
-  T:=
-    (trialT and coerce(trialT,m'')) or eval or return nil where
-      eval() ==
-        T:= comp(val,m'',E) => T
-        not get(id,"mode",E) and m'' ~= (maxm'':=maximalSuperType m'') and
-           (T:=comp(val,maxm'',E)) => T
-        (T:= comp(val,$EmptyMode,E)) and getmode(T.mode,E) =>
-          assignError(val,T.mode,id,m'')
-  T':= [x,m',e']:= convert(T,m) or return nil
-  if $profileCompiler = true then
-    not IDENTP id => nil
-    key :=
-      MEMQ(id,rest $form) => 'arguments
-      'locals
-    profileRecord(key,id,T.mode)
-  newProplist:= consProplistOf(id,currentProplist,"value",markKillAll removeEnv T)
-  e':= (cons? id => e'; addBinding(id,newProplist,e'))
-  x1 := markKillAll x
-  if isDomainForm(x1,e') then
-    if isDomainInScope(id,e') then
-      stackWarning ["domain valued variable","%b",id,"%d",
-        "has been reassigned within its scope"]
-    e':= augModemapsFromDomain1(id,x1,e')
-      --all we do now is to allocate a slot number for lhs
-      --e.g. the LET form below will be changed by putInLocalDomainReferences
---+
-  if (k:=NRTassocIndex(id))
-     then
-       $markFreeStack := [id,:$markFreeStack]
-       form:=['%store,['%tref,"$",k],x]
-     else form:=
-         ["%LET",id,x]
-  [form,m',e']
-
-setqMultiple(nameList,val,m,e) ==
-  val is ["CONS",:.] and m=$NoValueMode =>
-    setqMultipleExplicit(nameList,uncons val,m,e)
-  val is ["%Comma",:l] and m=$NoValueMode => setqMultipleExplicit(nameList,l,m,e)
-  --1. create a gensym, %add to local environment, compile and assign rhs
-  g:= genVariable()
-  e:= addBinding(g,nil,e)
-  T:= [.,m1,.]:= compSetq1(g,val,$EmptyMode,e) or return nil
-  e:= put(g,"mode",m1,e)
-  [x,m',e]:= convert(T,m) or return nil
-  --1.1 exit if result is a list
-  m1 is ["List",D] =>
-    for y in nameList repeat e := giveVariableSomeValue(y,D,e)
-    convert([["PROGN",x,["%LET",nameList,g],g],m',e],m)
-  --2. verify that the #nameList = number of parts of right-hand-side
-  selectorModePairs:=
-                                                --list of modes
-    decompose(m1,#nameList,e) or return nil where
-      decompose(t,length,e) ==
-        t is ["Record",:l] => [[name,:mode] for [":",name,mode] in l]
-        comp(t,$EmptyMode,e) is [.,["RecordCategory",:l],.] =>
-          [[name,:mode] for [":",name,mode] in l]
-        stackMessage ["no multiple assigns to mode: ",t]
-  #nameList ~= #selectorModePairs =>
-    stackMessage [val," must decompose into ",#nameList," components"]
-  -- 3.generate code; return
-  assignList:=
-    [([.,.,e]:= compSetq1(x,["elt",g,y],z,e) or return "failed").expr
-      for x in nameList for [y,:z] in selectorModePairs]
-  if assignList="failed" then NIL
-  else [mkpf([x,:assignList,g],'PROGN),m',e]
-
-setqMultipleExplicit(nameList,valList,m,e) ==
-  #nameList ~= #valList =>
-    stackMessage ["Multiple assignment error; # of items in: ",nameList,
-      "must = # in: ",valList]
-  gensymList:= [genVariable() for name in nameList]
-  for g in gensymList for name in nameList repeat
-    e := put(g,"mode",get(name,"mode",e),e)
-  assignList:=
-             --should be fixed to declare genVar when possible
-    [[.,.,e]:= compSetq1(g,val,$EmptyMode,e) or return "failed"
-      for g in gensymList for val in valList for name in nameList]
-  assignList="failed" => nil
-  reAssignList:=
-    [[.,.,e]:= compSetq1(name,g,$EmptyMode,e) or return "failed"
-      for g in gensymList for name in nameList]
-  reAssignList="failed" => nil
-  T := [["PROGN",:[T.expr for T in assignList],
-    :[T.expr for T in reAssignList]], $NoValueMode, (last reAssignList).env]
-  markMultipleExplicit(nameList,valList,T)
-
-canReturn(expr,level,exitCount,ValueFlag) ==  --SPAD: exit and friends
-  atom expr => ValueFlag and level=exitCount
-  (op:= first expr)="QUOTE" => ValueFlag and level=exitCount
-  op in '(WI MI) => canReturn(third expr,level,count,ValueFlag)
-  op="TAGGEDexit" =>
-    expr is [.,count,data] => canReturn(data.expr,level,count,count=level)
-  level=exitCount and not ValueFlag => nil
-  op="SEQ" => or/[canReturn(u,level+1,exitCount,false) for u in rest expr]
-  op="TAGGEDreturn" => nil
-  op="CATCH" =>
-    [.,gs,data]:= expr
-    (findThrow(gs,data,level,exitCount,ValueFlag) => true) where
-      findThrow(gs,expr,level,exitCount,ValueFlag) ==
-        atom expr => nil
-        expr is ["THROW", =gs,data] => true
-            --this is pessimistic, but I know of no more accurate idea
-        expr is ["SEQ",:l] =>
-          or/[findThrow(gs,u,level+1,exitCount,ValueFlag) for u in l]
-        or/[findThrow(gs,u,level,exitCount,ValueFlag) for u in rest expr]
-    canReturn(data,level,exitCount,ValueFlag)
-  op = '%when =>
-    level = exitCount =>
-      or/[canReturn(last u,level,exitCount,ValueFlag) for u in rest expr]
-    or/[or/[canReturn(u,level,exitCount,ValueFlag) for u in v]
-                for v in rest expr]
-  op="IF" =>
-    expr is [.,a,b,c]
-    if not canReturn(a,0,0,true) and not $convert2NewCompiler then
-      SAY "IF statement can not cause consequents to be executed"
-      pp expr
-    canReturn(a,level,exitCount,nil) or canReturn(b,level,exitCount,ValueFlag)
-      or canReturn(c,level,exitCount,ValueFlag)
-  --now we have an ordinary form
-  atom op => and/[canReturn(u,level,exitCount,ValueFlag) for u in expr]
-  op is ["XLAM",args,bods] =>
-    and/[canReturn(u,level,exitCount,ValueFlag) for u in expr]
-  systemErrorHere ["canReturn",expr] --for the time being
-
-compList(l,m is ["List",mUnder],e) ==
-  markImport m
-  markImport mUnder
-  null l => [NIL,m,e]
-  Tl:= [[.,mUnder,e]:=
-    comp(x,mUnder,e) or return "failed" for i in 1.. for x in l]
-  Tl="failed" => nil
-  T:= [['%list,:[T.expr for T in Tl]],["List",mUnder],e]
-
-compVector(l,m is ["Vector",mUnder],e) ==
-  markImport m
-  markImport mUnder
-  null l => [$EmptyVector,m,e]
-  Tl:= [[.,mUnder,e]:= comp(x,mUnder,e) or return "failed" for x in l]
-  Tl="failed" => nil
-  [["VECTOR",:[T.expr for T in Tl]],m,e]
-
-compColon([":",f,t],m,e) ==
-  $insideExpressionIfTrue=true => compPretend(["pretend",f,t],m,e)
-    --if inside an expression, ":" means to convert to m "on faith"
-  f := markKillAll f
-  $lhsOfColon: local:= f
-  t:=
-    t := markKillAll t
-    atom t and (t':= ASSOC(t,getDomainsInScope e)) => t'
-    isDomainForm(t,e) and not $insideCategoryIfTrue =>
-      (if not member(t,getDomainsInScope e) then e:= addDomain(t,e); t)
-    isDomainForm(t,e) or isCategoryForm(t,e) => t
-    t is ["Mapping",m',:r] => t
-    unknownTypeError t
-    t
-  if $insideCapsuleFunctionIfTrue then markDeclaredImport t
-  f is ["LISTOF",:l] =>
-    (for x in l repeat T:= [.,.,e]:= compColon([":",x,t],m,e); T)
-  e:=
-    f is [op,:argl] and not (t is ["Mapping",:.]) =>
-      --for MPOLY--replace parameters by formal arguments: RDJ 3/83
-      newTarget:= EQSUBSTLIST(take(#argl,$FormalMapVariableList),
-        [(x is [":",a,m] => a; x) for x in argl],t)
-      signature:=
-        ["Mapping",newTarget,:
-          [(x is [":",a,m] => m;
-              getmode(x,e) or systemErrorHere '"compColonOld") for x in argl]]
-      put(op,"mode",signature,e)
-    put(f,"mode",t,e)
-  if not $bootStrapMode and $insideFunctorIfTrue and
-    makeCategoryForm(t,e) is [catform,e] then
-        e:= giveVariableSomeValue(f,t,e)
-  ["/throwAway",getmode(f,e),e]
-
-compConstruct(form,m,e) == (T := compConstruct1(form,m,e)) and markConstruct(form,T) 
-  
-compConstruct1(form is ["construct",:l],m,e) ==
-  y:= modeIsAggregateOf("List",m,e) =>
-    T:= compList(l,["List",second y],e) => convert(T,m)
-  y:= modeIsAggregateOf("Vector",m,e) =>
-    T:= compVector(l,["Vector",second y],e) => convert(T,m)
-  T:= compForm(form,m,e) => T
-  for D in getDomainsInScope e repeat
-    (y:=modeIsAggregateOf("List",D,e)) and
-      (T:= compList(l,["List",second y],e)) and (T':= convert(T,m)) =>
-         return T'
-    (y:=modeIsAggregateOf("Vector",D,e)) and
-      (T:= compVector(l,["Vector",second y],e)) and (T':= convert(T,m)) =>
-         return T'
-
-compPretend(u := ["pretend",x,t],m,e) ==
-  t := markKillAll t
-  m := markKillAll m
-  e:= addDomain(t,e)
-  T:= comp(x,t,e) or comp(x,$EmptyMode,e) or return nil
-  if T.mode=t then warningMessage:= ["pretend",t," -- should replace by @"]
-  T1:= [T.expr,t,T.env]
-  t = "$" and m = "Rep" => markPretend(T1,T1)  -->! WATCH OUT: correct? !<--
-  T':= coerce(T1,m) =>
-    warningMessage =>
-      stackWarning warningMessage
-      markCompColonInside("@",T')
-    markPretend(T1,T')
-  nil
-
-compAtSign(["@",x,m'],m,e) ==
-  m' := markKillAll m'
-  m  := markKillAll m
-  e:= addDomain(m',e)
-  T:= comp(x,m',e) or return nil
-  coerce(T,m)
-
-compColonInside(x,m,e,m') ==
-  m' := markKillAll m'
-  e:= addDomain(m',e)
-  T:= comp(x,$EmptyMode,e) or return nil
-  if T.mode=m' then warningMessage:= [":",m'," -- should replace by ::"]
-  T:= [T.expr,m',T.env]
-  m := markKillAll m
-  T':= coerce(T,m) =>
-    warningMessage =>
-      stackWarning warningMessage
-      markCompColonInside("@",T')
-    stackWarning [":",m'," -- should replace by pretend"]
-    markCompColonInside("pretend",T')
-  nil
-
-resolve(min, mout) ==
-  din  := markKillAll min
-  dout := markKillAll mout
-  din=$NoValueMode or dout=$NoValueMode => $NoValueMode
-  dout=$EmptyMode => din
-  string? din and dout = $Symbol => dout   ------> hack 8/14/94
-  string? dout and din = $Symbol => din    ------> hack 8/14/94
-  din ~= dout and (string? din or string? dout) =>
-    modeEqual(dout,$String) => dout
-    modeEqual(din,$String) =>  nil
-    mkUnion(din,dout)
-  dout
-
-coerce(T,m) ==
-  T := [T.expr,markKillAll T.mode,T.env]
-  m := markKillAll m
-  if not isLiteral(m,T.env) then markImport m
-  $InteractiveMode =>
-    keyedSystemError("S2GE0016",['"coerce",
-      '"function coerce called from the interpreter."])
---==================> changes <======================
---The following line is inappropriate for our needs:::
---T.rest.first := substitute("$",$Rep,second T)
-  T' := coerce0(T,m) => T'
-  T := [T.expr,fullSubstitute("$",$Representation,T.mode),T.env]
---==================> changes <======================
-  coerce0(T,m)
-
-coerce0(T,m) ==
-  T':= coerceEasy(T,m) => T'
-  T':= coerceSubset(T,m) => markCoerce(T,T','AUTOSUBSET)
-  T':= coerceHard(T,m)   => markCoerce(T,T','AUTOHARD)
-  T':= coerceExtraHard(T,m) => T'
-  T.expr = "$fromCoerceable$" or isSomeDomainVariable m => nil
-  T' := coerceRep(T,m) => markCoerce(T,T','AUTOREP)
-  stackMessage fn(T.expr,T.mode,m) where
-      -- if from from coerceable, this coerce was just a trial coercion
-      -- from compFormWithModemap to filter through the modemaps
-    fn(x,m1,m2) ==
-      ["Cannot coerce","%b",x,"%d","%l","      of mode","%b",m1,"%d","%l",
-        "      to mode","%b",m2,"%d"]
-
-coerceSubset(T := [x,m,e],m') ==
-  m = $SmallInteger =>
-    m' = $Integer => [x,m',e]
-    m' = (r := get(x,'range,e)) or isSubset(r,m',e) => [x,r,e]
-    nil
---  pp [m, m']
-  isSubset(m,m',e) => [x,m',e]
-  -- if m is a type variable, we can't know.
-  (pred:= isSubset(m',m,e)) and integer? x and
-     -- obviously this is temporary
-    eval substitute(x,"#1",pred) => [x,m',e]
-  nil
-
-coerceRep(T,m) ==
-  md := T.mode
-  atom md => nil
-  CONTAINED('Rep,md) and SUBST('$,'Rep,md) = m or
-    CONTAINED('Rep,m) and SUBST('$,'Rep,m) = md => T
-  nil
-
---- GET rid of XLAMs
-spadCompileOrSetq form ==
-        --bizarre hack to take account of the existence of "known" functions
-        --good for performance (LISPLLIB size, BPI size, NILSEC)
-  [nam,[lam,vl,body]] := form
-  CONTAINED($ClearBodyToken,body) => sayBrightly ['"  ",:bright nam,'" not compiled"]
-  if vl is [:vl',E] and body is [nam',: =vl'] then
-      LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ nam']
-      sayBrightly ['"     ",:bright nam,'"is replaced by",:bright nam']
-  else if (atom body or and/[atom x for x in body])
-         and vl is [:vl',E] and not CONTAINED(E,body) then
-           macform := ['XLAM,vl',body]
-           LAM_,EVALANDFILEACTQ ['PUT,MKQ nam,MKQ 'SPADreplace,MKQ macform]
-           sayBrightly ['"     ",:bright nam,'"is replaced by",:bright body]
-  $insideCapsuleFunctionIfTrue => first backendCompile [form]
-  compileConstructor form
-
-coerceHard(T,m) ==
-  $e: local:= T.env
-  m':= T.mode
-  string? m' and modeEqual(m,$String) => [T.expr,m,$e]
-  modeEqual(m',m) or
-    (get(m',"value",$e) is [m'',:.] or getmode(m',$e) is ["Mapping",m'']) and
-      modeEqual(m'',m) or
-        (get(m,"value",$e) is [m'',:.] or getmode(m,$e) is ["Mapping",m'']) and
-          modeEqual(m'',m') => [T.expr,m,T.env]
-  string? T.expr and T.expr=m => [T.expr,m,$e]
-  isCategoryForm(m,$e) =>
-      $bootStrapMode = true => [T.expr,m,$e]
-      extendsCategoryForm(T.expr,T.mode,m) => [T.expr,m,$e]
-      nil
-  nil
-
-coerceExtraHard(T is [x,m',e],m) ==
-  T':= autoCoerceByModemap(T,m) => T'
-  unionLike?(m',e) is ['UnionCategory,:l] and (t:= hasType(x,e)) and
-    member(t,l) and (T':= autoCoerceByModemap(T,t)) and
-      (T'':= coerce(T',m)) => T''
-  m' is ['Record,:.] and m = $OutputForm =>
-      [['coerceRe2E,x,['ELT,COPY m',0]],m,e]
-  nil
-
-compCoerce(u := ["::",x,m'],m,e) ==
-  m' := markKillAll m'
-  e:= addDomain(m',e)
-  m := markKillAll m
---------------> new code <-------------------
-  T:= compCoerce1(x,m',e) => coerce(T,m)
-  T := comp(x,$EmptyMode,e) or return nil
-  T.mode = $SmallInteger and
-    opOf m in '(NonNegativeInteger PositiveInteger) =>
-      compCoerce(["::",["::",x,$Integer],m'],m,e)
---------------> new code <-------------------
-  getmode(m',e) is ["Mapping",["UnionCategory",:l]] =>
-    l := [markKillAll x for x in l]
-    T:= (or/[compCoerce1(x,m1,e) for m1 in l]) or return nil
-    coerce([T.expr,m',T.env],m)
-
-compCoerce1(x,m',e) ==
-  T:= comp(x,m',e)
-  if null T then T := comp(x,$EmptyMode,e)
-  null T => return nil
-  m1:=
-    string? T.mode => $String
-    T.mode
-  m':=resolve(m1,m')
-  T:=[T.expr,m1,T.env]
-  T':= coerce(T,m') => T'
-  T':= coerceByModemap(T,m') => T'
-  pred:=isSubset(m',T.mode,e) =>
-    gg:=gensym()
-    pred:= substitute(gg,"#1",pred)
-    code:= ['PROG1,["%LET",gg,T.expr], ['check_-subtype,pred,MKQ m',gg]]
-    [code,m',T.env]
-
-coerceByModemap([x,m,e],m') ==
---+ modified 6/27 for new runtime system
-  u:=
-    [modemap
-      for (modemap:= [map,cexpr]) in getModemapList("coerce",1,e) | map is [.,t,
-        s] and (modeEqual(t,m') or isSubset(t,m',e))
-           and (modeEqual(s,m) or isSubset(m,s,e))] or return nil
-  mm:=first u  -- patch for non-trival conditons
-  fn := genDeltaEntry(['coerce,:mm],e)
-  T := [['%call,fn,x],m',e]
-  markCoerceByModemap(x,m,m',markCallCoerce(x,m',T),nil)
- 
-autoCoerceByModemap([x,source,e],target) ==
-  u:=
-    [cexpr
-      for (modemap:= [map,cexpr]) in getModemapList("autoCoerce",1,e) | map is [
-        .,t,s] and modeEqual(t,target) and modeEqual(s,source)] or return nil
-  fn:= (or/[selfn for [cond,selfn] in u | cond=true]) or return nil
-  markCoerceByModemap(x,source,target,[['%call,fn,x],target,e],true)
-
---======================================================================
---                    From compiler.boot
---======================================================================
---comp3x(x,m,$e) ==
-
-comp3(x,m,$e) ==
-    --returns a Triple or %else nil to signalcan't do'
-  $e:= addDomain(m,$e)
-  e:= $e --for debugging purposes
-  m is ["Mapping",:.] => compWithMappingMode(x,m,e)
-  m is ["QUOTE",a] => (x=a => [x,m,$e]; nil)
-  string? m => (atom x => (m=x or m=STRINGIMAGE x => [m,m,e]; nil); nil)
-  null x or atom x => compAtom(x,m,e)
-  op:= first x
-  getmode(op,e) is ["Mapping",:ml] and (u:= applyMapping(x,m,e,ml)) => u
-  op=":" => compColon(x,m,e)
-  op="::" => compCoerce(x,m,e)
-  not ($insideCompTypeOf=true) and stringPrefix?('"TypeOf",PNAME op) =>
-    compTypeOf(x,m,e)
-  ------------special jump out code for PART (don't want $insideExpressionIfTrue=true)--
-  x is ['PART,:.] => compPART(x,m,e)
-  ----------------------------------
-  t:= qt(14,compExpression(x,m,e))
-  t is [x',m',e'] and not member(m',getDomainsInScope e') =>
-    qt(15,[x',m',addDomain(m',e')])
-  qt(16,t)
-
-yyyyy x == x
-compExpression(x,m,e) ==
-  $insideExpressionIfTrue: local:= true
-  if x is ["%LET",['PART,.,w],[['elt,B,'new],['PART,.,["#",['PART,.,l]]],:.],:.] then yyyyy x 
-  x := compRenameOp x
-  atom first x and (fn:= GETL(first x,"SPECIAL")) =>
-    FUNCALL(fn,x,m,e)
-  compForm(x,m,e)
-
-compRenameOp x ==   ----------> new 12/3/94
-  x is [op,:r] and op is ['PART,.,op1] =>
-    [op1,:r]
-  x
-
-compCase(["case",x,m1],m,e) ==
-  m' := markKillAll m1
-  e:= addDomain(m',e)
-  T:= compCase1(x,m',e) => coerce(T,m)
-  nil
-
-compCase1(x,m,e) ==
-  x1 :=
-    x is ['PART,.,a] => a
-    x
-  [x',m',e']:= comp(x1,$EmptyMode,e) or return nil
-  if m' = "$" then (m' := IFCAR get('Rep,'value,e)) and (switchMode := true)
-  --------------------------------------------------------------------------
-  m' isnt ['Union,:r] => nil
-  mml := [mm for (mm := [map,cexpr]) in getModemapList("case",2,e') 
-    | map is [.,.,s,t] and modeEqual(t,m) and 
-         (modeEqual(s,m') or switchMode and modeEqual(s,"$"))]
-        or return nil
-  u := [cexpr for [.,cexpr] in mml] 
-  fn:= (or/[selfn for [cond,selfn] in u | cond=true]) or return nil
-  tag := genCaseTag(m, r, 1) or return nil
-  x1 :=
-    switchMode => markRepper('rep, x)
-    x
-  markCase(x, tag, markCaseWas(x1,[['%call,fn,x'],$Boolean,e']))
-
-genCaseTag(t,l,n) ==
-  l is [x, :l] =>
-    x = t     => 
-      string? x => makeSymbol x
-      makeSymbol strconc("value", STRINGIMAGE n)
-    x is ["::",=t,:.] => t
-    string? x => genCaseTag(t, l, n)
-    genCaseTag(t, l, n + 1)
-  nil
-
-compIf(["IF",aOrig,b,c],m,E) ==
-  a := markKillButIfs aOrig
-  [xa,ma,Ea,Einv]:= compBoolean(a,aOrig,$Boolean,E) or return nil
-  [xb,mb,Eb]:= Tb:= compFromIf(b,m,Ea) or return nil
-  [xc,mc,Ec]:= Tc:= compFromIf(c,resolve(mb,m),Einv) or return nil
-  xb':= coerce(Tb,mc) or return nil
-  x:= ["IF",xa,xb'.expr,xc]
-  (returnEnv:= Env(xb'.env,Ec,xb'.expr,xc,E)) where
-    Env(bEnv,cEnv,b,c,E) ==
-      canReturn(b,0,0,true) =>
-        (canReturn(c,0,0,true) => intersectionEnvironment(bEnv,cEnv); bEnv)
-      canReturn(c,0,0,true) => cEnv
-      E
-  [x,mc,returnEnv]
-
-compBoolean(p,pWas,m,Einit) ==
-  op := opOf p
-  [p',m,E]:= 
-    fop := LASSOC(op,'((and . compAnd) (or . compOr) (not . compNot))) =>
-       apply(fop,[p,pWas,m,Einit]) or return nil
-    T := comp(p,m,Einit) or return nil
-    markAny('compBoolean,pWas,T) 
-  [p',m,getSuccessEnvironment(markKillAll p,E),
-        getInverseEnvironment(markKillAll p,E)]
-
-compAnd([op,:args], pWas, m, e) ==
---called ONLY from compBoolean
-  cargs := [T.expr for x in args 
-              | [.,.,e,.] := T := compBoolean(x,x,$Boolean,e) or return nil]
-  null cargs => nil
-  coerce(markAny('compAnd,pWas,[["AND",:cargs],$Boolean,e]),m)
-
-compOr([op,:args], pWas, m, e) ==
---called ONLY from compBoolean
-  cargs := [T.expr for x in args 
-              | [.,.,.,e] := T := compBoolean(x,x,$Boolean,e) or return nil]
-  null cargs => nil
-  coerce(markAny('compOr,pWas, [["OR",:cargs],$Boolean,e]),m)
-
-compNot([op,arg], pWas, m, e) ==
---called ONLY from compBoolean
-  [x,m1,.,ei] := compBoolean(arg,arg,$Boolean,e) or return nil
-  coerce(markAny('compNot, pWas, [["NOT",x],$Boolean,ei]),m)
-
-compDefine(form,m,e) ==
-  $macroIfTrue: local
-  ['DEF,.,originalSignature,.,body] := form
-  if not $insideFunctorIfTrue then
-    $originalBody := COPY body
-  compDefine1(form,m,e)
-
-compDefine1(form,m,e) ==
-  $insideExpressionIfTrue: local:= false
-  --1. decompose after macro-expanding form
-  ['DEF,lhs,signature,specialCases,rhs]:= form:= macroExpand(form,e)
-  $insideWhereIfTrue and isMacro(form,e) and (m=$EmptyMode or m=$NoValueMode)
-     => [lhs,m,putMacro(lhs.op,rhs,e)]
-  null signature.target and not MEMQ(KAR rhs,$BuiltinConstructorNames) and
-    (sig:= getSignatureFromMode(lhs,e)) =>
-  -- here signature of lhs is determined by a previous declaration
-      compDefine1(['DEF,lhs,[first sig,:rest signature],specialCases,rhs],m,e)
-  if signature.target=$Category then $insideCategoryIfTrue:= true
-  if signature.target is ['Mapping,:map] then
-    signature:= map
-    form:= ['DEF,lhs,signature,specialCases,rhs]
-
-
--- RDJ (11/83): when argument and return types are all declared,
---  or arguments have types declared in the environment,
---  and there is no existing modemap for this signature, add
---  the modemap by a declaration, then strip off declarations and recurse
-  e := compDefineAddSignature(lhs,signature,e)
--- 2. if signature list for arguments is not empty, replace ('DEF,..) by
---       ('where,('DEF,..),..) with an empty signature list;
---     otherwise, fill in all NILs in the signature
-  not (and/[null x for x in rest signature]) => compDefWhereClause(form,m,e)
-  signature.target=$Category =>
-    compDefineCategory(form,m,e,nil,$formalArgList)
-  isDomainForm(rhs,e) and not $insideFunctorIfTrue =>
-    if null signature.target then signature:=
-      [getTargetFromRhs(lhs,rhs,giveFormalParametersValues(rest lhs,e)),:
-          rest signature]
-    rhs:= addEmptyCapsuleIfNecessary(signature.target,rhs)
-    compDefineFunctor(['DEF,lhs,signature,specialCases,rhs],m,e,nil,
-      $formalArgList)
-  null $form => stackAndThrow ['"bad == form ",form]
-  newPrefix:=
-    $prefix => makeSymbol strconc(encodeItem $prefix,'",",encodeItem $op)
-    getAbbreviation($op,#rest $form)
-  compDefineCapsuleFunction(form,m,e,newPrefix,$formalArgList)
-
-compDefineCategory(df,m,e,prefix,fal) ==
-  $domainShell: local -- holds the category of the object being compiled
-  $lisplibCategory: local
-  not $insideFunctorIfTrue and $LISPLIB =>
-    compDefineLisplib(df,m,e,prefix,fal,'compDefineCategory1)
-  compDefineCategory1(df,m,e,prefix,fal)
-
-compDefineCategory1(df,m,e,prefix,fal) ==
-  $DEFdepth     : local := 0            --for conversion to new compiler 3/93
-  $capsuleStack : local := nil          --for conversion to new compiler 3/93
-  $predicateStack:local := nil          --for conversion to new compiler 3/93
-  $signatureStack:local := nil          --for conversion to new compiler 3/93
-  $importStack  : local := nil          --for conversion to new compiler 3/93
-  $globalImportStack  : local := nil    --for conversion to new compiler 3/93
-  $catAddForm  : local := nil           --for conversion to new compiler 2/95
-  $globalDeclareStack : local := nil
-  $globalImportDefAlist: local:= nil
-  $localMacroStack  : local := nil      --for conversion to new compiler 3/93
-  $freeStack   : local := nil           --for conversion to new compiler 3/93
-  $domainLevelVariableList: local := nil--for conversion to new compiler 3/93
-  $categoryTranForm : local := nil      --for conversion to new compiler 10/93
-  ['DEF,form,sig,sc,body] := df
-  body := markKillAll body --these parts will be replaced by compDefineLisplib
-  categoryCapsule :=
---+
-    body is ['add,cat,capsule] =>
-      body := cat
-      capsule
-    nil
-  [d,m,e]:= compDefineCategory2(form,sig,sc,body,m,e,prefix,fal)
---+ next two lines
---  if $convertingSpadFile then nil
---  else
-  if categoryCapsule and not $bootStrapMode then
-    [.,.,e] :=
-      $insideCategoryPackageIfTrue: local := true
-      $categoryPredicateList: local :=
-          makeCategoryPredicates(form,$lisplibCategory)
-      defform := mkCategoryPackage(form,cat,categoryCapsule)
-      ['DEF,[.,arg,:.],:.] := defform
-      $categoryNameForDollar :local := arg
-      compDefine1(defform,$EmptyMode,e)
-  else
-    [body,T] := $categoryTranForm
-    markFinish(body,T)
-
-  [d,m,e]
-
-compDefineCategory2(form,signature,specialCases,body,m,e,
-  $prefix,$formalArgList) ==
-    --1. bind global variables
-    $insideCategoryIfTrue: local:= true
-    $definition: local := nil
-                 --used by DomainSubstitutionFunction
-    $form: local := nil
-    $op: local := nil
-    $extraParms: local := nil
-             --Set in DomainSubstitutionFunction, used further down
---  1.1  augment e to add declaration $: <form>
-    [$op,:argl]:= $definition:= form
-    e:= addBinding("$",[['mode,:$definition]],e)
-
---  2. obtain signature
-    signature':=
-      [first signature,:[getArgumentModeOrMoan(a,$definition,e) for a in argl]]
-    e:= giveFormalParametersValues(argl,e)
-
---   3. replace arguments by $1,..., substitute into body,
---     and introduce declarations into environment
-    sargl:= TAKE(# argl, $TriangleVariableList)
-    $functorForm:= $form:= [$op,:sargl]
-    $formalArgList:= [:sargl,:$formalArgList]
-    aList:= [[a,:sa] for a in argl for sa in sargl]
-    formalBody:= SUBLIS(aList,body)
-    signature' := SUBLIS(aList,signature')
---Begin lines for category default definitions
-    $functionStats: local:= [0,0]
-    $functorStats: local:= [0,0]
-    $getDomainCode: local := nil
-    $addForm: local:= nil
-    for x in sargl for t in rest signature' repeat
-      [.,.,e]:= compMakeDeclaration(x,t,e)
-
---   4. compile body in environment of %type declarations for arguments
-    op':= $op
-    -- following line causes cats with no with or Join to be fresh copies
-    if opOf(formalBody) ~= 'Join and opOf(formalBody) ~= 'mkCategory then
-           formalBody := ['Join, formalBody]
-    T := compOrCroak(formalBody,signature'.target,e)
---------------------> new <-------------------
-    $catAddForm :=
-      $originalBody is ['add,y,:.] => y
-      $originalBody
-    $categoryTranForm := [$originalBody,[$form,['Mapping,:signature'],T.env]]
---------------------> new <-------------------
-    body:= optFunctorBody markKillAll T.expr
-    if $extraParms then
-      formals:=actuals:=nil
-      for u in $extraParms repeat
-        formals:=[first u,:formals]
-        actuals:=[MKQ rest u,:actuals]
-      body := ['sublisV,['PAIR,['QUOTE,formals],['%list,:actuals]],body]
-    if argl then body:=  -- always subst for args after extraparms
-        ['sublisV,['PAIR,['QUOTE,sargl],['%list,:
-          [['devaluate,u] for u in sargl]]],body]
-    body:=
-      ['PROG1,["%LET",g:= gensym(),body],
-         ['%store,['%tref,g,0],mkConstructor $functorForm]]
-    fun:= compile [op',['LAM,sargl,body]]
-
---  5. give operator a 'modemap property
-    pairlis:= pairList(argl,$FormalMapVariableList)
-    parSignature:= SUBLIS(pairlis,signature')
-    parForm:= SUBLIS(pairlis,form)
-----    lisplibWrite('"compilerInfo",
-----      ['SETQ,'$CategoryFrame,
-----       ['put,['QUOTE,op'],'
-----        (QUOTE isCategory),true,['addModemap,MKQ op',MKQ parForm,
-----          MKQ parSignature,true,MKQ fun,'$CategoryFrame]]],$libFile)
-    --Equivalent to the following two lines, we hope
-    if null sargl then
-      evalAndRwriteLispForm('NILADIC,
-            ['MAKEPROP,['QUOTE,op'],'(QUOTE NILADIC),true])
-
---   6. put modemaps into InteractiveModemapFrame
-    $domainShell :=
-      $convertingSpadFile => nil
-      eval [op',:MAPCAR('MKQ,sargl)]
-    $lisplibCategory:= formalBody
-----    if $LISPLIB then
-----      $lisplibForm:= form
-----      $lisplibKind:= 'category
-----      modemap:= [[parForm,:parSignature],[true,op']]
-----      $lisplibModemap:= modemap
-----      $lisplibCategory:= formalBody
-----      form':=[op',:sargl]
-----      augLisplibModemapsFromCategory(form',formalBody,signature')
-    [fun,'(Category),e]
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
deleted file mode 100644
index 7330a4c5..00000000
--- a/src/interp/wi2.boot
+++ /dev/null
@@ -1,1132 +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 macros
-import define
-namespace BOOT
-
--- ??? turns off buggy code
-$NRTopt := false
-
-compDefineFunctor1(df, m,$e,$prefix,$formalArgList) ==
-    ['DEF,form,signature,$functorSpecialCases,body] := df
-    signature := markKillAll signature
---  1. bind global variables
-    $addForm: local := nil
-    $functionStats: local:= [0,0]
-    $functorStats: local:= [0,0]
-    $DEFdepth :    local  := 0            --for conversion to new compiler 3/93
-    $capsuleStack : local := nil          --for conversion to new compiler 3/93
-    $predicateStack:local := nil          --for conversion to new compiler 3/93
-    $signatureStack:local := nil          --for conversion to new compiler 3/93
-    $importStack  : local := nil          --for conversion to new compiler 3/93
-    $globalImportStack  : local := nil    --for conversion to new compiler 3/93
-    $globalDeclareStack : local := nil
-    $globalImportDefAlist: local:= nil
-    $localMacroStack  : local := nil      --for conversion to new compiler 3/93
-    $freeStack   : local := nil           --for conversion to new compiler 3/93
-    $domainLevelVariableList: local := nil--for conversion to new compiler 3/93
-    $localLoopVariables: local := nil
-    $pathStack : local := nil
-    $form: local := nil
-    $op: local := nil
-    $signature: local := nil
-    $functorTarget: local := nil
-    $Representation: local := nil
-         --Set in doIt, accessed in the compiler - compNoStacking
-    $LocalDomainAlist: local  --set in doIt, accessed in genDeltaEntry
-    $LocalDomainAlist:= nil
-    $functorForm: local := nil
-    $functorLocalParameters: local := nil
-    $CheckVectorList: local := nil
-                  --prevents CheckVector from printing out same message twice
-    $getDomainCode: local -- code for getting views
-    $insideFunctorIfTrue: local:= true
-    $genSDVar: local:= 0
-    originale:= $e
-    [$op,:argl]:= form
-    $formalArgList:= [:argl,:$formalArgList]
-    $pairlis := pairList(argl,$FormalMapVariableList)
-    $mutableDomain: local :=
-      -- all defaulting packages should have caching turned off
-       isCategoryPackageName $op or   
-         (if $mutableDomains then MEMQ($op,$mutableDomains)
-            else false )   --true if domain has mutable state
-    signature':=
-      [first signature,:[getArgumentModeOrMoan(a,form,$e) for a in argl]]
-    $functorForm:= $form:= [$op,:argl]
-    $globalImportStack := 
-       [markKillAll x for x in rest $functorForm for typ in rest signature' 
-           | getConstructorKindFromDB opOf typ = "category"]
-    if null first signature' then signature':=
-      modemap2Signature getModemap($form,$e)
-    target:= first signature'
-    $functorTarget:= target
-    $e:= giveFormalParametersValues(argl,$e)
-    [ds,.,$e]:= compMakeCategoryObject(target,$e) or
---+ copy needed since slot1 is reset; compMake.. can return a cached vector
-      sayBrightly '"   cannot produce category object:"
-      pp target
-      return nil
-    $domainShell:= COPY_-SEQ ds
-    attributeList := ds.2 --see below under "loadTimeAlist"
---+ 7 lines for $NRT follow
--->--these globals used by NRTmakeCategoryAlist, set by NRTsetVector4Part1
-    $condAlist: local := nil
-    $uncondAlist: local := nil
--->>-- next global initialized here, reset by buildFunctor
-    $NRTslot1PredicateList: local :=
-      removeDuplicates [second x for x in attributeList]
--->>-- next global initialized here, used by NRTgenAttributeAlist (NRUNOPT)
-    $NRTattributeAlist: local := NRTgenInitialAttributeAlist attributeList
-    $NRTslot1Info: local := nil --set in NRTmakeSlot1Info
-       --this is used below to set $lisplibSlot1 global
-    $NRTaddForm: local := nil   -- see compAdd
-    $NRTdeltaList: local := nil --list of misc. elts used in compiled fncts
-    $NRTdeltaListComp: local := nil --list of compiled forms for $NRTdeltaList
-    $NRTdeltaLength: local := 0 -- =length of block of extra entries in vector
-    $template: local:= nil --stored in the lisplib
-    $functionLocations: local := nil --locations of defined functions in source
-    -- generate slots for arguments first, then for $NRTaddForm in compAdd
-    for x in argl repeat NRTgetLocalIndex x
-    [.,.,$e]:= compMakeDeclaration("$",target,$e)
-    --The following loop sees if we can economise on ADDed operations
-    --by using those of Rep, if that is the same. Example: DIRPROD
-    if not $insideCategoryPackageIfTrue  then
-      if body is ['add,ab:=[fn,:.],['CAPSULE,:cb]] and fn in '(List Vector)
-         and FindRep(cb) = ab
-               where FindRep cb ==
-                 u:=
-                   while cb repeat
-                     atom cb => return nil
-                     cb is [["%LET",'Rep,v,:.],:.] => return (u:=v)
-                     cb:=rest cb
-                 u
-      then $e:= augModemapsFromCategoryRep('_$,ab,cb,target,$e)
-      else $e:= augModemapsFromCategory('_$,'_$,'_$,target,$e)
-    $signature:= signature'
-    operationAlist:= SUBLIS($pairlis,$domainShell.1)
-    parSignature:= SUBLIS($pairlis,signature')
-    parForm:= SUBLIS($pairlis,form)
- 
---  (3.1) now make a list of the functor's local parameters; for
---  domain D in argl,check its signature: if domain, its type is Join(A1,..,An);
---  in this case, D is replaced by D1,..,Dn (gensyms) which are set
---  to the A1,..,An view of D
---+
-    $functorLocalParameters:=
-      argPars :=
-        makeFunctorArgumentParameters(argl,rest signature',first signature')
- -- must do above to bring categories into scope --see line 5 of genDomainView
-      argl
---  4. compile body in environment of %type declarations for arguments
-    op':= $op
-    rettype:= signature'.target
-    T:= compFunctorBody(body,rettype,$e,parForm)
----------------> new <---------------------
-    $convert2NewCompiler => 
-       return markFinish($originalBody,[$form,['Mapping,:signature'],T.env])
----------------> new <---------------------
-    -- If only compiling certain items, then ignore the body shell.
-    $compileOnlyCertainItems =>
-       reportOnFunctorCompilation()
-       [nil, ['Mapping, :signature'], originale]
- 
-    body':= T.expr
-    lamOrSlam:= if $mutableDomain then 'LAM else 'SPADSLAM
-    fun:= compile SUBLIS($pairlis, [op',[lamOrSlam,argl,body']])
-    --The above statement stops substitutions gettting in one another's way
---+
-    operationAlist := SUBLIS($pairlis,$lisplibOperationAlist)
-    if $LISPLIB then
-      augmentLisplibModemapsFromFunctor(parForm,operationAlist,parSignature)
-    reportOnFunctorCompilation()
- 
---  5. give operator a 'modemap property
-    $insideFunctorIfTrue:= false
-    if $LISPLIB then
-      $lisplibKind:=
-        $functorTarget is ["CATEGORY",key,:.] and key~="domain" => 'package
-        'domain
-      $lisplibForm:= form
-      modemap:= [[parForm,:parSignature],[true,op']]
-      $lisplibModemap:= modemap
-      if null $bootStrapMode then
-        $NRTslot1Info := NRTmakeSlot1Info()
-        $isOpPackageName: local := isCategoryPackageName $op
-        if $isOpPackageName then lisplibWrite('"slot1DataBase",
-          ['updateSlot1DataBase,MKQ $NRTslot1Info],$libFile)
-        $lisplibFunctionLocations := SUBLIS($pairlis,$functionLocations)
-        libFn := getConstructorAbbreviation op'
-        $lookupFunction: local :=
-            NRTgetLookupFunction($functorForm,$lisplibModemap.mmTarget,$NRTaddForm)
-            --either lookupComplete (for forgetful guys) or lookupIncomplete
-        $byteAddress :local := 0
-        $byteVec :local := nil
-        $NRTslot1PredicateList :=
-          [simpBool x for x in $NRTslot1PredicateList]
-        rwriteLispForm('loadTimeStuff,
-          ['MAKEPROP,MKQ $op,''infovec,getInfovecCode()])
-      $lisplibSlot1 := $NRTslot1Info --NIL or set by $NRTmakeSlot1
-      $lisplibOperationAlist:= operationAlist
-    lisplibWrite('"compilerInfo",
-       ['SETQ,'$CategoryFrame,
-        ['put,['QUOTE,op'],'
-         (QUOTE isFunctor),
-          ['QUOTE,operationAlist],['addModemap,['QUOTE,op'],['
-           QUOTE,parForm],['QUOTE,parSignature],true,['QUOTE,op'],
-            ['put,['QUOTE,op' ],'(QUOTE mode),
-             ['QUOTE,['Mapping,:parSignature]],'$CategoryFrame]]]],$libFile)
-    if null argl then
-      evalAndRwriteLispForm('NILADIC,
-            ['MAKEPROP, ['QUOTE,op'], ['QUOTE,'NILADIC], true])
-    [fun,['Mapping,:signature'],originale]
-
-makeFunctorArgumentParameters(argl,sigl,target) ==
-  $forceAdd: local:= true
-  $ConditionalOperators: local
-  target := markKillAll target
-  ("append"/[fn(a,augmentSig(s,findExtras(a,target)))
-              for a in argl for s in sigl]) where
-    findExtras(a,target) ==
-      --  see if conditional information implies anything else
-      --  in the signature of a
-      target is ['Join,:l] => "union"/[findExtras(a,x) for x in l]
-      target is ['CATEGORY,.,:l] => "union"/[findExtras1(a,x) for x in l] where
-        findExtras1(a,x) ==
-          x is ['AND,:l] => "union"/[findExtras1(a,y) for y in l]
-          x is ['OR,:l] => "union"/[findExtras1(a,y) for y in l]
-          x is ['IF,c,p,q] =>
-            union(findExtrasP(a,c),
-                  union(findExtras1(a,p),findExtras1(a,q))) where
-              findExtrasP(a,x) ==
-                x is ['AND,:l] => "union"/[findExtrasP(a,y) for y in l]
-                x is ['OR,:l] => "union"/[findExtrasP(a,y) for y in l]
-                x is ["has",=a,y] and y is ['SIGNATURE,:.] => [y]
-                nil
-        nil
-    augmentSig(s,ss) ==
-       -- if we find something extra, add it to the signature
-      null ss => s
-      for u in ss repeat
-        $ConditionalOperators:=[rest u,:$ConditionalOperators]
-      s is ['Join,:sl] =>
-        u:=ASSQ('CATEGORY,ss) =>
-          SUBST([:u,:ss],u,s)
-        ['Join,:sl,['CATEGORY,'package,:ss]]
-      ['Join,s,['CATEGORY,'package,:ss]]
-    fn(a,s) ==
-      isCategoryForm(s,$CategoryFrame) =>
-        s is ["Join",:catlist] => genDomainViewList(a,rest s)
-        [genDomainView(a,a,s,"getDomainView")]
-      [a]
-
-compDefineCapsuleFunction(df,m,oldE,$prefix,$formalArgList) ==
-    ['DEF,form,originalSignature,specialCases,body] := df
-    signature := markKillAll originalSignature
-    $markFreeStack: local := nil       --holds "free variables"
-    $localImportStack : local := nil   --local import stack for function
-    $localDeclareStack: local := nil   
-    $localLoopVariables: local := nil
-    originalDef := COPY df
-    [lineNumber,:specialCases] := specialCases
-    e := oldE
-    --1. bind global variables
-    $form: local := nil
-    $op: local := nil
-    $functionStats: local:= [0,0]
-    $argumentConditionList: local
-    $finalEnv: local := nil
-             --used by ReplaceExitEtc to get a common environment
-    $initCapsuleErrorCount: local:= #$semanticErrorStack
-    $insideCapsuleFunctionIfTrue: local:= true
-    $CapsuleModemapFrame: local:= e
-    $CapsuleDomainsInScope: local:= get("$DomainsInScope","special",e)
-    $insideExpressionIfTrue: local:= true
-    $returnMode:= m
-    [$op,:argl]:= form
-    $form:= [$op,:argl]
-    argl:= stripOffArgumentConditions argl
-    $formalArgList:= [:argl,:$formalArgList]
- 
-    --let target and local signatures help determine modes of arguments
-    argModeList:=
-      identSig:= hasSigInTargetCategory(argl,form,first signature,e) =>
-        (e:= checkAndDeclare(argl,form,identSig,e); rest identSig)
-      [getArgumentModeOrMoan(a,form,e) for a in argl]
-    argModeList:= stripOffSubdomainConditions(argModeList,argl)
-    signature':= [first signature,:argModeList]
-    if null identSig then  --make $op a local function
-      oldE := put($op,'mode,['Mapping,:signature'],oldE)
- 
-    --obtain target type if not given
-    if null first signature' then signature':=
-      identSig => identSig
-      getSignature($op,rest signature',e) or return nil
-    e:= giveFormalParametersValues(argl,e)
- 
-    $signatureOfForm:= signature' --this global is bound in compCapsuleItems
-    $functionLocations := [[[$op,$signatureOfForm],:lineNumber],
-      :$functionLocations]
-    e:= addDomain(first signature',e)
-    e:= compArgumentConditions e
- 
-    if $profileCompiler then
-      for x in argl for t in rest signature' repeat profileRecord('arguments,x,t)
- 
- 
-    --4. introduce needed domains into extendedEnv
-    for domain in signature' repeat e:= addDomain(domain,e)
- 
-    --6. compile body in environment with extended environment
-    rettype:= resolve(signature'.target,$returnMode)
- 
-    localOrExported :=
-      not MEMQ($op,$formalArgList) and
-        getmode($op,e) is ['Mapping,:.] => 'local
-      'exported
- 
-    --6a skip if compiling only certain items but not this one
-    -- could be moved closer to the top
-    formattedSig := formatUnabbreviated ['Mapping,:signature']
-    $compileOnlyCertainItems and _
-      not member($op, $compileOnlyCertainItems) =>
-        sayBrightly ['"   skipping ", localOrExported,:bright $op]
-        [nil,['Mapping,:signature'],oldE]
-    sayBrightly ['"   compiling ",localOrExported,
-      :bright $op,'": ",:formattedSig]
----------------------> new <---------------------------------
-    returnType := signature'.target
---  trialT := returnType = "$" and get("Rep",'value,e) and comp(body,'Rep,e)
-    trialT := returnType = "$" and comp(body,$EmptyMode,e)
-    ------------------------------------------------------  11/1/94    
-    -- try comp-ing in $EmptyMode; if succeed 
-    --   if we succeed then trialT.mode = "$" or "Rep"
-    --   do a coerce to get the correct result
-    T := (trialT and coerce(trialT,returnType)) 
-         -------------------------------------- 11/1/94
-          or CATCH('compCapsuleBody, compOrCroak(body,returnType,e))
-    markChanges(originalDef,T,$signatureOfForm)
-    [nil,['Mapping,:signature'],oldE]
-    ---------------------------------
- 
-compCapsuleInner(itemList,m,e) ==
-  e:= addInformation(m,e)
-           --puts a new 'special' property of $Information
-  data:= ["PROGN",:itemList]
-      --RPLACd by compCapsuleItems and Friends
-  e:= compCapsuleItems(itemList,nil,e)
-  $convert2NewCompiler => 
-     [nil,m,e] --nonsense but that's fine
-  localParList:= $functorLocalParameters
-  if $addForm then data:= ['add,$addForm,data]
-  code:=
-    $insideCategoryIfTrue and not $insideCategoryPackageIfTrue => data
-    processFunctor($form,$signature,data,localParList,e)
-  [MKPF([:$getDomainCode,code],"PROGN"),m,e]
-
-compSingleCapsuleItem(item,$predl,$e) ==
-  $localImportStack : local := nil
-  $localDeclareStack: local := nil
-  $markFreeStack: local := nil
-  newItem := macroExpandInPlace(item,qe(25,$e))
-  qe(26,$e)
-  doIt(newItem, $predl)
-  qe(27,$e)
-  $e
- 
-compImport(["import",:doms],m,e) ==
-  for dom in doms repeat 
-    dom := markKillAll dom
-    markImport dom
-    e:=addDomain(dom,e)
-  ["/throwAway",$NoValueMode,e]
- 
-mkUnion(a,b) ==
-  b="$" and $Rep is ["Union",:l] => b
-  a is ["Union",:l] =>
-    b is ["Union",:l'] => ["Union",:setUnion(l,l')]
-    member(b, l) => a
-    ["Union",:setUnion([b],l)]
-  b is ["Union",:l] => 
-    member(a, l) => b
-    ["Union",:setUnion([a],l)]
-  string? a => ["Union",b,a]
-  ["Union",a,b]
-
-compForMode(x,m,e) ==
-  $compForModeIfTrue: local:= true
-  $convert2NewCompiler: local := nil
-  comp(x,m,e)
- 
-compMakeCategoryObject(c,$e) ==
-  not isCategoryForm(c,$e) => nil
-  c := markKillAll c
-  u:= mkEvalableCategoryForm c => [eval markKillAll u,$Category,$e]
-  nil
- 
-macroExpand(x,e) ==   --not worked out yet
-  atom x => (u:= get(x,'macro,e) => macroExpand(u,e); x)
-  x is ['DEF,lhs,sig,spCases,rhs] =>
-    ['DEF,macroExpand(lhs,e), macroExpandList(sig,e),macroExpandList(spCases,e),
-      macroExpand(rhs,e)]
-  x is ['MI,a,b] => 
-      ['MI,a,macroExpand(b,e)]
-  macroExpandList(x,e)
- 
---======================================================================
---                    From apply.boot
---======================================================================
-applyMapping([op,:argl],m,e,ml) ==
-  #argl~=#ml-1 => nil
-  isCategoryForm(first ml,e) =>
-                                --is op a functor?
-    pairlis:= pairList(argl,$FormalMapVariableList)
-    ml' := SUBLIS(pairlis, ml)
-    argl':=
-      [T.expr for x in argl for m' in rest ml'] where
-        T() == [.,.,e]:= comp(x,m',e) or return "failed"
-    if argl'="failed" then return nil
-    form:= [op,:argl']
----------------------> new <----------------------------
-    if constructor? op then form := markKillAll form
----------------------> new <----------------------------
-    convert([form,first ml',e],m)
-  argl':=
-    [T.expr for x in argl for m' in rest ml] where
-      T() == [.,.,e]:= comp(x,m',e) or return "failed"
-  if argl'="failed" then return nil
-  form:=
-    not MEMQ(op,$formalArgList) and atom op and not get(op,'value,e) =>
-      nprefix := $prefix or
-   -- following needed for referencing local funs at capsule level
-        getAbbreviation($op,#rest $form)
-      [op',:argl',"$"] where
-        op':= makeSymbol strconc(encodeItem nprefix,";",encodeItem op)
-    ['%call,['applyFun,op],:argl']
-  pairlis := pairList(argl',$FormalMapVariableList)
-  convert([form,SUBLIS(pairlis,first ml),e],m)
- 
-compFormWithModemap(form,m,e,modemap) ==
-  compFormWithModemap1(form,m,e,modemap,true) or compFormWithModemap1(form,m,e,modemap,false)
-
-compFormWithModemap1(form,m,e,modemap,Rep2Dollar?) ==
-  [op,:argl] := form := markKillExpr form
-  [[dc,:.],:.] := modemap
-----------> new: <-----------
-  if Rep2Dollar? then 
-    if dc = 'Rep then
-      modemap := SUBST('Rep,'_$,modemap)
-      m       := SUBST('Rep,'_$,m)
-    else return nil
-----------> new: <-----------
-  [map:= [.,target,:.],[pred,impl]]:= modemap
-  -- this fails if the subsuming modemap is conditional
-  --impl is ['Subsumed,:.] => nil
-  if isCategoryForm(target,e) and isFunctor op then
-    [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil
-    [map:= [.,target,:.],:cexpr]:= modemap
-  sv:=listOfSharpVars map
-  if sv then
-     -- SAY [ "compiling ", op, " in compFormWithModemap,
-     -- mode= ",map," sharp vars=",sv]
-    for x in argl for ss in $FormalMapVariableList repeat
-      if ss in sv then
-        [map:= [.,target,:.],:cexpr]:= modemap :=SUBST(x,ss,modemap)
-        -- SAY ["new map is",map]
-  not (target':= coerceable(target,m,e)) => nil
-  markMap := map
-  map:= [target',:rest map]
-  [f,Tl,sl]:= compApplyModemap(form,modemap,e) or return nil
- 
-  --generate code; return
-  T:=
-    e':=
-      Tl => last(Tl).env
-      e
-    [x',m',e'] where
-      m':= SUBLIS(sl,map.1)
-      x':=
-        form':= [f,:[t.expr for t in Tl]]
-        m'=$Category or isCategoryForm(m',e) => form'
-        -- try to deal with new-style Unions where we know the conditions
-        op = "elt" and f is ['XLAM,:.] and IDENTP(z:=first argl) and
-          (c:=get(z,'condition,e)) and
-            c is [["case",=z,c1]] and
-              (c1 is ['_:,=(second argl),=m] or EQ(c1,second argl) ) =>
--- first is a full tag, as placed by getInverseEnvironment
--- second is what getSuccessEnvironment will place there
-                ['%tail,z]
-        markTran(form,form',markMap,e')
-  qt(18,T)
-  convert(T,m)
-
-convert(T,m) ==
-  tcheck T
-  qe(23,T.env)
-  coerce(T,resolve(T.mode,m) or return nil)
-
-compElt(origForm,m,E) ==
-  form := markKillAll origForm
-  form isnt ["elt",aDomain,anOp] => compForm(origForm,m,E)
-  aDomain="Lisp" =>
-    markLisp([anOp',m,E],E)where anOp'() == (anOp=$Zero => 0; anOp=$One => 1; anOp)
-  isDomainForm(aDomain,E) =>
-    markImport opOf aDomain
-    E:= addDomain(aDomain,E)
-    mmList:= getModemapListFromDomain(anOp,0,aDomain,E)
-    modemap:=
-      n:=#mmList
-      1=n => mmList.0
-      0=n =>
-        return
-          stackMessage ['"Operation ","%b",anOp,"%d",
-                         '"missing from domain: ", aDomain]
-      stackWarning ['"more than 1 modemap for: ",anOp,
-                  '" with dc=",aDomain,'" ===>"
-        ,mmList]
-      mmList.0
-----------> new: <-----------
-    if aDomain = 'Rep then
-      modemap := SUBST('Rep,'_$,modemap)
-      m       := SUBST('Rep,'_$,m)
-----------> new: <-----------
-    [sig,[pred,val]]:= modemap
-    #sig~=2 and val isnt ["CONST",:.] => nil
---+
-    val := genDeltaEntry([opOf anOp,:modemap],E)
-    x := markTran(origForm,[val],sig,[E])
-    [x,second sig,E] --implies fn calls used to access constants
-  compForm(origForm,m,E)
- 
-pause op == op
-compApplyModemap(form,modemap,$e) ==
-  sl := nil
-  [op,:argl] := form                   --form to be compiled
-  [[mc,mr,:margl],:fnsel] := modemap   --modemap we are testing
- 
-  -- $e     is the current environment
-  -- sl     substitution list, nil means bottom-up, otherwise top-down
- 
-  -- 0.  fail immediately if #argl=#margl
- 
-  if #argl~=#margl then return nil
- 
-  -- 1.  use modemap to evaluate arguments, returning failed if
-  --     not possible
- 
-  lt:=
-    [[.,m',$e]:=
-      comp(y,g,$e) or return "failed" where
-        g:= SUBLIS(sl,m) where
-            sl:= pmatchWithSl(m',m,sl) for y in argl for m in margl]
-  lt="failed" => return nil
- 
-  -- 2.  coerce each argument to final domain, returning failed
-  --     if not possible
- 
-  lt':= [coerce(y,d) or return "failed"
-         for y in lt for d in SUBLIS(sl,margl)]
-  lt'="failed" => return nil
- 
-  -- 3.  obtain domain-specific function, if possible, and return
- 
-  --$bindings is bound by compMapCond
-  [f,$bindings]:= compMapCond(op,mc,sl,fnsel) or return nil
- 
---+ can no longer trust what the modemap says for a reference into
---+ an exterior domain (it is calculating the displacement based on view
---+ information which is no longer valid; thus ignore this index and
---+ store the signature instead.
- 
---$NRTflag=true and f is [op1,d,.] and NE(d,'$) and member(op1,'(ELT CONST)) =>
-  f is [op1,d,.] and op1 in '(ELT CONST Subsumed) =>
-    [genDeltaEntry([op,:modemap],$e),lt',$bindings]
-  markImport mc
-  [f,lt',$bindings]
- 
-compMapCond''(cexpr,dc) ==
-  cexpr=true => true
-  --cexpr = "true" => true
----------------> new <----------------------
-  cexpr is [op,:l] and op in '(and AND) => and/[compMapCond''(u,dc) for u in l]
-  cexpr is [op,:l] and op in '(or OR)   => or/[compMapCond''(u,dc) for u in l]
----------------> new <----------------------
-  cexpr is ["not",u] => not compMapCond''(u,dc)
-  cexpr is ["has",name,cat] => (knownInfo cexpr => true; false)
-        --for the time being we'll stop here - shouldn't happen so far
-        --$disregardConditionIfTrue => true
-        --stackSemanticError(("not known that",'"%b",name,
-        -- '"%d","has",'"%b",cat,'"%d"),nil)
-  --now it must be an attribute
-  member(["ATTRIBUTE",dc,cexpr],get("$Information","special",$e)) => true
-  --for the time being we'll stop here - shouldn't happen so far
-  stackMessage ["not known that",'"%b",dc,'"%d","has",'"%b",cexpr,'"%d"]
-  false
- 
---======================================================================
---                    From nruncomp.boot
---======================================================================
-optCallEval u ==
-  u is ["List",:.] => List Integer()
-  u is ["Vector",:.] => Vector Integer()
-  u is ["PrimitiveArray",:.] => PrimitiveArray Integer()
-  u is ["FactoredForm",:.] => FactoredForm Integer()
-  u is ["Matrix",:.] => Matrix Integer()
-  eval u
- 
-optDeltaEntry(op,sig,dc,eltOrConst) ==
-  return nil    --------> kill it
-  $killOptimizeIfTrue = true => nil
-  ndc :=
-    dc = '$ => $functorForm
-    atom dc and (dcval := get(dc,'value,$e)) => dcval.expr
-    dc
---if (atom dc) and (dcval := get(dc,'value,$e))
---   then ndc := dcval.expr
---   else ndc := dc
-  sig := SUBST(ndc,dc,sig)
-  not optimizableDomain? ndc => nil
-  dcval := optCallEval ndc
-  -- MSUBST guarantees to use EQUAL testing
-  sig := MSUBST(devaluate dcval, ndc, sig)
-  if rest ndc then
-     for new in rest devaluate dcval for old in rest ndc repeat
-       sig := MSUBST(new,old,sig)
-     -- optCallEval sends (List X) to (LIst (Integer)) etc,
-     -- so we should make the same transformation
-  fn := compiledLookup(op,sig,dcval)
-  if null fn then
-    -- following code is to handle selectors like first, rest
-     nsig := [quoteSelector tt for tt in sig] where
-       quoteSelector(x) ==
-         not(IDENTP x) => x
-         get(x,'value,$e) => x
-         x='$ => x
-         MKQ x
-     fn := compiledLookup(op,nsig,dcval)
-     if null fn then return nil
-  eltOrConst="CONST" => 
-     hehe fn
-     [op]                    -----------> return just the op here
---   ['XLAM,'ignore,MKQ SPADCALL fn]
-  getFunctionReplacement first fn
- 
-genDeltaEntry(opMmPair,e) ==
---called from compApplyModemap
---$NRTdeltaLength=0.. always equals length of $NRTdeltaList
-  [.,[odc,:.],.] := opMmPair
-  --opModemapPair := SUBLIS($LocalDomainAlist,opMmPair)
-  [op,[dc,:sig],[.,cform:=[eltOrConst,:.]]] := opMmPair
-  if $profileCompiler = true then 
-    profileRecord(dc,op,sig)
---  markImport dc
-  eltOrConst = 'XLAM => cform
-  if eltOrConst = 'Subsumed then eltOrConst := 'ELT
-    -- following hack needed to invert Rep to $ substitution
-  if odc = 'Rep and cform is [.,.,osig] then sig:=osig
-  newimp := optDeltaEntry(op,sig,dc,eltOrConst) => newimp
-  setDifference(listOfBoundVars dc,$functorLocalParameters) ~= [] =>
-    ['applyFun,['compiledLookupCheck,MKQ op,
-         mkList consSig(sig,dc),consDomainForm(dc,nil)]]
- --if cons? dc then
- --   sig := substitute('$,dc,sig)
- --   cform := substitute('$,dc,cform)
-  opModemapPair :=
-    [op,[dc,:[genDeltaSig x for x in sig]],['T,cform]] -- force pred to T
-  if null NRTassocIndex dc and
-    (member(dc,$functorLocalParameters) or cons? dc) then
-    --create "%domain" entry to $NRTdeltaList
-      $NRTdeltaList:= [["%domain",NRTaddInner dc,:dc],:$NRTdeltaList]
-      saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
-      $NRTdeltaLength := $NRTdeltaLength+1
-      compEntry:=
-        dc
-      saveNRTdeltaListComp.first := compEntry
-      chk(saveNRTdeltaListComp,102)
-  u :=
-    [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index() ==
-      (n:= POSN1(opModemapPair,$NRTdeltaList)) => n + 1
-        --n + 1 since $NRTdeltaLength is 1 too large
-      $NRTdeltaList:= [opModemapPair,:$NRTdeltaList]
-      $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
-      $NRTdeltaLength := $NRTdeltaLength+1
-      0
-  u
-
---======================================================================
---                    From nruncomp.boot
---======================================================================
-parseIf t ==
-  t isnt [p,a,b] => t
-  ifTran(parseTran p,parseTran a,parseTran b) where
-    ifTran(p,a,b) ==
-      null($InteractiveMode) and p='true  => a
-      null($InteractiveMode) and p='false  => b
-      p is ['not,p'] => ifTran(p',b,a)
-      p is ['IF,p',a',b'] => ifTran(p',ifTran(a',COPY a,COPY b),ifTran(b',a,b))
-      p is ['SEQ,:l,['exit,1,p']] =>
-        ['SEQ,:l,['exit,1,ifTran(p',incExitLevel a,incExitLevel b)]]
-         --this assumes that l has no exits
-      a is ['IF, =p,a',.] => ['IF,p,a',b]
-      b is ['IF, =p,.,b'] => ['IF,p,a,b']
---      makeSimplePredicateOrNil p is ['SEQ,:s,['exit,1,val]] =>
---        parseTran ['SEQ,:s,['exit,1,incExitLevel ['IF,val,a,b]]]
-      ['IF,p,a,b]
-
---======================================================================
---                         From parse.boot
---======================================================================
-parseNot u ==  ['not,parseTran first u]
-
-makeSimplePredicateOrNil p == nil
- 
---======================================================================
---                         From g-cndata.boot
---======================================================================
-mkUserConstructorAbbreviation(c,a,type) ==
-  if $AnalyzeOnly or $convert2NewCompiler then
-    $abbreviationStack := [[type,a,:c],:$abbreviationStack]
-  if cons? c then c:= first c  --  Existing constructors will be wrapped
-  constructorAbbreviationErrorCheck(c,a,type,'abbreviationError)
-  clearClams()
-  clearConstructorCache(c)
-  installConstructor(c,type)
-  setAutoLoadProperty(c)
- 
---======================================================================
---                         From iterator.boot
---======================================================================
-
-compreduce(form is [.,op,x],m,e) ==
-  T := compForm(form,m,e) or return nil
-  y := T.expr
-  y.first := "REDUCE"
-  ------------------<== distinquish this as the special reduce form
-  (y is ["REDUCE",:.]) and (id:= getIdentity(op,e)) and (u := comp0(id,m,e)) and
-    # getNumberTypesInScope() > 1 => markSimpleReduce([:y, ["@",u.expr,m]], T)
-  T
-
-compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) ==
--------------------------------> 11/28 all new to preserve collect forms
-  markImport m
-  [collectOp,:itl,body]:= collectForm
-  $e:= e
-  itl:= [([.,$e]:= compIterator(x,$e) or return "failed").0 for x in itl]
-  itl="failed" => return nil
-  e:= $e
-  T0 := comp0(body,m,e) or return nil
-  md := T0.mode
-  T1 := compOrCroak(collectForm,["List",md],e) 
-  T  := [["REDUCE",op,nil,T1.expr],md,T1.env]
-  markReduce(form,T)
- 
-compIterator(it,e) ==
-  it is ["IN",x,y] =>
-    --these two lines must be in this order, to get "for f in list f"
-    --to give  an error message if f is undefined
-  ---------------> new <---------------------
-    [y',m,e] := markInValue(y, e)
-    x := markKillAll x
-    ------------------
-    $formalArgList:= [x,:$formalArgList]
-    [.,mUnder]:=
-      modeIsAggregateOf("List",m,e) or modeIsAggregateOf("Vector",m,e) or return
-         stackMessage ["mode: ",m," must be a list or vector of some mode"]
-    if null get(x,"mode",e) then [.,.,e]:=
-      compMakeDeclaration(x,mUnder,e) or return nil
-    e:= giveVariableSomeValue(x,mUnder,e)
-    markReduceIn(it, [["IN",x,y'],e])
-  it is ["ON",x,y] =>
----------------> new <---------------------
-    x := markKillAll x
-    ------------------
-    $formalArgList:= [x,:$formalArgList]
-    y := markKillAll y
-    markImport m
----------------> new <---------------------
-    [y',m,e]:= comp(y,$EmptyMode,e) or return nil
-    [.,mUnder]:=
-      modeIsAggregateOf("List",m,e) or return
-        stackMessage ["mode: ",m," must be a list of other modes"]
-    if null get(x,"mode",e) then [.,.,e]:=
-      compMakeDeclaration(x,m,e) or return nil
-    e:= giveVariableSomeValue(x,m,e)
-    [["ON",x,y'],e]
-  it is ["STEP",oindex,start,inc,:optFinal] =>
-    index := markKillAll oindex
-    $formalArgList:= [index,:$formalArgList]
-    --if all start/inc/end compile as small integers, then loop
-    --is compiled as a small integer loop
-    final':= nil
----------------> new <---------------------
-    u := smallIntegerStep(it,index,start,inc,optFinal,e) => u
----------------> new <---------------------
-    [start,.,e]:=
-      comp(markKillAll start,$Integer,e) or return
-        stackMessage ["start value of index: ",start," must be an integer"]
-    [inc,.,e]:=
-      comp(markKillAll inc,$Integer,e) or return
-        stackMessage ["index increment:",inc," must be an integer"]
-    if optFinal is [final] then
-      [final,.,e]:=
-        comp(markKillAll final,$Integer,e) or return
-          stackMessage ["final value of index: ",final," must be an integer"]
-      optFinal:= [final]
-    indexmode:=
-      comp(third it,$NonNegativeInteger,e) => $NonNegativeInteger
-      $Integer
---  markImport ['Segment,indexmode]
-    if null get(index,"mode",e) then [.,.,e]:=
-      compMakeDeclaration(index,indexmode,e) or return nil
-    e:= giveVariableSomeValue(index,indexmode,e)
-    markReduceStep(it, [["STEP",markStep(index),start,inc,:optFinal],e])
-  it is ["WHILE",p] =>
-    [p',m,e]:=
-      comp(p,$Boolean,e) or return
-        stackMessage ["WHILE operand: ",p," is not Boolean valued"]
-    markReduceWhile(it, [["WHILE",p'],e])
-  it is ["UNTIL",p] => markReduceUntil(it, ($until:= p; ['$until,e]))
-  it is ["|",x] =>
-    u:=
-      comp(x,$Boolean,e) or return
-        stackMessage ["SUCHTHAT operand: ",x," is not Boolean value"]
-    markReduceSuchthat(it, [["|",u.expr],u.env])
-  nil
-
-smallIntegerStep(it,index,start,inc,optFinal,e) ==
-  start    := markKillAll start
-  inc      := markKillAll inc
-  optFinal := markKillAll optFinal
-  startNum := source2Number start
-  incNum   := source2Number inc
-  mode := get(index,"mode",e) 
---fail if
-----> a) index has a mode that is not $SmallInteger
-----> b) one of start,inc, final won't comp as a $SmallInteger
-  mode and mode ~= $SmallInteger => nil
-  null (start':= comp(start,$SmallInteger,e)) => nil
-  null (inc':= comp(inc,$SmallInteger,start'.env)) => nil
-  if optFinal is [final] and not (final':= comp(final,$SmallInteger,inc'.env)) then
---    not (integer? startNum and integer? incNum) => return nil
---    null integer? startNum or abs startNum > 100 => return nil
-    -----> assume that optFinal is $SmallInteger
-    T := comp(final,$EmptyMode,inc'.env) or return nil
-    final' := T
-    maximalSuperType T.mode ~= $Integer => return nil
-    givenRange := T.mode
-  indexmode:= $SmallInteger
-  [.,.,e]:= compMakeDeclaration(index,indexmode,
-     (final' => final'.env; inc'.env)) or return nil
-  range :=
-    integer? startNum and integer? incNum =>
-      startNum >  0 and incNum > 0 => $PositiveInteger
-      startNum <  0 and incNum < 0 => $NegativeInteger
-      incNum >  0 => $NonNegativeInteger   --startNum = 0
-      $NonPositiveInteger
-    givenRange => givenRange
-    nil
-  e:= put(index,"range",range,e)
-  e:= giveVariableSomeValue(index,indexmode,e)
-  noptFinal := 
-    final' => 
-      [final'.expr]
-    nil
-  [markStepSI(it,["ISTEP",index,start'.expr,inc'.expr,:noptFinal]),e]
-
-source2Number n ==
-  n := markKillAll n
-  n = $Zero => 0
-  n = $One  => 1
-  n
-
-compRepeatOrCollect(form,m,e) ==
-  fn(form,[m,:$exitModeStack],[#$exitModeStack,:$leaveLevelStack],$formalArgList
-    ,e) where
-      fn(form,$exitModeStack,$leaveLevelStack,$formalArgList,e) ==
-        $until: local
-        [repeatOrCollect,:itl,body]:= form
-        itl':=
-          [([x',e]:= compIterator(x,e) or return "failed"; x') for x in itl]
-        itl'="failed" => nil
-        targetMode:= first $exitModeStack
---        pp '"---------"
---        pp targetMode
-        bodyMode:=
-          repeatOrCollect="COLLECT" =>
-            targetMode = '$EmptyMode => '$EmptyMode
-            (u:=modeIsAggregateOf('List,targetMode,e)) =>
-              second u
-            (u:=modeIsAggregateOf('Vector,targetMode,e)) =>
-              repeatOrCollect:='COLLECTV
-              second u
-            stackMessage('"Invalid collect bodytype")
-            return nil
-            -- If we're doing a collect, and the type isn't conformable
-            -- then we've boobed. JHD 26.July.1990
-          $NoValueMode
-        [body',m',e']:= T :=
-          -- (m1:= listOrVectorElementMode targetMode) and comp(body,m1,e) or
-            compOrCroak(body,bodyMode,e) or return nil
-        markRepeatBody(body, T)
-        if $until then
-          [untilCode,.,e']:= comp($until,$Boolean,e')
-          itl':= substitute(["UNTIL",untilCode],'$until,itl')
-        form':= [repeatOrCollect,:itl',body']
-        m'':=
-          repeatOrCollect="COLLECT" =>
-            (u:=modeIsAggregateOf('List,targetMode,e)) => first u
-            ["List",m']
-          repeatOrCollect="COLLECTV" =>
-            (u:=modeIsAggregateOf('Vector,targetMode,e)) => first u
-            ["Vector",m']
-          m'
---------> new <--------------
-        markImport m''
---------> new <--------------
-        markRepeat(form,coerceExit([form',m'',e'],targetMode))
- 
-chaseInferences(origPred,$e) ==
-  pred := markKillAll origPred
-  ----------------------------12/4/94 do this immediately
-  foo hasToInfo pred where
-    foo pred ==
-      knownInfo pred => nil
-      $e:= actOnInfo(pred,$e)
-      pred:= infoToHas pred
-      for u in get("$Information","special",$e) repeat
-        u is ['%when,:l] =>
-          for [ante,:conseq] in l repeat
-            ante=pred => [foo w for w in conseq]
-            ante is ["and",:ante'] and member(pred,ante') =>
-              ante':= delete(pred,ante')
-              v':=
-                # ante'=1 => first ante'
-                ["and",:ante']
-              v':= ['%when,[v',:conseq]]
-              member(v',get("$Information","special",$e)) => nil
-              $e:=
-                put("$Information","special",[v',:
-                  get("$Information","special",$e)],$e)
-            nil
-  $e
- 
---======================================================================
---                   doit Code
---======================================================================
-doIt(item,$predl) ==
-  $GENNO: local:= 0
-  $coerceList: local := nil
-  --->                 
-  if item is ['PART,.,a] then item := a
-  -------------------------------------
-  item is ['SEQ,:.] => doItSeq item
-  isDomainForm(item,$e) => doItDomain item
-  item is ["%LET",:.] => doItLet item
-  item is [":",a,t] => [.,.,$e]:= 
-    markDeclaredImport markKillAll t
-    compOrCroak(item,$EmptyMode,$e)
-  item is ["import",:doms] =>
-     item := ["import",:(doms := markKillAll doms)]
-     for dom in doms repeat
-       sayBrightly ['"   importing ",:formatUnabbreviated dom]
-     [.,.,$e] := compOrCroak(item,$EmptyMode,$e)
-     wiReplaceNode(item,'(PROGN),10)
-  item is ["IF",:.] => doItIf(item,$predl,$e)
-  item is ["where",b,:l] => compOrCroak(item,$EmptyMode,$e)
-  item is ["MDEF",:.] => [.,.,$e]:= compOrCroak(item,$EmptyMode,$e)
-  item is ['DEF,:.] => doItDef item
-  T:= compOrCroak(item,$EmptyMode,$e) => doItExpression(item,T)
-  true => cannotDo()
-
-holdIt item == item
- 
-doItIf(item is [.,p,x,y],$predl,$e) ==
-  olde:= $e
-  [p',.,$e]:= qt(19,comp(p,$Boolean,$e)) or userError ['"not a Boolean:",p]
-  oldFLP:=$functorLocalParameters
-  if x~="%noBranch" then
---> new <-----------------------
-    qe(20,compSingleCapsuleItem(x,[p,:$predl],getSuccessEnvironment(markKillAll p,$e)))
----> new                                                 -----------
-    x':=localExtras(oldFLP)
-          where localExtras(oldFLP) ==
-            EQ(oldFLP,$functorLocalParameters) => NIL
-            flp1:=$functorLocalParameters
-            oldFLP':=oldFLP
-            n:=0
-            while oldFLP' repeat
-              oldFLP':=rest oldFLP'
-              flp1:=rest flp1
-              n:=n+1
-            -- Now we have to add code to compile all the elements
-            -- of functorLocalParameters that were added during the
-            -- conditional compilation
-            nils:=ans:=[]
-            for u in flp1 repeat -- is =u form always an atom?
-              if atom u or (or/[v is [.,=u,:.] for v in $getDomainCode])
-                then
-                  nils:=[u,:nils]
-                else
-                  gv := gensym()
-                  ans:=[["%LET",gv,u],:ans]
-                  nils:=[gv,:nils]
-              n:=n+1
-
-            $functorLocalParameters:=[:oldFLP,:reverse nils]
-            reverse ans
-  oldFLP:=$functorLocalParameters
-  if y~="%noBranch" then
---> new <-----------------------
-    qe(21,compSingleCapsuleItem(y,[['not, p],:$predl],getInverseEnvironment(markKillAll p,olde)))
--->                                                      ----------- 
-    y':=localExtras(oldFLP)
-  wiReplaceNode(item,['%when,[p',x,:x'],['%otherwise,y,:y']],12)
-
-doItSeq item == 
-  ['SEQ,:l,['exit,1,x]] := item
-  item.first := "PROGN"
-  lastNode(item).first := x
-  for it1 in rest item repeat $e:= compSingleCapsuleItem(it1,$predl,$e)
-
-doItDomain item ==
-  -- convert naked top level domains to import
-  u:= ["import", [first item,:rest item]]
-  markImport second u
-  stackWarning ["Use: import ", [first item,:rest item]]
---wiReplaceNode(item, u, 14)
-  item.first := first u
-  item.rest := rest u
-  doIt(item,$predl)
-
-doItLet item ==
-  qe(3,$e)
-  res := doItLet1 item
-  qe(4,$e)
-  res
- 
-doItLet1 item ==
-  ["%LET",lhs,rhs,:.] := item
-  not (compOrCroak(item,$EmptyMode,$e) is [code,.,$e]) =>
-      stackSemanticError(["cannot compile assigned value to",:bright lhs],nil)
-  qe(5,$e)
-  code := markKillAll code
-  not (code is ["%LET",lhs',rhs',:.] and atom lhs') =>
-      code is ["PROGN",:.] =>
-         stackSemanticError(["multiple assignment ",item," not allowed"],nil)
-      wiReplaceNode(item, code, 24)
-  lhs:= lhs'
-  if not member(KAR rhs,$NonMentionableDomainNames) and
-      not MEMQ(lhs, $functorLocalParameters) then
-         $functorLocalParameters:= [:$functorLocalParameters,lhs]
-  if (rhs' := rhsOfLetIsDomainForm code) then
-      if isFunctor rhs' then
-        $globalImportDefAlist := pp [[lhs, :rhs'],:$globalImportDefAlist]
-      if lhs="Rep" then
-        $Representation:= (get("Rep",'value,$e)).expr
-           --$Representation bound by compDefineFunctor, used in compNoStacking
---+
-        if $NRTopt = true
-          then NRTgetLocalIndex $Representation
---+
-      $LocalDomainAlist:= --see genDeltaEntry
-        [[lhs,:SUBLIS($LocalDomainAlist,(get(lhs,'value,$e)).0)],:$LocalDomainAlist]
---+
-  qe(6,$e)
-  code is ["%LET",:.] =>
-      rhsCode:= rhs'
-      op := '%store
-      wiReplaceNode(item,[op,['%tref,'$,NRTgetLocalIndex lhs],rhsCode], 16)
-  wiReplaceNode(item, code, 18)
-
-rhsOfLetIsDomainForm code ==
-  code is ["%LET",.,rhs',:.] =>
-    isDomainForm(rhs',$e) => rhs'
-    isDomainForm(rhs' := markKillAll rhs',$e) => rhs'
-    false
-  false
-
-doItDef item == 
-  ['DEF,[op,:.],:.] := item
-  body:= isMacro(item,$e) => $e := putMacro(op,body,$e)
-  [.,.,$e]:= t:= compOrCroak(item,$EmptyMode,$e)
-  chk(item,3)
-  item.first := "CodeDefine"
-        --Note that DescendCode, in CodeDefine, is looking for this
-  second(item).rest := [$signatureOfForm]
-  chk(item,4)
-      --This is how the signature is updated for buildFunctor to recognise
---+
-  functionPart:= ['dispatchFunction,t.expr]
-  wiReplaceNode(CDDR item,[functionPart], 20)
-  chk(item, 30)
-
-doItExpression(item,T) ==
-  SETQ($ITEM,COPY item)
-  SETQ($T1,COPY T.expr)
-  chk(T.expr, 304)
-  u := markCapsuleExpression(item, T)
-  [code,.,$e]:= u
-  wiReplaceNode(item,code, 22)
-
-wiReplaceNode(node,ocode,key) ==
-  ncode := [first ocode,:rest ocode]
-  code := replaceNodeInStructureBy(node,ncode)
-  SETQ($NODE,COPY node)
-  SETQ($NODE1, COPY first code)
-  SETQ($NODE2, COPY rest  code)
-  node.first := first code
-  node.rest := rest  code
-  chk(code, key)
-  chk(node, key + 1)
-
-replaceNodeInStructureBy(node, x) == 
-  $nodeCopy: local := [first node,:rest node]
-  replaceNodeBy(node, x)
-  node
-
-replaceNodeBy(node, x) ==
-  atom x => nil
-  for y in tails x | x is [=node,:.] repeat x.first := $nodeCopy
-  nil  
-
-chk(x,key) == fn(x,0,key) where fn(x,cnt,key) ==
-  cnt > 10000 => 
-    sayBrightly ["--> ", key, " <---"]
-    hahaha(key)
-  atom x => cnt
-  vector? x => systemError nil
-  for y in x repeat cnt := fn(y, cnt + 1, key)
-  cnt
- 
-- 
cgit v1.2.3