Clean up

7 files changed, 59 insertions, 99 deletions

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 5022d5dc..28a4cbf3 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -620,8 +620,8 @@ compFormWithModemap(form,m,e,modemap) ==
           (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
+      -- first is a full tag, as placed by getInverseEnvironment
+      -- second is what getSuccessEnvironment will place there
                 ["CDR",z]
         ["call",:form']
       e':=
@@ -843,7 +843,6 @@ setqSingle(id,val,m,E) ==
     e':= augModemapsFromDomain1(id,val,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 
     form := ["setShellEntry","$",k,x]
   else form:=
@@ -862,18 +861,18 @@ 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
+  -- 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
+  -- 1.1. exit if result is a list
   m1 is ["List",D] =>
     for y in nameList repeat 
       e:= put(y,"value",[genSomeVariable(),D,$noEnv],e)
     convert([["PROGN",x,["%LET",nameList,g],g],m',e],m)
-  2 --verify that the #nameList = number of parts of right-hand-side
+  -- 2. verify that the #nameList = number of parts of right-hand-side
   selectorModePairs:=
                                                 --list of modes
     decompose(m1,#nameList,e) or return nil where
@@ -884,7 +883,7 @@ setqMultiple(nameList,val,m,e) ==
         stackMessage('"no multiple assigns to mode: %1p",[t])
   #nameList~=#selectorModePairs =>
     stackMessage('"%1b must decompose into %2 components",[val,#nameList])
-  3 --generate code; return
+  -- 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]
diff --git a/src/interp/define.boot b/src/interp/define.boot
index ce5bf8d7..debdd992 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -364,17 +364,11 @@ macroExpandList(l,e) ==
   [macroExpand(x,e) for x in l]
 
 --% constructor evaluation
---  The following functions are used by the compiler but are modified
---  here for use with new LISPLIB scheme
  
 mkEvalableCategoryForm c ==
   c is [op,:argl] =>
     op="Join" => ["Join",:[mkEvalableCategoryForm x for x in argl]]
-    op is "DomainSubstitutionMacro" =>
-        --$extraParms :local
-        --catobj := EVAL c -- DomainSubstitutionFunction makes $extraParms
-        --mkEvalableCategoryForm sublisV($extraParms, catobj)
-        mkEvalableCategoryForm second argl
+    op is "DomainSubstitutionMacro" => mkEvalableCategoryForm second argl
     op is "mkCategory" => c
     MEMQ(op,$CategoryNames) =>
       ([x,m,$e]:= compOrCroak(c,$EmptyMode,$e); m=$Category => x)
@@ -464,25 +458,25 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
     -- Remember the body for checking the current instantiation.
     $currentCategoryBody : local := body
          --Set in DomainSubstitutionFunction, used further down
---  1.1  augment e to add declaration $: <form>
+    -- 1.1  augment e to add declaration $: <form>
     [$op,:argl] := $definition
     e:= addBinding("$",[['mode,:$definition]],e)
  
---  2. obtain signature
+    -- 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
+    -- 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 := pairList(argl,sargl)
     formalBody:= SUBLIS(aList,body)
     signature' := SUBLIS(aList,signature')
---Begin lines for category default definitions
+    --Begin lines for category default definitions
     $functionStats: local:= [0,0]
     $functorStats: local:= [0,0]
     $getDomainCode: local := nil
@@ -490,7 +484,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
     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
+    -- 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
@@ -510,13 +504,13 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
          ["setShellEntry",g,0,mkConstructor $form]]
     fun:= compile [op',["LAM",sargl,body]]
  
---  5. give operator a 'modemap property
+    -- 5. give operator a 'modemap property
     pairlis := pairList(argl,$FormalMapVariableList)
     parSignature:= SUBLIS(pairlis,signature')
     parForm:= SUBLIS(pairlis,form)
     -- If we are only interested in the defaults, there is no point
     -- in writing out compiler info and load-time stuff for 
-    --the category which is assumed to have already been translated.
+    -- the category which is assumed to have already been translated.
     if not $compileDefaultsOnly then
       lisplibWrite('"compilerInfo",
         removeZeroOne ['SETQ,'$CategoryFrame,
@@ -528,7 +522,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
         evalAndRwriteLispForm('NILADIC,
               ['MAKEPROP,['QUOTE,op'],'(QUOTE NILADIC),true])
  
---   6. put modemaps into InteractiveModemapFrame
+    -- 6. put modemaps into InteractiveModemapFrame
     $domainShell := eval [op',:MAPCAR('MKQ,sargl)]
     $lisplibCategory:= formalBody
     if $LISPLIB then
@@ -609,7 +603,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
     originale:= $e
     [$op,:argl]:= form
     $formalArgList:= [:argl,:$formalArgList]
-    $pairlis := pairList(argl,$FormalMapVariableList)
+    $pairlis: local := pairList(argl,$FormalMapVariableList)
     $mutableDomain: local :=
       -- all defaulting packages should have caching turned off
        isCategoryPackageName $op or MEMQ($op,$mutableDomains)
@@ -627,7 +621,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body],
     [ds,.,$e]:= compMakeCategoryObject(target,$e) or return
        stackAndThrow('"   cannot produce category object: %1pb",[target])
     $compileExportsOnly => compDefineExports(form, ds.1, signature',$e)
-    $domainShell:= COPY_-SEQ ds
+    $domainShell: local := COPY_-SEQ ds
     attributeList := ds.2 --see below under "loadTimeAlist"
     $condAlist: local := nil
     $uncondAlist: local := nil
@@ -866,26 +860,25 @@ mkOpVec(dom,siglist) ==
     u:= ASSQ(op,oplist)
     assoc(sig,u) is [.,n,.,'ELT] => ops.i := dom.n
     noplist:= SUBLIS(substargs,u)
- -- following variation on assoc needed for GENSYMS in Mutable domains
+  -- following variation on assoc needed for GENSYMS in Mutable domains
     AssocBarGensym(substitute(dom.0,'$,sig),noplist) is [.,n,.,'ELT] =>
                    ops.i := dom.n
     ops.i := [function Undef,[dom.0,i],:opSig]
   ops
  
+
+++ form is lhs (f a1 ... an) of definition; body is rhs;
+++ signature is (t0 t1 ... tn) where t0= target type, ti=type of ai, i > 0;
+++ specialCases is (NIL l1 ... ln) where li is list of special cases
+++ which can be given for each ti
+++ removes declarative and assignment information from form and
+++ signature, placing it in list L, replacing form by ("where",form',:L),
+++ signature by a list of NILs (signifying declarations are in e)
 compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) ==
--- form is lhs (f a1 ... an) of definition; body is rhs;
--- signature is (t0 t1 ... tn) where t0= target type, ti=type of ai, i > 0;
--- specialCases is (NIL l1 ... ln) where li is list of special cases
--- which can be given for each ti
- 
--- removes declarative and assignment information from form and
--- signature, placing it in list L, replacing form by ("where",form',:L),
--- signature by a list of NILs (signifying declarations are in e)
   $sigAlist: local := nil
   $predAlist: local := nil
- 
--- 1. create sigList= list of all signatures which have embedded
---    declarations moved into global variable $sigAlist
+  -- 1. create sigList= list of all signatures which have embedded
+  --    declarations moved into global variable $sigAlist
   sigList:=
     [transformType fetchType(a,x,e,form) for a in rest form for x in rest signature]
        where
@@ -900,16 +893,16 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) ==
           x is ['Record,:.] => x --RDJ 8/83
           [first x,:[transformType y for y in rest x]]
  
--- 2. replace each argument of the form (|| x p) by x, recording
---    the given predicate in global variable $predAlist
+  -- 2. replace each argument of the form (|| x p) by x, recording
+  --    the given predicate in global variable $predAlist
   argList:=
     [removeSuchthat a for a in rest form] where
       removeSuchthat x ==
         x is ["|",y,p] => ($predAlist:= [[y,:p],:$predAlist]; y)
         x
  
--- 3. obtain a list of parameter identifiers (x1 .. xn) ordered so that
---       the type of xi is independent of xj if i < j
+  -- 3. obtain a list of parameter identifiers (x1 .. xn) ordered so that
+  --       the type of xi is independent of xj if i < j
   varList:=
     orderByDependency(ASSOCLEFT argDepAlist,ASSOCRIGHT argDepAlist) where
       argDepAlist:=
@@ -919,13 +912,13 @@ compDefWhereClause(['DEF,form,signature,specialCases,body],m,e) ==
               delete(x,listOfIdentifiersIn LASSOC(x,$predAlist)))
           argSigAlist:= [:$sigAlist,:pairList(argList,sigList)]
  
--- 4. construct a WhereList which declares and/or defines the xi's in
---    the order constructed in step 3
+  -- 4. construct a WhereList which declares and/or defines the xi's in
+  --    the order constructed in step 3
   (whereList:= [addSuchthat(x,[":",x,LASSOC(x,argSigAlist)]) for x in varList])
      where addSuchthat(x,y) == (p:= LASSOC(x,$predAlist) => ["|",y,p]; y)
  
--- 5. compile new ('DEF,("where",form',:WhereList),:.) where
---    all argument parameters of form' are bound/declared in WhereList
+  -- 5. compile new ('DEF,("where",form',:WhereList),:.) where
+  --    all argument parameters of form' are bound/declared in WhereList
   comp(form',m,e) where
     form':=
       ["where",defform,:whereList] where
@@ -1031,8 +1024,8 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
     if $newCompCompare=true then
        SAY '"The old compiler generates:"
        prTriple T
---  A THROW to the above CATCH occurs if too many semantic errors occur
---  see stackSemanticError
+    --  A THROW to the above CATCH occurs if too many semantic errors occur
+    --  see stackSemanticError
     catchTag:= MKQ GENSYM()
     fun:=
       body':= replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode)
@@ -1041,7 +1034,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body],
       compile [$op,["LAM",[:argl,'_$],finalBody]]
     $functorStats:= addStats($functorStats,$functionStats)
  
---  7. give operator a 'value property
+    --7. give operator a 'value property
     val:= [fun,signature',e]
     [fun,['Mapping,:signature'],$e]
  
@@ -1202,7 +1195,7 @@ compile u ==
   -- Deduce old sequence number and use it (items have been skipped).
   if $LISPLIB and $compileOnlyCertainItems then
     parts := splitEncodedFunctionName(u.0, ";")
---  Next line JHD/SMWATT 7/17/86 to deal with inner functions
+  --  Next line JHD/SMWATT 7/17/86 to deal with inner functions
     parts='inner => $savableItems:=[u.0,:$savableItems]
     unew  := nil
     for [s,t] in $splitUpItemsAlreadyThere repeat
@@ -1555,9 +1548,6 @@ doItIf(item is [.,p,x,y],$predl,$e) ==
    $functorLocalParameters:=[:oldFLP,:nreverse nils]
    nreverse ans
  
---compSingleCapsuleIf(x,predl,e,$functorLocalParameters) ==
---  compSingleCapsuleItem(x,predl,e)
- 
 --% CATEGORY AND DOMAIN FUNCTIONS
 
 compContained: (%Form, %Mode, %Env) -> %Maybe %Triple
@@ -1649,7 +1639,7 @@ DomainSubstitutionFunction(parameters,body) ==
         [Subst(parameters,u) for u in body]
   not (body is ["Join",:.]) => body
   atom $definition => body
-  null rest $definition => body
+  null rest $definition => body 
            --should not bother if it will only be called once
   name:= INTERN STRCONC(KAR $definition,";CAT")
   SETANDFILE(name,nil)
@@ -1709,9 +1699,9 @@ compCategoryItem(x,predl,env) ==
     for u in l repeat 
       compCategoryItem(u,predl,env)
  
--- 4. otherwise, x gives a signature for a
---    single operator name or a list of names; if a list of names,
---    recurse
+  -- 4. otherwise, x gives a signature for a
+  --    single operator name or a list of names; if a list of names,
+  --    recurse
   x is ["SIGNATURE",:opsig] => compSignature(opsig,pred,env)
   systemErrorHere ["compCategoryItem",x]
 
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 95b9ccd1..75ac00e4 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -44,7 +44,7 @@ keyItem a ==
   --The item that domain checks on
  
 --Global strategy here is to maintain a list of substitutions
---  ( %in Sublis), of vectors and the names that they have,
+--  ( in $Sublis), of vectors and the names that they have,
 --  which may be either local names ('View1') or global names ('Where1')
 --  The global names are remembered on $Sublis from one
 --  invocation of DomainPrint1 to the next
@@ -803,9 +803,9 @@ InvestigateConditions catvecListMaker ==
         list2
   list:= [[sec,:ICformat u] for u in list for sec in secondaries]
   pv:= getPossibleViews $principal
--- $HackSlot4 is used in SetVector4 to ensure that conditional
--- extensions of the principal view are handles correctly
--- here we build the code necessary to remove spurious extensions
+  -- $HackSlot4 is used in SetVector4 to ensure that conditional
+  -- extensions of the principal view are handles correctly
+  -- here we build the code necessary to remove spurious extensions
   ($HackSlot4:= [reshape u for u in $HackSlot4]) where
     reshape u ==
       ['COND,[TryGDC ICformat rest u],
@@ -907,23 +907,6 @@ resolvePatternVars(p,args) ==
   p := SUBLISLIS(args, $TriangleVariableList, p)
   SUBLISLIS(args, $FormalMapVariableList, p)
 
---resolvePatternVars(p,args) ==
---  atom p =>
---    isSharpVarWithNum p => args.(position(p,$FormalMapVariableList))
---    p
---  [resolvePatternVars(first p,args),:resolvePatternVars(rest p,args)]
- 
--- Mysterious JENKS definition follows:
---DescendCodeVarAdd(base,flag) ==
---  baseops := [(u:=LASSOC([base,:SUBST(base,'$,types)],
---                    get(op,'modemap,$e))) and [sig,:u]
---                       for (sig := [op,types]) in $CheckVectorList]
---  $CheckVectorList := [sig for sig in $CheckVectorList
---                           for op in baseops | null op]
---  [SetFunctionSlots(sig,implem,flag,'adding)
---                   for u in baseops | u is [sig,[pred,implem]]]
- 
-
 --% Code Processing Packages
 
 isCategoryPackageName nam ==
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index f69f80b3..c0fdeda4 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -264,7 +264,6 @@ NRTgetLocalIndex item ==
     -- ??? That we do is likely a bug.
     flag => item  
     (compOrCroak(item,$EmptyMode,$e)).expr
---    item
   RPLACA(saveNRTdeltaListComp,compEntry)
   saveIndex
 
@@ -399,10 +398,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
 
   changeDirectoryInSlot1()  --this extends $NRTslot1PredicateList
 
-  --pp '"=================="
-  --for item in $NRTdeltaList repeat pp item
-
---LOCAL BOUND FLUID VARIABLES:
+  --LOCAL BOUND FLUID VARIABLES:
   $GENNO: local:= 0     --bound in compDefineFunctor1, then as parameter here
   $catvecList: local := nil   --list of vectors v1..vn for each view
   $hasCategoryAlist: local := nil  --list of GENSYMs bound to (HasCategory ..) items
@@ -418,7 +414,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
   $supplementaries: local := nil
    --set in InvestigateConditions to represent any additional
    --category membership tests that may be needed(see buildFunctor for details)
-------------------------
+
   oldtime:= TEMPUS_-FUGIT()
   [$catsig,:argsig]:= sig
   catvecListMaker:=REMDUP
@@ -440,8 +436,8 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
   $catNames:= ['$,:[GENVAR() for u in rest catvecListMaker]]
   domname:='dv_$
 
--->  Do this now to create predicate vector; then DescendCode can refer
--->  to predicate vector if it can
+  -- Do this now to create predicate vector; then DescendCode can refer
+  -- to predicate vector if it can
   [$uncondAlist,:$condAlist] :=    --bound in compDefineFunctor1
       NRTsetVector4Part1($catNames,catvecListMaker,condCats)
   [$NRTslot1PredicateList,predBitVectorCode1,:predBitVectorCode2] :=
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 96f7b3bc..813dab7d 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -356,7 +356,7 @@ newLookupInCategories1(op,sig,dom,dollar) ==
   slot4 := dom.4
   packageVec := first slot4
   catVec := first QCDR slot4
---the next three lines can go away with new category world
+  --the next three lines can go away with new category world
   varList := ['$,:$FormalMapVariableList]
   valueList := [dom,:[dom.(5+i) for i in 1..(# rest dom.0)]]
   valueList := [MKQ val for val in valueList]
@@ -434,7 +434,7 @@ lazyMatchArg(s,a,dollar,domain) == lazyMatchArg2(s,a,dollar,domain,true)
  
 lazyMatchArg2(s,a,dollar,domain,typeFlag) ==
   if s = '$ then
---  a = 0 => return true  --needed only if extra call in newGoGet to basicLookup
+    --  a = 0 => return true  --needed only if extra call in newGoGet to basicLookup
     s := devaluate dollar -- calls from HasCategory can have $s
   INTEGERP a =>
     not typeFlag => s = domain.a
@@ -532,7 +532,7 @@ newExpandGoGetTypeSlot(slot,dollar,domain) ==
   newExpandTypeSlot(slot,domain,domain)
  
 newExpandTypeSlot(slot, dollar, domain) ==
---> returns domain form for dollar.slot
+-- returns domain form for dollar.slot
    newExpandLocalType(sigDomainVal(dollar, domain, slot), dollar,domain)
  
  
@@ -679,13 +679,6 @@ lazyMatchAssocV1(x,vec,domain) ==               --old style slot4
   or/[QCDR QVELT(vec,i) for i in 0..n |
     xop = first (lazyt := first QVELT(vec,i)) and lazyMatch(x,lazyt,domain,domain)]
  
---newHasAttribute(domain,attrib) ==
---  predIndex := LASSOC(attrib,domain.2) =>
---    EQ(predIndex,0) => true
---    predvec := domain.3
---    testBitVector(predvec,predIndex)
---  false
-
 --=======================================================
 --                   Utility Functions
 --=======================================================
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index 1fb22e93..a359fed7 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -340,8 +340,8 @@ NRTisRecurrenceRelation(op,body,minivectorName) ==
   -- body should have a conditional expression which
   -- gives k boundary values, one general term plus possibly an
   -- "out of domain" condition
---pcl is [:.,[ ''T,:mess]] and not (CONTAINED('throwMessage,mess) or
---  CONTAINED('throwKeyedMsg,mess)) => NIL
+  --pcl is [:.,[ ''T,:mess]] and not (CONTAINED('throwMessage,mess) or
+  --  CONTAINED('throwKeyedMsg,mess)) => NIL
   pcl := [x for x in pcl | not (x is [''T,:mess] and
     (CONTAINED('throwMessage,mess) or
       CONTAINED('throwKeyedMsg,mess)))]
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index a4aea6b5..568929ee 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -384,7 +384,6 @@ NRTcatCompare [catform,:pred] == LASSOC(first catform,$levelAlist)
 hasDefaultPackage catname ==
   defname := INTERN STRCONC(catname,'"&")
   constructor? defname => defname
---MEMQ(defname,allConstructors()) => defname
   nil
  
  
@@ -911,6 +910,6 @@ expandTypeArgs(u,template,domform) ==
  
 templateVal(template,domform,index) ==
 --returns a domform or a lazy slot
-  index = 0 => harhar() --template
+  index = 0 => BREAK() --template
   template.index