* Makefile.pamphlet (functor.$(FASLEXT)): New rule.

	(<<functor.clisp>>): Remove.
	* functor.boot.pamphlet: Push into package "BOOT".

5 files changed, 60 insertions, 92 deletions

diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog
index bc1dc193..f74f3000 100644
--- a/src/interp/ChangeLog
+++ b/src/interp/ChangeLog
@@ -1,4 +1,10 @@
 2007-11-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* Makefile.pamphlet (functor.$(FASLEXT)): New rule.
+	(<<functor.clisp>>): Remove.
+	* functor.boot.pamphlet: Push into package "BOOT".
+
+2007-11-01  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 	    Waldek Hebisch <hebisch@math.uni.wroc.pl>
 
 	* int-top.boot (ncParseFromString): Fix thinko.
diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in
index b2f00424..97fac659 100644
--- a/src/interp/Makefile.in
+++ b/src/interp/Makefile.in
@@ -457,6 +457,9 @@ define.$(FASLEXT): define.boot cattable.$(FASLEXT) category.$(FASLEXT) \
 			c-util.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
 
+functor.$(FASLEXT): functor.boot category.$(FASLEXT) c-util.$(FASLEXT)
+	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
+
 category.$(FASLEXT): category.boot g-util.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
 
@@ -689,10 +692,6 @@ database.clisp: database.boot
 	@ echo 243 making $@ from $<
 	@ echo '(old-boot::boot "database.boot")' | ${DEPSYS}
 
-functor.clisp: functor.boot
-	@ echo 254 making $@ from $<
-	@ echo '(old-boot::boot "functor.boot")' | ${DEPSYS}
-
 i-analy.clisp: i-analy.boot
 	@ echo 280 making $@ from $<
 	@ echo '(old-boot::boot "i-analy.boot")' | ${DEPSYS}
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet
index 9ff90c55..69abbb73 100644
--- a/src/interp/Makefile.pamphlet
+++ b/src/interp/Makefile.pamphlet
@@ -1116,14 +1116,6 @@ database.clisp: database.boot
 	@ echo '(old-boot::boot "database.boot")' | ${DEPSYS}
 @
 
-\subsection{functor.boot}
-
-<<functor.clisp>>=
-functor.clisp: functor.boot
-	@ echo 254 making $@ from $<
-	@ echo '(old-boot::boot "functor.boot")' | ${DEPSYS}
-@
-
 \subsection{i-analy.boot}
 
 <<i-analy.clisp>>=
@@ -1564,6 +1556,9 @@ define.$(FASLEXT): define.boot cattable.$(FASLEXT) category.$(FASLEXT) \
 			c-util.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
 
+functor.$(FASLEXT): functor.boot category.$(FASLEXT) c-util.$(FASLEXT)
+	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
+
 category.$(FASLEXT): category.boot g-util.$(FASLEXT)
 	$(BOOTSYS) -- --compile --boot="old" --output=$@ --load-directory=. $<
 
@@ -1774,8 +1769,6 @@ boot-pkg.$(FASLEXT): boot-pkg.lisp
 
 <<database.clisp>>
 
-<<functor.clisp>>
-
 <<i-analy.clisp>>
 
 <<i-code.clisp>>
