* interp/package.boot: Fold content into functor.boot. Delete.

	* interp/Makefile.pamphlet: Adjust.

6 files changed, 251 insertions, 300 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index d4560d4a..07439f98 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,10 @@
 2008-11-15  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/package.boot: Fold content into functor.boot.  Delete.
+	* interp/Makefile.pamphlet: Adjust.
+
+2008-11-15  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/i-syscmd.boot: Remove dead code.
 	* interp/spad.lisp: Likewise.
 
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index 158682b8..b15c1ed6 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -97,8 +97,7 @@ OCOBJS=	\
 	iterator.$(FASLEXT)	compiler.$(FASLEXT)	\
 	c-doc.$(FASLEXT)	\
 	profile.$(FASLEXT)	functor.$(FASLEXT)	\
-	nruncomp.$(FASLEXT)	package.$(FASLEXT)	\
-	htcheck.$(FASLEXT)
+	nruncomp.$(FASLEXT)	htcheck.$(FASLEXT)
 
 autoload_objects += $(OCOBJS)
 
@@ -311,12 +310,10 @@ nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT)
 nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT)
 iterator.$(FASLEXT): g-util.$(FASLEXT)
 define.$(FASLEXT): g-error.$(FASLEXT) cattable.$(FASLEXT) \
-	functor.$(FASLEXT) lisplib.$(FASLEXT) package.$(FASLEXT) \
-	nruncomp.$(FASLEXT)
-package.$(FASLEXT): clam.$(FASLEXT)
+	functor.$(FASLEXT) lisplib.$(FASLEXT) nruncomp.$(FASLEXT)
 database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \
 		cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT)
-functor.$(FASLEXT): category.$(FASLEXT) c-util.$(FASLEXT)
+functor.$(FASLEXT): category.$(FASLEXT) c-util.$(FASLEXT) clam.$(FASLEXT)
 category.$(FASLEXT): g-util.$(FASLEXT) g-cndata.$(FASLEXT)
 cattable.$(FASLEXT): simpbool.$(FASLEXT) g-util.$(FASLEXT)
 compat.$(FASLEXT): pathname.$(FASLEXT)
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 8da04087..8d53c817 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -208,8 +208,7 @@ OCOBJS=	\
 	iterator.$(FASLEXT)	compiler.$(FASLEXT)	\
 	c-doc.$(FASLEXT)	\
 	profile.$(FASLEXT)	functor.$(FASLEXT)	\
-	nruncomp.$(FASLEXT)	package.$(FASLEXT)	\
-	htcheck.$(FASLEXT)
+	nruncomp.$(FASLEXT)	htcheck.$(FASLEXT)
 
 autoload_objects += $(OCOBJS)
 
@@ -560,12 +559,10 @@ nruncomp.$(FASLEXT): nrunopt.$(FASLEXT) profile.$(FASLEXT) simpbool.$(FASLEXT)
 nrungo.$(FASLEXT): c-util.$(FASLEXT) clam.$(FASLEXT) interop.$(FASLEXT)
 iterator.$(FASLEXT): g-util.$(FASLEXT)
 define.$(FASLEXT): g-error.$(FASLEXT) cattable.$(FASLEXT) \
-	functor.$(FASLEXT) lisplib.$(FASLEXT) package.$(FASLEXT) \
-	nruncomp.$(FASLEXT)
-package.$(FASLEXT): clam.$(FASLEXT)
+	functor.$(FASLEXT) lisplib.$(FASLEXT) nruncomp.$(FASLEXT)
 database.$(FASLEXT): clam.$(FASLEXT) nlib.$(FASLEXT) \
 		cattable.$(FASLEXT) compat.$(FASLEXT) g-cndata.$(FASLEXT)
-functor.$(FASLEXT): category.$(FASLEXT) c-util.$(FASLEXT)
+functor.$(FASLEXT): category.$(FASLEXT) c-util.$(FASLEXT) clam.$(FASLEXT)
 category.$(FASLEXT): g-util.$(FASLEXT) g-cndata.$(FASLEXT)
 cattable.$(FASLEXT): simpbool.$(FASLEXT) g-util.$(FASLEXT)
 compat.$(FASLEXT): pathname.$(FASLEXT)
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 7f80200c..ee85d733 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -36,7 +36,6 @@ import g_-error
 import lisplib
 import cattable
 import functor
