remove pamphlets - part 7

1 files changed, 1229 insertions, 0 deletions

diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
new file mode 100644
index 00000000..3842101e
--- /dev/null
+++ b/src/interp/wi2.boot
@@ -0,0 +1,1229 @@
+-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+-- All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions are
+-- met:
+--
+--     - Redistributions of source code must retain the above copyright
+--       notice, this list of conditions and the following disclaimer.
+--
+--     - Redistributions in binary form must reproduce the above copyright
+--       notice, this list of conditions and the following disclaimer in
+--       the documentation and/or other materials provided with the
+--       distribution.
+--
+--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--       names of its contributors may be used to endorse or promote products
+--       derived from this software without specific prior written permission.
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+
+)package "BOOT"
+
+compDefineFunctor1(df, m,$e,$prefix,$formalArgList) ==
+    ['DEF,form,signature,$functorSpecialCases,body] := df
+    signature := markKillAll signature
+    if NRTPARSE = true then
+      [lineNumber,:$functorSpecialCases] := $functorSpecialCases
+--  1. bind global variables
+    $addForm: local
+    $viewNames: local:= nil
+ 
+            --This list is only used in genDomainViewName, for generating names
+            --for alternate views, if they do not already exist.
+            --format: Alist: (domain name . sublist)
+            --sublist is alist: category . name of view
+    $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
+    $op: local
+    $signature: local
+    $functorTarget: local
+    $Representation: local
+         --Set in doIt, accessed in the compiler - compNoStacking
+    $LocalDomainAlist: local  --set in doIt, accessed in genDeltaEntry
+    $LocalDomainAlist:= nil
+    $functorForm: local
+    $functorLocalParameters: local
+    $CheckVectorList: local
+                  --prevents CheckVector from printing out same message twice
+    $getDomainCode: local -- code for getting views
+    $insideFunctorIfTrue: local:= true
+    $functorsUsed: local --not currently used, finds dependent functors
+    $setelt: local :=
+      $QuickCode = true => 'QSETREFV
+      'SETELT
+    $TOP__LEVEL: local
+    $genSDVar: local:= 0
+    originale:= $e
+    [$op,:argl]:= form
+    $formalArgList:= [:argl,:$formalArgList]
+    $pairlis := [[a,:v] for a in argl for v in $FormalMapVariableList]
+    $mutableDomain: local :=
+      -- all defaulting packages should have caching turned off
+       isCategoryPackageName $op or   
+         (if BOUNDP '$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' 
+           | GETDATABASE(opOf typ,'CONSTRUCTORKIND) = '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
+    $attributesName:local := INTERN STRCONC(PNAME $op,'";attributes")
+    attributeList := ds.2 --see below under "loadTimeAlist"
+--+ 7 lines for $NRT follow
+    $goGetList: local := nil
+-->--these globals used by NRTmakeCategoryAlist, set by NRTsetVector4Part1
+    $condAlist: local := nil
+    $uncondAlist: local := nil
+-->>-- next global initialized here, reset by NRTbuildFunctor
+    $NRTslot1PredicateList: local :=
+      REMDUP [CADR x for x in attributeList]
+-->>-- next global initialized here, used by NRTgenAttributeAlist (NRUNOPT)
+    $NRTattributeAlist: local := NRTgenInitialAttributeAlist attributeList
+    $NRTslot1Info: local  --set in NRTmakeSlot1 called by NRTbuildFunctor
+       --this is used below to set $lisplibSlot1 global
+    $NRTbase: local := 6 -- equals length of $domainShell
+    $NRTaddForm: local := nil   -- see compAdd; NRTmakeSlot1
+    $NRTdeltaList: local := nil --list of misc. elts used in compiled fncts
+    $NRTdeltaListComp: local := nil --list of COMP-ed forms for $NRTdeltaList
+    $NRTaddList: local := nil --list of fncts not defined in capsule (added)
+    $NRTdeltaLength: local := 0 -- =length of block of extra entries in vector
+    $NRTloadTimeAlist: local := nil --used for things in slot4 (NRTsetVector4)
+    $NRTdomainFormList: local := nil -- of form ((gensym . (Repe...)) ...
+    -- the above optimizes the calls to local domains
+    $template: local:= nil --stored in the lisplib (if $NRTvec = true)
+    $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],m,$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 $insideCategoryPackageIfTrue^= true  then
+      if body is ['add,ab:=[fn,:.],['CAPSULE,:cb]] and MEMQ(fn,'(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:=CDR 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
+    if isPackageFunction() then $functorLocalParameters:=
+      [nil,:
+        [nil
+          for i in 6..MAXINDEX $domainShell |
+            $domainShell.i is [.,.,['ELT,'_$,.]]]]
+    --leave space for vector ops and package name to be stored
+--+
+    $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
+    SETQ($myFunctorBody, body)  -------->  new  <--------
+    T:= compFunctorBody(body,rettype,$e,parForm)
+---------------> new <---------------------
+    BOUNDP '$convert2NewCompiler and $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
+--   if $functorsUsed then MAKEPROP(op',"NEEDS",$functorsUsed)
+    $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)
+        $lisplibCategoriesExtended := SUBLIS($pairlis,$lisplibCategoriesExtended)
+        -- see NRTsetVector4 for initial setting of $lisplibCategoriesExtended
+        libFn := getConstructorAbbreviation op'
+        $lookupFunction: local :=
+            NRTgetLookupFunction($functorForm,CADAR $lisplibModemap,$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
+      $lisplibMissingFunctions:= $CheckVectorList
+    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) ==
+  $alternateViewList: local:= nil
+  $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:=[CDR 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] => genDomainViewList0(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
+    $op: local
+    $functionStats: local:= [0,0]
+    $argumentConditionList: local
+    $finalEnv: local
+             --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 :=
+      null member($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)
+  BOUNDP '$convert2NewCompiler and $convert2NewCompiler => 
+     [nil,m,e] --nonsense but that's fine
+  localParList:= $functorLocalParameters
+  if $addForm then data:= ['add,$addForm,data]
+  code:=
+    $insideCategoryIfTrue and not $insideCategoryPackageIfTrue => data
+    processFunctorOrPackage($form,$signature,data,localParList,m,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)]
+  STRINGP 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)
+ 
+getSuccessEnvironment(a,e) ==
+  -- the next four lines try to ensure that explicit special-case tests
+  --  prevent implicit ones from being generated
+  a is ["has",x,m] =>
+    x := unLet x   
+    IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,e)
+    e
+  a is ["is",id,m] =>
+    id := unLet id
+    IDENTP id and isDomainForm(m,$EmptyEnvironment) =>
+         e:=put(id,"specialCase",m,e)
+         currentProplist:= getProplist(id,e)
+         [.,.,e] := T := comp(m,$EmptyMode,e) or return nil -- duplicates compIs
+         newProplist:= consProplistOf(id,currentProplist,"value",removeEnv T)
+         addBinding(id,newProplist,e)
+    e
+  a is ["case",x,m] and (x := unLet x) and IDENTP x =>
+    put(x,"condition",[a,:get(x,"condition",e)],e)
+  e
+ 
+getInverseEnvironment(a,E) ==
+  atom a => E
+  [op,:argl]:= a
+-- the next five lines try to ensure that explicit special-case tests
+-- prevent implicit ones from being generated
+  op="has" =>
+    [x,m]:= argl
+    x := unLet x
+    IDENTP x and isDomainForm(m,$EmptyEnvironment) => put(x,"specialCase",m,E)
+    E
+  a is ["case",x,m] and (x := unLet x) and IDENTP x =>
+           --the next two lines are necessary to get 3-branched Unions to work
+           -- old-style unions, that is
+    if corrupted? get(x,"condition",E) then systemError 'condition
+    (get(x,"condition",E) is [["OR",:oldpred]]) and member(a,oldpred) =>
+      put(x,"condition",LIST MKPF(delete(a,oldpred),"OR"),E)
+    getUnionMode(x,E) is ["Union",:l] or systemError 'Union
+    if corrupted? l then systemError 'list
+    l':= delete(m,l)
+    for u in l' repeat
+       if u is ['_:,=m,:.] then l':= delete(u,l')
+    newpred:= MKPF([["case",x,m'] for m' in l'],"OR")
+    put(x,"condition",[newpred,:get(x,"condition",E)],E)
+  E
+
+unLet x ==
+  x is ['LET,u,:.] => unLet u
+  x
+
+corrupted? u ==
+  u is [op,:r] =>
+    MEMQ(op,'(WI MI PART)) => true
+    or/[corrupted? x for x in r]
+  false
+
+--======================================================================
+--                    From apply.boot
+--======================================================================
+applyMapping([op,:argl],m,e,ml) ==
+  #argl^=#ml-1 => nil
+  isCategoryForm(first ml,e) =>
+                                --is op a functor?
+    pairlis:= [[v,:a] for a in argl for v in $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 member(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':= INTERN STRCONC(encodeItem nprefix,";",encodeItem op)
+    ['call,['applyFun,op],:argl']
+  pairlis:= [[v,:a] for a in argl' for v in $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,nil) 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:=CAR argl) and
+          (c:=get(z,'condition,e)) and
+            c is [['case,=z,c1]] and
+              (c1 is ['_:,=(CADR argl),=m] or EQ(c1,CADR argl) ) =>
+-- first is a full tag, as placed by getInverseEnvironment
+-- second is what getSuccessEnvironment will place there
+                ["CDR",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 is ["elt",:.] => nil --what does the second clause do ????
+--+
+    val := genDeltaEntry [opOf anOp,:modemap]
+    x := markTran(origForm,[val],sig,[E])
+    [x,first rest sig,E] --implies fn calls used to access constants
+  compForm(origForm,m,E)
+ 
+pause op == op
+compApplyModemap(form,modemap,$e,sl) ==
+  [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 member(op1,'(ELT CONST Subsumed)) =>
+    [genDeltaEntry [op,:modemap],lt',$bindings]
+  markImport mc
+  [f,lt',$bindings]
+ 
+compMapCond''(cexpr,dc) ==
+  cexpr=true => true
+  --cexpr = "true" => true
+---------------> new <----------------------
+  cexpr is [op,:l] and MEMQ(op,'(_and AND)) => and/[compMapCond''(u,dc) for u in l]
+  cexpr is [op,:l] and MEMQ(op,'(_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
+--======================================================================
+NRTgetLocalIndex1(item,killBindingIfTrue) ==
+  k := NRTassocIndex item => k
+  item = $NRTaddForm => 5
+  item = '$ => 0 
+  item = '_$_$ => 2
+  value:=
+    MEMQ(item,$formalArgList) => item
+    nil
+  atom item and null MEMQ(item,'($ _$_$)) 
+   and null value =>  --give slots to atoms
+    $NRTdeltaList:= [['domain,NRTaddInner item,:value],:$NRTdeltaList]
+    $NRTdeltaListComp:=[item,:$NRTdeltaListComp]
+    $NRTdeltaLength := $NRTdeltaLength+1
+    $NRTbase + $NRTdeltaLength - 1
+  $NRTdeltaList:= [['domain,NRTaddInner item,:value],:$NRTdeltaList]
+  saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+  saveIndex := $NRTbase + $NRTdeltaLength
+  $NRTdeltaLength := $NRTdeltaLength+1
+  compEntry:=  item
+               ----94/11/07
+  --      WAS: compOrCroak(item,$EmptyMode,$e).expr
+  RPLACA(saveNRTdeltaListComp,compEntry)
+  saveIndex
+
+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 MEMQ(KAR ndc,$optimizableConstructorNames) => 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]
+  GETL(compileTimeBindingOf first fn,'SPADreplace)
+ 
+genDeltaEntry opMmPair ==
+--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 null atom 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 dc ^= $NRTaddForm and
+    (member(dc,$functorLocalParameters) or null atom dc) then
+    --create "domain" entry to $NRTdeltaList
+      $NRTdeltaList:= [['domain,NRTaddInner dc,:dc],:$NRTdeltaList]
+      saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp]
+      $NRTdeltaLength := $NRTdeltaLength+1
+      compEntry:=
+        dc
+      RPLACA(saveNRTdeltaListComp,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 not atom c then c:= CAR 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
+  RPLACA(y,"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],$EmptyMode,e) or return nil
+    e:= put(x,"value",[genSomeVariable(),mUnder,e],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],$EmptyMode,e) or return nil
+    e:= put(x,"value",[genSomeVariable(),m,e],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(CADDR it,$NonNegativeInteger,e) => $NonNegativeInteger
+      $Integer
+--  markImport ['Segment,indexmode]
+    if null get(index,"mode",e) then [.,.,e]:=
+      compMakeDeclaration([":",index,indexmode],$EmptyMode,e) or return nil
+    e:= put(index,"value",[genSomeVariable(),indexmode,e],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 (FIXP startNum and FIXP incNum) => return nil
+--    null FIXP startNum or ABSVAL startNum > 100 => return nil
+    -----> assume that optFinal is $SmallInteger
+    T := comp(final,$EmptyMode,inc'.env) or return nil
+    final' := T
+    maxSuperType(T.mode,e) ^= $Integer => return nil
+    givenRange := T.mode
+  indexmode:= $SmallInteger
+  [.,.,e]:= compMakeDeclaration([":",index,indexmode],$EmptyMode,
+     (final' => final'.env; inc'.env)) or return nil
+  range :=
+    FIXP startNum and FIXP 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:= put(index,"value",[genSomeVariable(),indexmode,e],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)) =>
+              CADR u
+            (u:=modeIsAggregateOf('Vector,targetMode,e)) =>
+              repeatOrCollect:='COLLECTV
+              CADR 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)) => CAR u
+            ["List",m']
+          repeatOrCollect="COLLECTV" =>
+            (u:=modeIsAggregateOf('Vector,targetMode,e)) => CAR 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 ["COND",: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':=
+                LENGTH ante'=1 => first ante'
+                ["and",:ante']
+              v':= ["COND",[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':=CDR oldFLP'
+              flp1:=CDR 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,["COND",[p',x,:x'],['(QUOTE T),y,:y']],12)
+
+doItSeq item == 
+  ['SEQ,:l,['exit,1,x]] := item
+  RPLACA(item,"PROGN")
+  RPLACA(LASTNODE item,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 CADR u
+  stackWarning ["Use: import ", [first item,:rest item]]
+--wiReplaceNode(item, u, 14)
+  RPLACA(item, first u)
+  RPLACD(item, 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
+        $functorsUsed:= insert(opOf rhs',$functorsUsed)
+        $packagesUsed:= insert([opOf rhs'],$packagesUsed)
+        $globalImportDefAlist := pp [[lhs, :rhs'],:$globalImportDefAlist]
+      if lhs="Rep" then
+        $Representation:= (get("Rep",'value,$e)).(0)
+           --$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 := ($QuickCode => 'QSETREFV;'SETELT)
+      wiReplaceNode(item,[op,'$,NRTgetLocalIndexClear 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:= put(op,'macro,body,$e)
+  [.,.,$e]:= t:= compOrCroak(item,$EmptyMode,$e)
+  chk(item,3)
+  RPLACA(item,"CodeDefine")
+        --Note that DescendCode, in CodeDefine, is looking for this
+  RPLACD(CADR item,[$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 := CONS(first ocode, rest ocode)
+  code := replaceNodeInStructureBy(node,ncode)
+  SETQ($NODE,COPY node)
+  SETQ($NODE1, COPY first code)
+  SETQ($NODE2, COPY rest  code)
+  RPLACA(node,first code)
+  RPLACD(node,rest  code)
+  chk(code, key)
+  chk(node, key + 1)
+
+replaceNodeInStructureBy(node, x) == 
+  $nodeCopy: local := [CAR node,:CDR node]
+  replaceNodeBy(node, x)
+  node
+
+replaceNodeBy(node, x) ==
+  atom x => nil
+  for y in tails x | EQCAR(x,node) repeat RPLAC(CAR x, $nodeCopy)
+  nil  
+
+chk(x,key) == fn(x,0,key) where fn(x,cnt,key) ==
+  cnt > 10000 => 
+    sayBrightly ["--> ", key, " <---"]
+    hahaha(key)
+  atom x => cnt
+  VECP x => systemError nil
+  for y in x repeat cnt := fn(y, cnt + 1, key)
+  cnt
+