diff --git a/src/interp/define.boot.pamphlet b/src/interp/define.boot
index 6bebbf01..20238790 100644
--- a/src/interp/define.boot.pamphlet
+++ b/src/interp/define.boot
@@ -1,45 +1,7 @@
-\documentclass{article}
-\usepackage{axiom}
-
-\title{\File{src/interp/define.boot} Pamphlet}
-\author{The Axiom Team}
-
-\begin{document}
-\maketitle
-\begin{abstract}
-\end{abstract}
-\eject
-\tableofcontents
-\eject
-
-\section{compCapsuleItems}
-
-The variable [[data]] appears to be unbound at runtime. Optimized
-code won't check for this but interpreted code fails. We should
-PROVE that data is unbound at runtime but have not done so yet.
-Rather than remove the code entirely (since there MIGHT be a 
-path where it is used) we check for the runtime bound case and
-assign [[$myFunctorBody]] if data has a value.
-
-The [[compCapsuleInner]] function in this file LOOKS like it sets
-data and expects code to manipulate the assigned data structure.
-Since we can't be sure we take the least disruptive course of action.
-<<compCapsuleItems>>=
-compCapsuleItems(itemlist,$predl,$e) ==
-  $TOP__LEVEL: local
-  $myFunctorBody :local         -- := data    ---needed for translator
-  if (BOUNDP 'data) then 
-    $myFunctorBody:= SYMBOL_-VALUE 'data -- unbound at runtime?
-  $signatureOfForm: local
-  $suffix: local:= 0
-  for item in itemlist repeat $e:= compSingleCapsuleItem(item,$predl,$e)
-  $e
- 
-@ 
-\section{License}
-<<license>>=
 -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
 -- All rights reserved.
+-- Copyright (C) 2007, 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
@@ -69,9 +31,6 @@ compCapsuleItems(itemlist,$predl,$e) ==
 -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-@
-<<*>>=
-<<license>>
 
 import '"c-util"
 import '"cattable"
@@ -183,7 +142,7 @@ macroExpand(x,e) ==   --not worked out yet
 macroExpandList(l,e) ==
   -- macros should override niladic props
   (l is [name]) and IDENTP name and GETDATABASE(name, 'NILADIC) and
-	(u := get(name, 'macro, e)) => macroExpand(u,e)
+        (u := get(name, 'macro, e)) => macroExpand(u,e)
   [macroExpand(x,e) for x in l]
  
 compDefineCategory1(df is ['DEF,form,sig,sc,body],m,e,prefix,fal) ==
@@ -1078,8 +1037,8 @@ compile u ==
       encodeFunctionName(op,$functorForm,$signatureOfForm,";",$suffix)
      where
        isLocalFunction op ==
-	 null member(op,$formalArgList) and
-	   getmode(op,$e) is ['Mapping,:.]
+         null member(op,$formalArgList) and
+           getmode(op,$e) is ['Mapping,:.]
     u:= [op',lamExpr]
   -- If just updating certain functions, check for previous existence.
   -- Deduce old sequence number and use it (items have been skipped).
@@ -1259,7 +1218,18 @@ processFunctor(form,signature,data,localParList,e) ==
     error "CategoryDefaults is a reserved name"
   buildFunctor(form,signature,data,localParList,e)
  
-<<compCapsuleItems>>
+compCapsuleItems(itemlist,$predl,$e) ==
+  $TOP__LEVEL: local
+  $myFunctorBody :local         -- := data    ---needed for translator
+  -- ??? the following line needs more investigation.  Why is data
+  -- ??? expected to be a dynamic variable? Looks more like a bug.
+  if (BOUNDP 'data) then 
+    $myFunctorBody:= SYMBOL_-VALUE 'data -- unbound at runtime?
+  $signatureOfForm: local
+  $suffix: local:= 0
+  for item in itemlist repeat $e:= compSingleCapsuleItem(item,$predl,$e)
+  $e
+ 
 compSingleCapsuleItem(item,$predl,$e) ==
   doIt(macroExpandInPlace(item,$e),$predl)
   $e
@@ -1370,11 +1340,11 @@ doItIf(item is [.,p,x,y],$predl,$e) ==
    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]
+         nils:=[u,:nils]
        else
-	 gv := GENSYM()
-	 ans:=[['LET,gv,u],:ans]
-	 nils:=[gv,:nils]
+         gv := GENSYM()
+         ans:=[['LET,gv,u],:ans]
+         nils:=[gv,:nils]
      n:=n+1
    $functorLocalParameters:=[:oldFLP,:NREVERSE nils]
    NREVERSE ans
@@ -1535,9 +1505,3 @@ compCategoryItem(x,predl) ==
 
 
 
-@
-\eject
-\begin{thebibliography}{99}
-\bibitem{1} nothing
-\end{thebibliography}
-\end{document}
diff --git a/src/interp/functor.boot.pamphlet b/src/interp/functor.boot.pamphlet
index 7e952a88..60111870 100644
--- a/src/interp/functor.boot.pamphlet
+++ b/src/interp/functor.boot.pamphlet
@@ -50,6 +50,10 @@
 <<*>>=
 <<license>>
 
+import '"c-util"
+import '"category"
+)package "BOOT"
+
 --%  Domain printing
 keyItem a ==
   isDomain a => CDAR a.4
@@ -243,7 +247,7 @@ compCategories1(u,v) ==
 NewbFVectorCopy(u,domName) ==
   v:= GETREFV SIZE u
   for i in 0..5 repeat v.i:= u.i
-  for i in 6..MAXINDEX v | PAIRP u.i repeat v.i:= [Undef,[domName,i],:first u.i]
+  for i in 6..MAXINDEX v | PAIRP u.i repeat v.i:= [function Undef,[domName,i],:first u.i]
   v
  
 mkVector u ==
@@ -360,11 +364,12 @@ setVector12 args ==
     args2:=[CDR u,:args2]
   freeof($domainShell.1,args1) and
       freeof($domainShell.2,args1) and
-          freeof($domainShell.4,args1) => nil  where freeof(a,b) ==
-                  ATOM a => NULL MEMQ(a,b)
-                  freeof(CAR a,b) => freeof(CDR a,b)
-                  false
+          freeof($domainShell.4,args1) => nil  
   [['SetDomainSlots124,'$,['QUOTE,args1],['LIST,:args2]]]
+ where freeof(a,b) ==
+	 ATOM a => NULL MEMQ(a,b)
+	 freeof(CAR a,b) => freeof(CDR a,b)
+	 false
  
 SetDomainSlots124(vec,names,vals) ==
   l:= PAIR(names,vals)
@@ -483,7 +488,7 @@ setVector4part3(catNames,catvecList) ==
   generated:= nil
   for u in catvecList for uname in catNames repeat
     for v in CADDR u.4 repeat
-      if w:= ASSOC(first v,generated)
+      if w:= assoc(first v,generated)
          then RPLACD(w,[[rest v,:uname],:rest w])
          else generated:= [[first v,[rest v,:uname]],:generated]
   codeList := nil
@@ -500,7 +505,7 @@ PrepareConditional u == u
 setVector5(catNames,locals) ==
   generated:= nil
   for u in locals for uname in catNames repeat
-    if w:= ASSOC(u,generated)
+    if w:= assoc(u,generated)
        then RPLACD(w,[uname,:rest w])
        else generated:= [[u,uname],:generated]
   [(w:= mkVectorWithDeferral(first u,first rest u);
@@ -611,7 +616,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) ==
       NREVERSE [v for u in REVERSE codelist |
                     (v:= DescendCode(u,flag,viewAssoc,EnvToPass))^=nil]]
   code is ['COND,:condlist] =>
-    c:= [[u2:= ProcessCond(first u,viewAssoc),:q] for u in condlist] where q ==
+    c:= [[u2:= ProcessCond(first u,viewAssoc),:q] for u in condlist] where q() ==
           null u2 => nil
           f:=
             TruthP u2 => flag;
@@ -769,7 +774,7 @@ CheckVector(vec,name,catvecListMaker) ==
         if y=v then code:=
           [[($QuickCode => 'QSETREFV; 'SETELT),name,i,x],:code]
     if name='$ then
-      ASSOC(first v,$CheckVectorList) => nil
+      assoc(first v,$CheckVectorList) => nil
       $CheckVectorList:=
         [[first v,:makeMissingFunctionEntry(condAlist,i)],:$CheckVectorList]
 --  member(first v,$CheckVectorList) => nil
@@ -863,7 +868,7 @@ InvestigateConditions catvecListMaker ==
       ['AND,:u]
     for [v,:.] in newS repeat
       for v' in [v,:CAR (CatEval v).4] repeat
-        if (w:=ASSOC(v',$HackSlot4)) then
+        if (w:=assoc(v',$HackSlot4)) then
           RPLAC(rest w,if rest w then mkOr(u,rest w) else u)
     (list:= update(list,u,secondaries,newS)) where
       update(list,cond,secondaries,newS) ==
@@ -907,17 +912,7 @@ ICformat u ==
           l1:=mkAnd(u,l1)
         l1
       u is ['OR,:l] =>
-        (l:= ORreduce l) where
-          ORreduce l ==
-            for u in l | u is ['AND,:.] or u is ['and,:.] repeat
-                                  --check that B causes (and A B) to go
-              for v in l | not (v=u) repeat
-                if member(v,u) or (and/[member(w,u) for w in v]) then l:=
-                  delete(u,l)
-                       --v subsumes u
-                           --Note that we are ignoring AND as a component.
-                           --Convince yourself that this code still works
-            l
+        (l:= ORreduce l)
         LENGTH l=1 => ICformat first l
         l:= ORreduce REMDUP [ICformat u for u in l]
                  --causes multiple ANDs to be squashed, etc.
@@ -941,6 +936,17 @@ ICformat u ==
         LENGTH l=1 => first l
         ['OR,:l]
       systemErrorHere '"ICformat"
+  where
+    ORreduce l ==
+      for u in l | u is ['AND,:.] or u is ['and,:.] repeat
+			    --check that B causes (and A B) to go
+	for v in l | not (v=u) repeat
+	  if member(v,u) or (and/[member(w,u) for w in v]) then l:=
+	    delete(u,l)
+		 --v subsumes u
+		     --Note that we are ignoring AND as a component.
+		     --Convince yourself that this code still works
+      l
  
 partPessimise(a,trueconds) ==
   atom a => a