-import package
 
 namespace BOOT
 
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index c5a55ae3..0d9db0d8 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -33,6 +33,7 @@
 
 
 import c_-util
+import clam
 import category
 namespace BOOT
 
@@ -248,7 +249,6 @@ optFunctorBody x ==
     ['LIST,:l]
   x is ['PROGN,:l] => ['PROGN,:optFunctorPROGN l]
   x is ['COND,:l] =>
---+
     l:=
       [CondClause u for u in l | u and first u] where
         CondClause [pred,:conseq] ==
@@ -420,9 +420,7 @@ setVector4(catNames,catsig,conditions) ==
   if $HackSlot4 then
     for ["%LET",name,cond,:.] in $getDomainCode repeat
       $HackSlot4:=MSUSBT(name,cond,$HackSlot4)
-  code:=
---+
-    ['SETELT,'$,4,'TrueDomain]
+  code := ['SETELT,'$,4,'TrueDomain]
   code:=['(%LET TrueDomain (NREVERSE TrueDomain)),:$HackSlot4,code]
   code:=
     [:
@@ -669,7 +667,7 @@ ProcessCond(cond,viewassoc) ==
   ncond := SUBLIS($pairlis,cond)
   INTEGERP POSN1(ncond,$NRTslot1PredicateList) => predicateBitRef ncond
   cond
---+
+
 TryGDC cond ==
             --sees if a condition can be optimised by the use of
             --information in $getDomainCode
@@ -683,7 +681,6 @@ TryGDC cond ==
   cond
  
 SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding"
---+
   catNames := ['$]
   for u in $catvecList for v in catNames repeat
     null body => return nil
@@ -787,7 +784,6 @@ InvestigateConditions catvecListMaker ==
       --We are not interested in the principal view
       --The next block allows for the possibility that $principal may
       --have conditional secondary views
---+
   null secondaries => '(T)
       --return for packages which generally have no secondary views
   if $principal is [op,:.] then
@@ -840,9 +836,6 @@ InvestigateConditions catvecListMaker ==
   for u in partList repeat
     for [v,:.] in u repeat
       if not member(v,secondaries) then secondaries:= [v,:secondaries]
-  --PRETTYPRINT $Conditions
-  --PRETTYPRINT masterSecondaries
-  --PRETTYPRINT secondaries
   (list:= [mkNilT member(u,necessarySecondaries) for u in secondaries]) where
     mkNilT u ==
       u => true
@@ -959,7 +952,6 @@ getViewsConditions u ==
     systemErrorHere '"getViewsConditions"
   views:= [[first u,:CADR u] for u in CADR vec.4]
   null vec.0 =>
---+
     null CAR vec.4 => views
     [[CAAR vec.4,:true],:views] --*
   [[vec.0,:true],:views] --*
@@ -994,3 +986,240 @@ resolvePatternVars(p,args) ==
 --  [SetFunctionSlots(sig,implem,flag,'adding)
 --                   for u in baseops | u is [sig,[pred,implem]]]
  
+
+--% Code Processing Packages
+
+isPackageFunction() ==
+  -- called by compile/putInLocalDomainReferences
+  nil
+
+isCategoryPackageName nam ==
+  p := PNAME opOf nam
+  p.(MAXINDEX p) = char '_&
+
+processFunctorOrPackage(form,signature,data,localParList,m,e) ==
+  processFunctor(form,signature,data,localParList,e)
+ 
+processPackage($definition is [name,:args],[$catsig,:argssig],code,locals,$e) ==
+  $GENNO: local:= 0 --for GENVAR()
+  $catsig: local := nil
+               --used in ProcessCond
+  $ResetItems: local := nil
+       --stores those items that get SETQed, and may need re-processing
+  $catvecList: local:= [$domainShell]
+  $catNames: local:= ["$"]
+  catvec:= $domainShell --from compDefineFunctor
+  $getDomainCode:= optFunctorBody $getDomainCode
+      --the purpose of this is so ProcessCond recognises such items
+  code:= PackageDescendCode(code,true,nil)
+  if delete(nil,locals) then code:=[:code,:(setPackageCode locals)] where
+      setPackageCode locals ==
+          locals':=[[u,:i] for u in locals for i in 0.. | u]
+          locals'' :=[]
+          while locals' repeat
+            for v in locals' repeat
+              [u,:i]:=v
+              if and/[EQ(v,v') or not subTree(u,CAR v') for v' in locals']
+              then
+                locals'':=[v,:locals'']
+                locals':=delete(v,locals')
+          precomp:=code:=[]
+          for elem in locals'' repeat
+            [u,:i]:=elem
+            if ATOM u then u':=u
+            else
+              u':=opt(u,precomp) where
+                  opt(u,alist) ==
+                    ATOM u => u
+                    for v in u repeat
+                      if (a:=assoc(v,alist)) then
+                        [.,:i]:=a
+                        u:=replace(v,["getShellEntry","$",i],u) where
+                           replace(old,new,l) ==
+                             l isnt [h,:t] => l
+                             h = old => [new,:t]
+                             [h,:replace(old,new,t)]
+                      v':=opt(v,alist)
+                      EQ(v,v') => nil
+                      u:=replace(v,v',u)
+                    u
+              precomp:=[elem,:precomp]
+            code:=[["setShellEntry","$",i,u'],:code]
+          nreverse code
+  code:=
+    ["PROGN",:$getDomainCode,["%LET","$",["newShell",#locals]],
+                           --It is important to place this code here,
+                           --after $ is set up
+                   --slam functor with shell
+                   --the order of steps in this PROGN are critical
+      addToSlam($definition,"$"),code,[
+        "SETELT","$",0, mkDomainConstructor $definition],:
+-- If we call addMutableArg this early, then recurise calls to this domain
+-- (e.g. while testing predicates) will generate new domains => trouble
+--      "SETELT","$",0,addMutableArg mkDomainConstructor $definition],:
+          [["SETELT","$",position(name,locals),name]
+            for name in $ResetItems | MEMQ(name,locals)],
+             :[($mutableDomain => '(RPLACD (LASTNODE (ELT $ 0))
+                                           (LIST (GENSYM)));[]) ],
+              "$"]
+  for u in $getDomainCode repeat
+    u is ["%LET",.,u'] and u' is ['getDomainView,.,u''] =>
+      $packagesUsed:=union(CategoriesFromGDC u'',$packagesUsed)
+  $packagesUsed:=union($functorLocalParameters,$packagesUsed)
+  $getDomainCode:= nil
+     --if we didn't kill this, DEFINE would insert it in the wrong place
+  optFunctorBody code
+ 
+subTree(u,v) ==
+  v=u => true
+  ATOM v => nil
+  or/[subTree(u,v') for v' in v]
+ 
+setPackageLocals(pac,locs) ==
+  for var in locs for i in 0.. | var^=nil repeat pac.i:= var
+ 
+PackageDescendCode(code,flag,viewAssoc) ==
+               --flag is true if we are walking down code always executed
+               --nil if we are in conditional code
+  code=nil => nil
+  code="%noBranch" => nil
+  code is ["add",base,:codelist] =>
+    systemError '"packages may not have add clauses"
+  code is ["PROGN",:codelist] =>
+    ["PROGN",:
+      [v for u in codelist | (v:= PackageDescendCode(u,flag,viewAssoc))^=nil]]
+  code is ["COND",:condlist] =>
+    c:=
+      ["COND",:
+        [[u2:= ProcessCond(first u,viewAssoc),:
+         (if null u2
+             then nil
+             else
+              [PackageDescendCode(v,flag and TruthP u2,
+                if first u is ["HasCategory",dom,cat]
+                   then [[dom,:cat],:viewAssoc]
+                   else viewAssoc) for v in rest u])] for u in condlist]]
+    TruthP CAADR c => ["PROGN",:CDADR c]
+    c
+  code is ["%LET",name,body,:.] =>
+    if not MEMQ(name,$ResetItems) then $ResetItems:= [name,:$ResetItems]
+    if body is [a,:.] and isFunctor a
+      then $packagesUsed:=[body,:$packagesUsed]
+    code
+  code is ["CodeDefine",sig,implem] =>
+             --Generated by doIt in COMPILER BOOT
+    dom:= "$"
+    dom:=
+      u:= LASSOC(dom,viewAssoc) => ["getDomainView",dom,u]
+      dom
+    body:= ["CONS",implem,dom]
+    SetFunctionSlots(sig,body,flag,"original")
+  code is [":",:.] => (RPLACA(code,"LIST"); RPLACD(code,NIL))
+      --Yes, I know that's a hack, but how else do you kill a line?
+  code is ["LIST",:.] => nil
+  code is ["MDEF",:.] => nil
+  code is ["devaluate",:.] => nil
+  code is ["call",:.] => code
+  code is ["SETELT",:.] => code
+  code is ["QSETREFV",:.] => code
+  code is ["setShellEntry",:.] => code
+  stackWarning('"unknown Package code: %1 ",[code])
+  code
+ 
+mkOperatorEntry(domainOrPackage,opSig is [op,sig,:flag],pred,count) ==
+  domainOrPackage^="domain" =>
+    [opSig,pred,["PAC","$",name]] where
+      name() == encodeFunctionName(op,domainOrPackage,sig,":",count)
+  null flag => [opSig,pred,["ELT","$",count]]
+  first flag="constant" => [[op,sig],pred,["CONST","$",count]]
+  systemError ["unknown variable mode: ",flag]
+ 
+optPackageCall(x,["PAC",packageVariableOrForm,functionName],arglist) ==
+  RPLACA(x,functionName)
+  RPLACD(x,[:arglist,packageVariableOrForm])
+  x
+ 
+--% Code for encoding function names inside package or domain
+ 
+encodeFunctionName(fun,package is [packageName,:arglist],signature,sep,count)
+   ==
+    signature':= MSUBST("$",package,signature)
+    reducedSig:= mkRepititionAssoc [:rest signature',first signature']
+    encodedSig:=
+      ("STRCONC"/[encodedPair for [n,:x] in reducedSig]) where
+        encodedPair() ==
+          n=1 => encodeItem x
+          STRCONC(STRINGIMAGE n,encodeItem x)
+    encodedName:= INTERNL(getAbbreviation(packageName,#arglist),";",
+        encodeItem fun,";",encodedSig, sep,STRINGIMAGE count)
+    if $LISPLIB then
+      $lisplibSignatureAlist:=
+        [[encodedName,:signature'],:$lisplibSignatureAlist]
+    encodedName
+ 
+splitEncodedFunctionName(encodedName, sep) ==
+    -- [encodedPackage, encodedItem, encodedSig, sequenceNo] or NIL
+    -- sep0 is the separator used in "encodeFunctionName".
+    sep0 := '";"
+    if not STRINGP encodedName then
+        encodedName := STRINGIMAGE encodedName
+    null (p1 := STRPOS(sep0, encodedName, 0,    '"*")) => nil
+    null (p2 := STRPOS(sep0, encodedName, p1+1, '"*")) => 'inner
+--  This is picked up in compile for inner functions in partial compilation
+    null (p3 := STRPOS(sep,  encodedName, p2+1, '"*")) => nil
+    s1 := SUBSTRING(encodedName, 0,    p1)
+    s2 := SUBSTRING(encodedName, p1+1, p2-p1-1)
+    s3 := SUBSTRING(encodedName, p2+1, p3-p2-1)
+    s4 := SUBSTRING(encodedName, p3+1, nil)
+    [s1, s2, s3, s4]
+ 
+mkRepititionAssoc l ==
+  mkRepfun(l,1) where
+    mkRepfun(l,n) ==
+      null l => nil
+      l is [x] => [[n,:x]]
+      l is [x, =x,:l'] => mkRepfun(rest l,n+1)
+      [[n,:first l],:mkRepfun(rest l,1)]
+ 
+encodeItem x ==
+  x is [op,:argl] => getCaps op
+  IDENTP x => PNAME x
+  STRINGIMAGE x
+ 
+getCaps x ==
+  s:= STRINGIMAGE x
+  clist:= [c for i in 0..MAXINDEX s | UPPER_-CASE_-P (c:= s.i)]
+  null clist => '"__"
+  "STRCONC"/[first clist,:[L_-CASE u for u in rest clist]]
+ 
+--% abbreviation code
+ 
+getAbbreviation(name,c) ==
+  --returns abbreviation of name with c arguments
+  x := constructor? name
+  X := ASSQ(x,$abbreviationTable) =>
+    N:= ASSQ(name,rest X) =>
+      C:= ASSQ(c,rest N) => rest C --already there
+      newAbbreviation:= mkAbbrev(X,x)
+      RPLAC(rest N,[[c,:newAbbreviation],:rest N])
+      newAbbreviation
+    newAbbreviation:= mkAbbrev(X,x)
+    RPLAC(rest X,[[name,[c,:newAbbreviation]],:rest X])
+    newAbbreviation
+  $abbreviationTable:= [[x,[name,[c,:x]]],:$abbreviationTable]
+  x
+ 
+mkAbbrev(X,x) == addSuffix(alistSize rest X,x)
+ 
+alistSize c ==
+  count(c,1) where
+    count(x,level) ==
+      level=2 => #x
+      null x => 0
+      count(CDAR x,level+1)+count(rest x,level)
+ 
+addSuffix(n,u) ==
+  ALPHA_-CHAR_-P (s:= STRINGIMAGE u).(MAXINDEX s) => 
+    INTERN STRCONC(s,STRINGIMAGE n)
+  INTERNL STRCONC(s,STRINGIMAGE ";",STRINGIMAGE n)
+ 
diff --git a/src/interp/package.boot b/src/interp/package.boot
deleted file mode 100644
index 8dd15b8b..00000000
--- a/src/interp/package.boot
+++ /dev/null
@@ -1,276 +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 clam
-namespace BOOT
-
-isPackageFunction() ==
-  -- called by compile/putInLocalDomainReferences
---+
-  nil
-
-isCategoryPackageName nam ==
-  p := PNAME opOf nam
-  p.(MAXINDEX p) = char '_&
-
-processFunctorOrPackage(form,signature,data,localParList,m,e) ==
---+
-  processFunctor(form,signature,data,localParList,e)
- 
-processPackage($definition is [name,:args],[$catsig,:argssig],code,locals,$e) ==
-  $GENNO: local:= 0 --for GENVAR()
-  $catsig: local := nil
-               --used in ProcessCond
-  $ResetItems: local := nil
-       --stores those items that get SETQed, and may need re-processing
-  $catvecList: local:= [$domainShell]
-  $catNames: local:= ["$"]
---PRINT $definition
---PRINT ($catsig,:argssig)
---PRETTYPRINT code
-  catvec:= $domainShell --from compDefineFunctor
-  $getDomainCode:= optFunctorBody $getDomainCode
-      --the purpose of this is so ProcessCond recognises such items
-  code:= PackageDescendCode(code,true,nil)
-  if delete(nil,locals) then code:=[:code,:(setPackageCode locals)] where
-      setPackageCode locals ==
-          locals':=[[u,:i] for u in locals for i in 0.. | u]
-          locals'' :=[]
-          while locals' repeat
-            for v in locals' repeat
-              [u,:i]:=v
-              if and/[EQ(v,v') or not subTree(u,CAR v') for v' in locals']
-              then
-                locals'':=[v,:locals'']
-                locals':=delete(v,locals')
-          precomp:=code:=[]
-          for elem in locals'' repeat
-            [u,:i]:=elem
-            if ATOM u then u':=u
-            else
-              u':=opt(u,precomp) where
-                  opt(u,alist) ==
-                    ATOM u => u
-                    for v in u repeat
-                      if (a:=assoc(v,alist)) then
-                        [.,:i]:=a
-                        u:=replace(v,["getShellEntry","$",i],u) where
-                           replace(old,new,l) ==
-                             l isnt [h,:t] => l
-                             h = old => [new,:t]
-                             [h,:replace(old,new,t)]
-                      v':=opt(v,alist)
-                      EQ(v,v') => nil
-                      u:=replace(v,v',u)
-                    u
-              precomp:=[elem,:precomp]
-            code:=[["setShellEntry","$",i,u'],:code]
-          nreverse code
-  code:=
-    ["PROGN",:$getDomainCode,["%LET","$",["newShell",#locals]],
-                           --It is important to place this code here,
-                           --after $ is set up
-                   --slam functor with shell
-                   --the order of steps in this PROGN are critical
-      addToSlam($definition,"$"),code,[
-        "SETELT","$",0, mkDomainConstructor $definition],:
--- If we call addMutableArg this early, then recurise calls to this domain
--- (e.g. while testing predicates) will generate new domains => trouble
---      "SETELT","$",0,addMutableArg mkDomainConstructor $definition],:
-          [["SETELT","$",position(name,locals),name]
-            for name in $ResetItems | MEMQ(name,locals)],
-             :[($mutableDomain => '(RPLACD (LASTNODE (ELT $ 0))
-                                           (LIST (GENSYM)));[]) ],
-              "$"]
-  for u in $getDomainCode repeat
-    u is ["%LET",.,u'] and u' is ['getDomainView,.,u''] =>
-      $packagesUsed:=union(CategoriesFromGDC u'',$packagesUsed)
-  $packagesUsed:=union($functorLocalParameters,$packagesUsed)
-  $getDomainCode:= nil
-     --if we didn't kill this, DEFINE would insert it in the wrong place
-  optFunctorBody code
- 
-subTree(u,v) ==
-  v=u => true
-  ATOM v => nil
-  or/[subTree(u,v') for v' in v]
- 
-setPackageLocals(pac,locs) ==
-  for var in locs for i in 0.. | var^=nil repeat pac.i:= var
- 
-PackageDescendCode(code,flag,viewAssoc) ==
-               --flag is true if we are walking down code always executed
-               --nil if we are in conditional code
-  code=nil => nil
-  code="%noBranch" => nil
-  code is ["add",base,:codelist] =>
-    systemError '"packages may not have add clauses"
-  code is ["PROGN",:codelist] =>
-    ["PROGN",:
-      [v for u in codelist | (v:= PackageDescendCode(u,flag,viewAssoc))^=nil]]
-  code is ["COND",:condlist] =>
-    c:=
-      ["COND",:
-        [[u2:= ProcessCond(first u,viewAssoc),:
-         (if null u2
-             then nil
-             else
-              [PackageDescendCode(v,flag and TruthP u2,
-                if first u is ["HasCategory",dom,cat]
-                   then [[dom,:cat],:viewAssoc]
-                   else viewAssoc) for v in rest u])] for u in condlist]]
-    TruthP CAADR c => ["PROGN",:CDADR c]
-    c
-  code is ["%LET",name,body,:.] =>
-    if not MEMQ(name,$ResetItems) then $ResetItems:= [name,:$ResetItems]
-    if body is [a,:.] and isFunctor a
-      then $packagesUsed:=[body,:$packagesUsed]
-    code
-  code is ["CodeDefine",sig,implem] =>
-             --Generated by doIt in COMPILER BOOT
-    dom:= "$"
-    dom:=
-      u:= LASSOC(dom,viewAssoc) => ["getDomainView",dom,u]
-      dom
-    body:= ["CONS",implem,dom]
-    SetFunctionSlots(sig,body,flag,"original")
-  code is [":",:.] => (RPLACA(code,"LIST"); RPLACD(code,NIL))
-      --Yes, I know that's a hack, but how else do you kill a line?
-  code is ["LIST",:.] => nil
-  code is ["MDEF",:.] => nil
-  code is ["devaluate",:.] => nil
-  code is ["call",:.] => code
-  code is ["SETELT",:.] => code
-  code is ["QSETREFV",:.] => code
-  code is ["setShellEntry",:.] => code
-  stackWarning('"unknown Package code: %1 ",[code])
-  code
- 
-mkOperatorEntry(domainOrPackage,opSig is [op,sig,:flag],pred,count) ==
-  domainOrPackage^="domain" =>
-    [opSig,pred,["PAC","$",name]] where
-      name() == encodeFunctionName(op,domainOrPackage,sig,":",count)
-  null flag => [opSig,pred,["ELT","$",count]]
-  first flag="constant" => [[op,sig],pred,["CONST","$",count]]
-  systemError ["unknown variable mode: ",flag]
- 
-optPackageCall(x,["PAC",packageVariableOrForm,functionName],arglist) ==
-  RPLACA(x,functionName)
-  RPLACD(x,[:arglist,packageVariableOrForm])
-  x
- 
---% Code for encoding function names inside package or domain
- 
-encodeFunctionName(fun,package is [packageName,:arglist],signature,sep,count)
-   ==
-    signature':= MSUBST("$",package,signature)
-    reducedSig:= mkRepititionAssoc [:rest signature',first signature']
-    encodedSig:=
-      ("STRCONC"/[encodedPair for [n,:x] in reducedSig]) where
-        encodedPair() ==
-          n=1 => encodeItem x
-          STRCONC(STRINGIMAGE n,encodeItem x)
-    encodedName:= INTERNL(getAbbreviation(packageName,#arglist),";",
-        encodeItem fun,";",encodedSig, sep,STRINGIMAGE count)
-    if $LISPLIB then
-      $lisplibSignatureAlist:=
-        [[encodedName,:signature'],:$lisplibSignatureAlist]
-    encodedName
- 
-splitEncodedFunctionName(encodedName, sep) ==
-    -- [encodedPackage, encodedItem, encodedSig, sequenceNo] or NIL
-    -- sep0 is the separator used in "encodeFunctionName".
-    sep0 := '";"
-    if not STRINGP encodedName then
-        encodedName := STRINGIMAGE encodedName
-    null (p1 := STRPOS(sep0, encodedName, 0,    '"*")) => nil
-    null (p2 := STRPOS(sep0, encodedName, p1+1, '"*")) => 'inner
---  This is picked up in compile for inner functions in partial compilation
-    null (p3 := STRPOS(sep,  encodedName, p2+1, '"*")) => nil
-    s1 := SUBSTRING(encodedName, 0,    p1)
-    s2 := SUBSTRING(encodedName, p1+1, p2-p1-1)
-    s3 := SUBSTRING(encodedName, p2+1, p3-p2-1)
-    s4 := SUBSTRING(encodedName, p3+1, nil)
-    [s1, s2, s3, s4]
- 
-mkRepititionAssoc l ==
-  mkRepfun(l,1) where
-    mkRepfun(l,n) ==
-      null l => nil
-      l is [x] => [[n,:x]]
-      l is [x, =x,:l'] => mkRepfun(rest l,n+1)
-      [[n,:first l],:mkRepfun(rest l,1)]
- 
-encodeItem x ==
-  x is [op,:argl] => getCaps op
-  IDENTP x => PNAME x
-  STRINGIMAGE x
- 
-getCaps x ==
-  s:= STRINGIMAGE x
-  clist:= [c for i in 0..MAXINDEX s | UPPER_-CASE_-P (c:= s.i)]
-  null clist => '"__"
-  "STRCONC"/[first clist,:[L_-CASE u for u in rest clist]]
- 
---% abbreviation code
- 
-getAbbreviation(name,c) ==
-  --returns abbreviation of name with c arguments
-  x := constructor? name
-  X := ASSQ(x,$abbreviationTable) =>
-    N:= ASSQ(name,rest X) =>
-      C:= ASSQ(c,rest N) => rest C --already there
-      newAbbreviation:= mkAbbrev(X,x)
-      RPLAC(rest N,[[c,:newAbbreviation],:rest N])
-      newAbbreviation
-    newAbbreviation:= mkAbbrev(X,x)
-    RPLAC(rest X,[[name,[c,:newAbbreviation]],:rest X])
-    newAbbreviation
-  $abbreviationTable:= [[x,[name,[c,:x]]],:$abbreviationTable]
-  x
- 
-mkAbbrev(X,x) == addSuffix(alistSize rest X,x)
- 
-alistSize c ==
-  count(c,1) where
-    count(x,level) ==
-      level=2 => #x
-      null x => 0
-      count(CDAR x,level+1)+count(rest x,level)
- 
-addSuffix(n,u) ==
-  ALPHA_-CHAR_-P (s:= STRINGIMAGE u).(MAXINDEX s) => INTERN STRCONC(s,STRINGIMAGE n)
-  INTERNL STRCONC(s,STRINGIMAGE ";",STRINGIMAGE n)
- 
-