diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/interp/category.boot (renamed from src/interp/category.boot.pamphlet) | 208 | ||||
| -rw-r--r-- | src/interp/cattable.boot (renamed from src/interp/cattable.boot.pamphlet) | 26 |
2 files changed, 65 insertions, 169 deletions
diff --git a/src/interp/category.boot.pamphlet b/src/interp/category.boot index 5da2cc25..c6a411bb 100644 --- a/src/interp/category.boot.pamphlet +++ b/src/interp/category.boot @@ -1,134 +1,3 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp category.boot} Pamphlet} -\author{The Axiom Team} - -\begin{document} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject - -\section{mkCategory} - -This code defines the structure of a category. -<<mkCategory>>= -mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) == - NSigList:= nil - if PrincipalAncestor=nil then count:= 6 else count:= SIZE PrincipalAncestor - sigList:= - [if s is [sig,pred] - then - or/[x is [[ =sig,.,:impl],:num] for x in NSigList] => [sig,pred,:impl] - --only needed for multiple copies of sig - num:= if domainOrPackage="domain" then count else count-5 - nsig:= mkOperatorEntry("domain",sig,pred,num) - NSigList:= [[nsig,:count],:NSigList] - count:= count+1 - nsig - else s for s in sigList] - NewLocals:= nil - for s in sigList repeat - NewLocals:= union(NewLocals,Prepare CADAR s) where - Prepare u == "union"/[Prepare2 v for v in u] - Prepare2 v == - v is "$" => nil - STRINGP v => nil - atom v => [v] - MEMQ(first v,$PrimitiveDomainNames) => nil - --This variable is set in INIT LISP - --It is a list of all the domains that we need not cache - v is ["Union",:w] => - "union"/[Prepare2 x for x in stripUnionTags w] - v is ["Mapping",:w] => "union"/[Prepare2 x for x in w] - v is ["List",w] => Prepare2 w - v is ["Record",.,:w] => "union"/[Prepare2 CADDR x for x in w] - [v] - OldLocals:= nil - if PrincipalAncestor then for u in (OldLocals:= CADDR PrincipalAncestor.4) - repeat NewLocals:= delete(first u,NewLocals) - for u in NewLocals repeat - (OldLocals:= [[u,:count],:OldLocals]; count:= count+1) - v:= GETREFV count - v.(0):= nil - v.(1):= sigList - v.2:= attList - v.3:= ["Category"] - if not PrincipalAncestor=nil - then - for x in 6..SIZE PrincipalAncestor-1 repeat v.x:= PrincipalAncestor.x - v.4:= [first PrincipalAncestor.4,CADR PrincipalAncestor.4,OldLocals] - else v.4:= [nil,nil,OldLocals] --associated categories and domains - v.5:= domList - for [nsig,:sequence] in NSigList repeat v.sequence:= nsig - v - -@ -\section{hasCategoryBug} -The hasCategoryBug (bug000001)\cite{2} manifests itself by causing a -value stack overflow when compiling algebra code that uses conditions -that read ``if R has ...'' when using GCL (but not CCL). Essentially -the [[|Ring|]] category keeps getting added to the list each time -[[|Ring|]] is processed. Camm Maguire's mail explains it thus: - -The bottom line is that [[(|Ring|)]] is totally correct until -[[|Algebra|]] is executed, at which point the fourth element returned -by [[(|Ring|)]] is overwritten by the result returned in the fourth -element of the vector returned by [[|Algebra|]]. The point of this -overwrite is at the following form of [[|JoinInner|]] from -[[(int/interp/category.clisp)]] - -\begin{verbatim} - (SETELT |$NewCatVec| 4 (CONS |c| (CONS |FundamentalAncestors| (CONS - (CADDR (ELT |$NewCatVec| 4)) NIL)))) -\end{verbatim} - -called from [[|Algebra;|]] [[(int/algebra/ALGEBRA.NRLIB/code.lsp)]] through - -\begin{verbatim} -(|Join| (|Ring|) (|Module| (QUOTE |t#1|)) (|mkCategory| (QUOTE -|domain|) (QUOTE (((|coerce| ($ |t#1|)) T))) NIL (QUOTE NIL) NIL)) -\end{verbatim} - -I haven't parsed [[|JoinInner|]] yet, but my guess is that there is a -copy-seq in there which is not getting executed in the assignment of -[[|$NewCatVec|]] before the setelt. - -The original code failed to copy the NewCatVec before updating -it. This code from macros.lisp\cite{1} checks whether the array is -adjustable. - -\begin{verbatim} -(defun lengthenvec (v n) - (if (adjustable-array-p v) (adjust-array v n) - (replace (make-array n) v))) -\end{verbatim} -At least in GCL, the code for lengthenvec need not copy the vec to a -new location. In this case the FundamentalAncesters array is adjustable -and in GCL the adjust-array need not, and in this case, does not do a -copy. -<<hasCategoryBug>>= - if reallynew then - n:= SIZE $NewCatVec - FundamentalAncestors:= [[b.(0),condition,n],:FundamentalAncestors] - $NewCatVec:= LENGTHENVEC($NewCatVec,n+1) --- We need to copy the vector otherwise the FundamentalAncestors --- list will get stepped on while compiling "If R has ... " code --- Camm Maguire July 26, 2003 --- copied:= true - copied:= false - originalvector:= false - $NewCatVec.n:= b.(0) - if not copied then $NewCatVec:= COPY_-SEQ $NewCatVec - -- It is important to copy the vector now, - -- in case SigListUnion alters it while - -- performing Operator Subsumption -@ -\section{License} -<<license>>= -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. -- @@ -160,9 +29,6 @@ copy. -- 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 '"g-util" )package "BOOT" @@ -191,7 +57,56 @@ CategoryPrint(D,$e) == atom first u => SAY("Alternate View corresponding to: ",u) PRETTYPRINT u -<<mkCategory>> +mkCategory(domainOrPackage,sigList,attList,domList,PrincipalAncestor) == + NSigList:= nil + if PrincipalAncestor=nil then count:= 6 else count:= SIZE PrincipalAncestor + sigList:= + [if s is [sig,pred] + then + or/[x is [[ =sig,.,:impl],:num] for x in NSigList] => [sig,pred,:impl] + --only needed for multiple copies of sig + num:= if domainOrPackage="domain" then count else count-5 + nsig:= mkOperatorEntry("domain",sig,pred,num) + NSigList:= [[nsig,:count],:NSigList] + count:= count+1 + nsig + else s for s in sigList] + NewLocals:= nil + for s in sigList repeat + NewLocals:= union(NewLocals,Prepare CADAR s) where + Prepare u == "union"/[Prepare2 v for v in u] + Prepare2 v == + v is "$" => nil + STRINGP v => nil + atom v => [v] + MEMQ(first v,$PrimitiveDomainNames) => nil + --This variable is set in INIT LISP + --It is a list of all the domains that we need not cache + v is ["Union",:w] => + "union"/[Prepare2 x for x in stripUnionTags w] + v is ["Mapping",:w] => "union"/[Prepare2 x for x in w] + v is ["List",w] => Prepare2 w + v is ["Record",.,:w] => "union"/[Prepare2 CADDR x for x in w] + [v] + OldLocals:= nil + if PrincipalAncestor then for u in (OldLocals:= CADDR PrincipalAncestor.4) + repeat NewLocals:= delete(first u,NewLocals) + for u in NewLocals repeat + (OldLocals:= [[u,:count],:OldLocals]; count:= count+1) + v:= GETREFV count + v.(0):= nil + v.(1):= sigList + v.2:= attList + v.3:= ["Category"] + if not PrincipalAncestor=nil + then + for x in 6..SIZE PrincipalAncestor-1 repeat v.x:= PrincipalAncestor.x + v.4:= [first PrincipalAncestor.4,CADR PrincipalAncestor.4,OldLocals] + else v.4:= [nil,nil,OldLocals] --associated categories and domains + v.5:= domList + for [nsig,:sequence] in NSigList repeat v.sequence:= nsig + v + isCategory a == REFVECP a and #a>5 and a.3=["Category"] --% Subsumption code (for operators) @@ -568,7 +483,21 @@ JoinInner(l,$e) == if c=true then attl:= [[a,condition],:attl] else attl:= [[a,["and",condition,c]],:attl] -<<hasCategoryBug>> + if reallynew then + n:= SIZE $NewCatVec + FundamentalAncestors:= [[b.(0),condition,n],:FundamentalAncestors] + $NewCatVec:= LENGTHENVEC($NewCatVec,n+1) +-- We need to copy the vector otherwise the FundamentalAncestors +-- list will get stepped on while compiling "If R has ... " code +-- Camm Maguire July 26, 2003 +-- copied:= true + copied:= false + originalvector:= false + $NewCatVec.n:= b.(0) + if not copied then $NewCatVec:= COPY_-SEQ $NewCatVec + -- It is important to copy the vector now, + -- in case SigListUnion alters it while + -- performing Operator Subsumption for b in l repeat sigl:= SigListUnion([DropImplementations u for u in b.(1)],sigl) attl:= @@ -624,10 +553,3 @@ isCategoryForm(x,e) == x is [name,:.] => categoryForm? name atom x => u:= get(x,"macro",e) => isCategoryForm(u,e) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} [[pamphlet:src/interp/macros.lisp.pamphlet]] -\bibitem{2} [[pamphlet:KNOWN.BUGS.pamphlet]] -\end{thebibliography} -\end{document} diff --git a/src/interp/cattable.boot.pamphlet b/src/interp/cattable.boot index 61b406c3..c5bb711c 100644 --- a/src/interp/cattable.boot.pamphlet +++ b/src/interp/cattable.boot @@ -1,20 +1,3 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp cattable.boot} Pamphlet} -\author{The Axiom Team} - -\begin{document} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject - -\section{License} - -<<license>>= -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. -- @@ -46,9 +29,6 @@ -- 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 '"simpbool" import '"g-util" @@ -523,9 +503,3 @@ clearTempCategoryTable(catNames) == -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} |