diff options
Diffstat (limited to 'src/interp')
| -rw-r--r-- | src/interp/ChangeLog | 22 | ||||
| -rw-r--r-- | src/interp/Makefile.in | 23 | ||||
| -rw-r--r-- | src/interp/Makefile.pamphlet | 121 | ||||
| -rw-r--r-- | src/interp/interop.boot.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/mark.boot.pamphlet | 6 | ||||
| -rw-r--r-- | src/interp/parse.boot.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/postpar.boot.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/showimp.boot.pamphlet | 6 | ||||
| -rw-r--r-- | src/interp/template.boot (renamed from src/interp/template.boot.pamphlet) | 23 | ||||
| -rw-r--r-- | src/interp/termrw.boot (renamed from src/interp/termrw.boot.pamphlet) | 45 | ||||
| -rw-r--r-- | src/interp/topics.boot | 240 | ||||
| -rw-r--r-- | src/interp/trace.boot (renamed from src/interp/trace.boot.pamphlet) | 28 | ||||
| -rw-r--r-- | src/interp/varini.boot (renamed from src/interp/varini.boot.pamphlet) | 34 | ||||
| -rw-r--r-- | src/interp/wi2.boot.pamphlet | 2 | ||||
| -rw-r--r-- | src/interp/xrun.boot (renamed from src/interp/xrun.boot.pamphlet) | 170 | ||||
| -rw-r--r-- | src/interp/xruncomp.boot (renamed from src/interp/xruncomp.boot.pamphlet) | 42 |
16 files changed, 368 insertions, 400 deletions
diff --git a/src/interp/ChangeLog b/src/interp/ChangeLog index 43c20c12..3071735f 100644 --- a/src/interp/ChangeLog +++ b/src/interp/ChangeLog @@ -1,3 +1,25 @@ +2007-09-11 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * template.boot: New. + * template.boot.pamphlet: Move content to template.boot. Remove. + * termrw.boot: New. + * termrw.boot.pamphlet: Move content to template.boot. Remove. + * topics.boot: New. + * topics.boot.pamphlet: Move content to topics.boot. Remove. + * trace.boot: New. + * trace.boot.pamphlet: Move content to trace.boot. Remove. + * varini.boot: New. + * varini.boot.pamphlet: Move content to varini.boot. Remove. + * xrun.boot: New. + * xrun.boot.pamphlet: Move content to xrun.boot. Remove + * xruncomp.boot: New. + * xruncomp.boot.pamphlet: Move content to xruncomp.boot. Remove. + * Makefile.pamphlet (<<xruncomp.clisp>>): Remove. + (<<trace.lisp>>): Likewise. + (<<topics.clisp>>): Likewise. + (<<template.clisp>>): Likewise. + (<<termrw.clisp>>): Likewise. + 2007-09-10 Gabriel Dos Reis <gdr@cs.tamu.edu> * i-output.boot.pamphlet ($defaultSpecialCharacters): Define as diff --git a/src/interp/Makefile.in b/src/interp/Makefile.in index 3027455a..3f0fed26 100644 --- a/src/interp/Makefile.in +++ b/src/interp/Makefile.in @@ -6,7 +6,7 @@ DOC=$(axiom_target_docdir)/src/interp BOOK=$(axiom_target_docdir) # Command to translate Boot to Common Lisp -BOOT_TO_LISP = $(BOOTSYS) -- --translate $< +BOOT_TO_LISP = $(BOOTSYS) -- --translate --output=$@ $< # Command to translate Common Lisp to native object code COMPILE_LISP = $(DEPSYS) -- --compile --output=$@ $< @@ -821,32 +821,11 @@ setvart.clisp: setvart.boot @ echo 398 making $@ from $< @ echo '(progn (old-boot::boot "setvart.boot"))' | ${DEPSYS} -template.clisp: template.boot - @ echo 408 making $@ from $< - @ echo '(progn (old-boot::boot "template.boot"))' | ${DEPSYS} - -termrw.clisp: termrw.boot - @ echo 411 making $@ from $< - @ echo '(progn (old-boot::boot "termrw.boot"))' | ${DEPSYS} - -topics.clisp: topics.boot - @ echo 495 making $@ from $< - @ echo '(progn (old-boot::boot "topics.boot"))' | ${DEPSYS} - -trace.clisp: trace.boot - @ echo 414 making $@ from $< - @ echo '(progn (old-boot::boot "trace.boot"))' | ${DEPSYS} - ../algebra/warm.data: $(srcdir)/Makefile.pamphlet @ echo 2 building warm.data $(axiom_build_document) --tangle=warm.data --output=$@ $< -xruncomp.clisp: xruncomp.boot - @ echo 459 making $@ from $< - @ echo '(progn (old-boot::boot "xruncomp.boot"))' | ${DEPSYS} - - buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 165922ab..ad4d277d 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -56,7 +56,7 @@ DOC=$(axiom_target_docdir)/src/interp BOOK=$(axiom_target_docdir) # Command to translate Boot to Common Lisp -BOOT_TO_LISP = $(BOOTSYS) -- --translate $< +BOOT_TO_LISP = $(BOOTSYS) -- --translate --output=$@ $< # Command to translate Common Lisp to native object code COMPILE_LISP = $(DEPSYS) -- --compile --output=$@ $< @@ -1718,30 +1718,6 @@ setvart.clisp: setvart.boot @ echo '(progn (old-boot::boot "setvart.boot"))' | ${DEPSYS} @ -\subsection{template.boot} - -<<template.clisp>>= -template.clisp: template.boot - @ echo 408 making $@ from $< - @ echo '(progn (old-boot::boot "template.boot"))' | ${DEPSYS} -@ - -\subsection{termrw.boot} - -<<termrw.clisp>>= -termrw.clisp: termrw.boot - @ echo 411 making $@ from $< - @ echo '(progn (old-boot::boot "termrw.boot"))' | ${DEPSYS} -@ - -\subsection{trace.boot} - -<<trace.clisp>>= -trace.clisp: trace.boot - @ echo 414 making $@ from $< - @ echo '(progn (old-boot::boot "trace.boot"))' | ${DEPSYS} -@ - \subsection{as.boot} <<as.clisp>>= @@ -1822,14 +1798,6 @@ htcheck.clisp: htcheck.boot @ echo '(progn (old-boot::boot "htcheck.boot"))' | ${DEPSYS} @ -\subsection{xruncomp.boot} - -<<xruncomp.clisp>>= -xruncomp.clisp: xruncomp.boot - @ echo 459 making $@ from $< - @ echo '(progn (old-boot::boot "xruncomp.boot"))' | ${DEPSYS} -@ - \subsection{ax.boot} <<ax.clisp>>= @@ -1894,14 +1862,6 @@ br-saturn.clisp: br-saturn.boot @ echo '(progn (old-boot::boot "br-saturn.boot"))' | ${DEPSYS} @ -\subsection{topics.boot} - -<<topics.clisp>>= -topics.clisp: topics.boot - @ echo 495 making $@ from $< - @ echo '(progn (old-boot::boot "topics.boot"))' | ${DEPSYS} -@ - \subsection{br-prof.boot} <<br-prof.clisp>>= @@ -2173,19 +2133,8 @@ $(AUTO)/%.$(FASLEXT): %.$(FASLEXT) <<setvart.clisp>> -<<template.clisp>> - -<<termrw.clisp>> - -<<topics.clisp>> - -<<trace.clisp>> - <<warm.data.stanza>> -<<xruncomp.clisp>> - - buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT) $(BOOTSYS) -- --compile --output=$@ --load-directory=. $< @@ -2193,71 +2142,5 @@ buildom.$(FASLEXT): buildom.boot sys-macros.$(FASLEXT) <<DVI from pamphlet>> @ -pp -\eject -\begin{thebibliography}{99} -\bibitem{1} \File{Makefile.pamphlet} -\bibitem{2} \File{src/boot/Makefile.pamphlet} -\bibitem{4} \File{src/interp/setq.lisp.pamphlet} -\bibitem{5} \File{src/interp/patches.lisp.pamphlet} -\bibitem{6} {\bf www.aldor.org} -\bibitem{7} \File{src/interp/apply.boot.pamphlet} -\bibitem{8} \File{src/interp/bits.lisp.pamphlet} -\bibitem{9} \File{src/interp/bootlex.lisp.pamphlet} -\bibitem{10} \File{src/interp/cfuns.lisp.pamphlet} -\bibitem{11} \File{src/interp/comp.lisp.pamphlet} -\bibitem{12} \File{src/interp/construc.lisp.pamphlet} -\bibitem{13} \File{src/interp/daase.lisp.pamphlet} -\bibitem{14} \File{src/interp/debug.lisp.pamphlet} -\bibitem{15} \File{src/interp/def.lisp.pamphlet} -\bibitem{16} \File{src/interp/fortcall.boot.pamphlet} -\bibitem{17} \File{src/interp/fname.lisp.pamphlet} -\bibitem{18} \File{src/interp/fnewmeta.lisp.pamphlet} -\bibitem{19} \File{src/interp/ggreater.lisp.pamphlet} -\bibitem{20} \File{src/interp/hash.lisp.pamphlet} -\bibitem{21} \File{src/interp/macros.lisp.pamphlet} -\bibitem{22} \File{src/interp/metalex.lisp.pamphlet} -\bibitem{24} \File{src/interp/monitor.lisp.pamphlet} -\bibitem{25} \File{src/interp/newaux.lisp.pamphlet} -\bibitem{26} \File{src/interp/nlib.lisp.pamphlet} -\bibitem{27} \File{src/interp/nocompil.lisp.pamphlet} -\bibitem{28} \File{src/interp/nspadaux.lisp.pamphlet} -\bibitem{29} \File{src/interp/parsing.lisp.pamphlet} -\bibitem{30} \File{src/interp/postprop.lisp.pamphlet} -\bibitem{31} \File{src/interp/preparse.lisp.pamphlet} -\bibitem{32} \File{src/interp/property.lisp.pamphlet} -\bibitem{33} \File{src/interp/sockio.lisp.pamphlet} -\bibitem{34} \File{src/interp/spad.lisp.pamphlet} -\bibitem{35} \File{src/interp/spaderror.lisp.pamphlet} -\bibitem{37} \File{src/interp/union.lisp.pamphlet} -\bibitem{38} \File{src/interp/util.lisp.pamphlet} -\bibitem{39} \File{src/interp/vmlisp.lisp.pamphlet} -\bibitem{40} \File{src/interp/alql.boot.pamphlet} -\bibitem{41} \File{src/interp/buildom.boot.pamphlet} -\bibitem{42} \File{src/interp/c-util.boot.pamphlet} -\bibitem{43} \File{src/interp/nag-c02.boot.pamphlet} -\bibitem{44} \File{src/interp/nag-c05.boot.pamphlet} -\bibitem{45} \File{src/interp/nag-c06.boot.pamphlet} -\bibitem{46} \File{src/interp/nag-d01.boot.pamphlet} -\bibitem{47} \File{src/interp/nag-d02.boot.pamphlet} -\bibitem{48} \File{src/interp/nag-d03.boot.pamphlet} -\bibitem{49} \File{src/interp/nag-e01.boot.pamphlet} -\bibitem{51} \File{src/interp/nag-e02.boot.pamphlet} -\bibitem{52} \File{src/interp/nag-e04.boot.pamphlet} -\bibitem{53} \File{src/interp/nag-f01.boot.pamphlet} -\bibitem{54} \File{src/interp/nag-f02.boot.pamphlet} -\bibitem{55} \File{src/interp/nag-f04.boot.pamphlet} -\bibitem{56} \File{src/interp/nag-f07.boot.pamphlet} -\bibitem{57} \File{src/interp/nag-s.boot.pamphlet} -\bibitem{58} \File{src/interp/category.boot.pamphlet} -\bibitem{59} \File{src/interp/cattable.boot.pamphlet} -\bibitem{60} \File{src/interp/c-doc.boot.pamphlet} -\bibitem{61} \File{src/interp/clam.boot.pamphlet} -\bibitem{62} \File{src/interp/clammed.boot.pamphlet} -\bibitem{63} \File{src/interp/compat.boot.pamphlet} -\bibitem{64} \File{src/interp/compiler.boot.pamphlet} -\bibitem{65} \File{src/interp/profile.boot.pamphlet} -\bibitem{66} \File{src/interp/compress.boot.pamphlet} -\bibitem{67} \File{src/interp/database.boot.pamphlet} -\end{thebibliography} + \end{document} diff --git a/src/interp/interop.boot.pamphlet b/src/interp/interop.boot.pamphlet index 4d346313..88d4e560 100644 --- a/src/interp/interop.boot.pamphlet +++ b/src/interp/interop.boot.pamphlet @@ -619,7 +619,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) == start := QSPLUS(start,QSPLUS(numTableArgs,4)) (success ^= 'failed) and success => if $monitorNewWorld then - sayLooking1('"<----",uu) where uu == + sayLooking1('"<----",uu) where uu() == PAIRP success => [first success,:devaluate rest success] success success diff --git a/src/interp/mark.boot.pamphlet b/src/interp/mark.boot.pamphlet index 83f63d2a..a72c838d 100644 --- a/src/interp/mark.boot.pamphlet +++ b/src/interp/mark.boot.pamphlet @@ -281,7 +281,7 @@ markRepeat(form, T) == markTran(form,form',[dc,:sig],env) == --from compElt/compFormWithModemap dc ^= 'Rep or ^MEMQ('_$,sig) => mkWi('markTran,'WI,form,['call,:form']) - argl := [u for t in rest sig for arg in rest form'] where u == + argl := [u for t in rest sig for arg in rest form'] where u() == t='_$ => argSource := getSourceWI arg IDENTP argSource and getmode(argSource,env) = 'Rep => arg @@ -1294,7 +1294,7 @@ moveImportsAfterDefinitions lines == -- pp defineAlist -- pp importAlist for [name, :i] in defineAlist repeat - or/[fn for [imp, :j] in importAlist] where fn == + or/[fn for [imp, :j] in importAlist] where fn() == substring?(name,imp,0) => moveAlist := [[i,:j], :moveAlist] nil @@ -1465,7 +1465,7 @@ rplacaSubst(x, y, u) == (fn(x, y, u); u) where fn(x,y,u) == u := q buildNewDefinition(op,theSig,formPredAlist) == - newAlist := [fn for item in formPredAlist] where fn == + newAlist := [fn for item in formPredAlist] where fn() == [form,:predl] := item pred := null predl => 'T diff --git a/src/interp/parse.boot.pamphlet b/src/interp/parse.boot.pamphlet index 0af415c6..b4c72963 100644 --- a/src/interp/parse.boot.pamphlet +++ b/src/interp/parse.boot.pamphlet @@ -241,7 +241,7 @@ parseTypeEvaluate form == form parseTypeEvaluateArgs(argl,argml) == - [argVal for arg in argl for md in argml for i in 1..] where argVal == + [argVal for arg in argl for md in argml for i in 1..] where argVal() == isCategoryForm(md,$CategoryFrame) => parseTypeEvaluate arg arg diff --git a/src/interp/postpar.boot.pamphlet b/src/interp/postpar.boot.pamphlet index f5f13b56..4e4d01e7 100644 --- a/src/interp/postpar.boot.pamphlet +++ b/src/interp/postpar.boot.pamphlet @@ -533,7 +533,7 @@ aplTranList x == hasAplExtension argl == or/[x is ["_!",:.] for x in argl] => - u:= [futureArg for x in argl] where futureArg == + u:= [futureArg for x in argl] where futureArg() == x is ["_!",y] => z:= deepestExpression y arglAssoc := [[g := GENVAR(),:aplTran1 z],:arglAssoc] diff --git a/src/interp/showimp.boot.pamphlet b/src/interp/showimp.boot.pamphlet index ae682ad3..49b72338 100644 --- a/src/interp/showimp.boot.pamphlet +++ b/src/interp/showimp.boot.pamphlet @@ -141,7 +141,7 @@ getDomainSigs(D,:option) == getDomainSigs1(D,first option) getDomainSigs1(D,ops) == listSort(function GLESSEQP,u) where - u == [x for x in getDomainOpTable(D,nil) | null ops or MEMQ(CAR x,ops)] + u() == [x for x in getDomainOpTable(D,nil) | null ops or MEMQ(CAR x,ops)] getDomainDocs(D,:option) == domname := D.0 @@ -182,7 +182,7 @@ getCategoriesOfDomain domain == predkeyVec := domain.4.0 catforms := CADR domain.4 [fn for i in 0..MAXINDEX predkeyVec | test] where - test == predkeyVec.i and + test() == predkeyVec.i and (x := catforms . i) isnt ['DomainSubstitutionMacro,:.] fn == VECP x => devaluate x @@ -194,7 +194,7 @@ getInheritanceByDoc(D,op,sig,:options) == catList := KAR options or getExtensionsOfDomain D getDocDomainForOpSig(op,sig,devaluate D,D) or or/[fn for x in catList] or '(NIL NIL) - where fn == getDocDomainForOpSig(op,sig,substDomainArgs(D,x),D) + where fn() == getDocDomainForOpSig(op,sig,substDomainArgs(D,x),D) getDocDomainForOpSig(op,sig,dollar,D) == (u := LASSOC(op,GETDATABASE(CAR dollar,'DOCUMENTATION))) diff --git a/src/interp/template.boot.pamphlet b/src/interp/template.boot index f37828c7..06b03d7a 100644 --- a/src/interp/template.boot.pamphlet +++ b/src/interp/template.boot @@ -1,16 +1,3 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp template.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<<license>>= -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. -- @@ -42,9 +29,7 @@ -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> +)package "BOOT" getOperationAlistFromLisplib x == -- used to be in clammed.boot. Moved on 1/24/94 @@ -351,9 +336,3 @@ makeSpadConstant [fn,dollar,slot] == -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/termrw.boot.pamphlet b/src/interp/termrw.boot index bf52c465..6829defc 100644 --- a/src/interp/termrw.boot.pamphlet +++ b/src/interp/termrw.boot @@ -1,38 +1,3 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp termrw.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\begin{verbatim} -Algorithms for Term Reduction - -The following assumptions are made: - -a term rewrite system is represented by a pair (varlist,varRules) where - varlist is the list of rewrite variables (test by MEMQ) and varRules - is an alist (no variables may occur in varRules) - -the following rewrite functions are available: - termRW looks for a fixpoint in applying varRules, where the outermost - leftmost is reduced first by term1RW - term1RW applies the first rule - -subCopy uses an alist (calls of ASSQ) to substitute a list structure - no left side of a pair of alist may appear on a righthand side - this means, subCopy is an idempotent function - -in both cases copying is only done if necessary to avoid destruction -this means, EQ can be used to check whether something was done - -\end{verbatim} -\section{License} -<<license>>= -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. -- @@ -64,9 +29,7 @@ this means, EQ can be used to check whether something was done -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> +)package "BOOT" termRW(t,R) == -- reduce t by rewrite system R @@ -189,9 +152,3 @@ deepSubCopyOrNil(t,SL) == t2 and ( t0:= deepSubCopyOrNil(t2,SL) ) => CONS(t, CONS(t1,CDR t0)) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/topics.boot b/src/interp/topics.boot new file mode 100644 index 00000000..32a7d7bf --- /dev/null +++ b/src/interp/topics.boot @@ -0,0 +1,240 @@ +-- 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" + +$topicsDefaults := '( + (basic elt setelt qelt qsetelt eval xRange yRange zRange map map_! qsetelt_!) + (conversion coerce convert retract) + (hidden retractIfCan Zero One) + (predicate _< _=) + (algebraic _+ _- _* _*_* _/ quo rem exquo) + (trignometric acos acot acsc asec asin atan cos cot csc sec sin tan) + (hyperbolic acosh acoth acsch asech asinh atanh cosh coth csch sech sinh tanh) + (destructive setelt qsetelt) + (extraction xRange yRange zRange elt qelt) + (transformation map map_!)) + +$topicSynonyms := '( + (b . basic) + (h . hidden) + (e . extended) + (a . algebraic) + (g . algebraic) + (c . construct) + (d . destructive) + (v . conversion) + (m . miscellaneous) + (x . extraction) + (p . predicate) + (tg . trignometric) + (hy . hyperbolic) + (t . transformation)) + +$groupAssoc := '((extended . 1) (basic . 2) (hidden . 4)) + +--======================================================================= +-- Create Hashtable of Operation Properties +--======================================================================= +--called at build-time before making DOCUMENTATION property +mkTopicHashTable() == --given $groupAssoc = ((extended . 1)(basic . 2)(xx . 4)..) + $defaultsHash := MAKE_-HASHTABLE 'ID --keys are ops, value is list of topic names + for [kind,:items] in $topicsDefaults repeat --$topicsDefaults is ((<topic> op ...) ..) + for item in items repeat + HPUT($defaultsHash,item,[kind,:HGET($defaultsHash,item)]) + $conTopicHash := MAKE_-HASHTABLE 'EQL --key is constructor name; value is + instream := OPEN '"topics.data" + while not EOFP instream repeat + line := READLINE instream + while blankLine? line repeat line := READLINE instream + m := MAXINDEX line --file "topics.data" has form: + m = -1 => 'skip --1 ConstructorName: + line.0 = char '_- => 'skip --2 constructorName or operation name + line := trimString line --3-n ... + m := MAXINDEX line -- (blank line) ... + line.m ^= (char '_:) => systemError('"wrong heading") + con := INTERN SUBSTRING(line,0,m) + alist := [lst while not EOFP instream and + not (blankLine? (line := READLINE instream)) and + line.0 ^= char '_- for i in 1.. + | lst := string2OpAlist line] + alist => HPUT($conTopicHash,con,alist) + --initialize table of topic classes + $topicHash := MAKE_-HASHTABLE 'ID --$topicHash has keys: topic and value: index + for [x,:c] in $groupAssoc repeat HPUT($topicHash,x,c) + $topicIndex := CDR LAST $groupAssoc + + --replace each property list by a topic code + --store under each construct an OR of all codes + for con in HKEYS $conTopicHash repeat + conCode := 0 + for pair in HGET($conTopicHash,con) repeat + RPLACD(pair,code := topicCode CDR pair) + conCode := LOGIOR(conCode,code) + HPUT($conTopicHash,con, + [['constructor,:conCode],:HGET($conTopicHash,con)]) + SHUT instream + +--reduce integers stored under names to 1 + its power of 2 + for key in HKEYS $topicHash repeat + HPUT($topicHash,key,INTEGER_-LENGTH HGET($topicHash,key)) + + $conTopicHash --keys are ops or 'constructor', values are codes + +blankLine? line == + MAXINDEX line = -1 or and/[line . j = (char '_ ) for j in 0..MAXINDEX line] + +string2OpAlist s == + m := #s + k := skipBlanks(s,0,m) or return nil + UPPER_-CASE_-P s.k => nil --skip constructor names + k := 0 + while (k := skipBlanks(s,k,m)) repeat + acc := [INTERN SUBSTRING(s,k,-k + (k := charPosition(char '_ ,s,k + 1))),:acc] + acc := NREVERSE acc + --now add defaults + if u := getDefaultProps first acc then acc := [first acc,:u,:rest acc] + acc + +getDefaultProps name == + u := HGET($defaultsHash,name) + if (s := PNAME name).(m := MAXINDEX s) = char '? then u := ['p,:u] + if s.m = char '_! then u := ['destructive,:u] + u + +skipBlanks(u,i,m) == + while i < m and u.i = $charBlank repeat i := i + 1 + i >= m => nil + i + +--======================================================================= +-- Compute Topic Code for Operation +--======================================================================= +topicCode lst == + u := [y for x in lst] where y() == + rename := LASSOC(x,$topicSynonyms) => rename + x + if null intersection('(basic extended hidden),u) then u := ['extended,:u] + bitIndexList := nil + for x in REMDUP u repeat + bitIndexList := [fn x,:bitIndexList] where fn x == + k := HGET($topicHash,x) => k + HPUT($topicHash,x,$topicIndex := $topicIndex * 2) + $topicIndex + code := +/[i for i in bitIndexList] + +--======================================================================= +-- Add Codes to Documentation Property +--======================================================================= +--called to modify DOCUMENTATION property for each "con" +addTopic2Documentation(con,docAlist) == + alist := HGET($conTopicHash,con) or return docAlist + [y for x in docAlist] where y() == + [op,:pairlist] := x + code := LASSOC(op,alist) or 0 + for sigDoc in pairlist repeat + sigDoc is [.,.] => RPLACD(rest sigDoc,code) + systemError sigDoc + docAlist + +--======================================================================= +-- Test: Display Topics for a given constructor +--======================================================================= +td con == + $topicClasses := ASSOCRIGHT mySort + [[HGET($topicHash,key),:key] for key in HKEYS $topicHash] + hash := MAKE_-HASHTABLE 'ID + tdAdd(con,hash) + tdPrint hash + +tdAdd(con,hash) == + v := HGET($conTopicHash,con) + u := addTopic2Documentation(con,v) +--u := GETDATABASE(con,'DOCUMENTATION) + for pair in u | FIXP (code := myLastAtom pair) and (op := CAR pair) ^= 'construct repeat + for x in (names := code2Classes code) repeat HPUT(hash,x,insert(op,HGET(hash,x))) + +tdPrint hash == + for key in mySort HKEYS hash repeat + sayBrightly [key,'":"] + sayBrightlyNT '" " + for x in HGET(hash,key) repeat sayBrightlyNT ['" ",x] + TERPRI() + +topics con == + --assumes that DOCUMENTATION property already has #s added + $topicClasses := ASSOCRIGHT mySort + [[HGET($topicHash,key),:key] for key in HKEYS $topicHash] + hash := MAKE_-HASHTABLE 'ID + tdAdd(con,hash) + for x in REMDUP [CAAR y for y in ancestorsOf(getConstructorForm con,nil)] repeat + tdAdd(x,hash) + for x in HKEYS hash repeat HPUT(hash,x,mySort HGET(hash,x)) + tdPrint hash + +code2Classes cc == + cc := 2*cc + [x while cc ^= 0 for x in $topicClasses | ODDP (cc := QUOTIENT(cc,2))] + +myLastAtom x == + while x is [.,:x] repeat nil + x + +--======================================================================= +-- Transfer Codes to opAlist +--======================================================================= + +transferClassCodes(conform,opAlist) == + transferCodeCon(opOf conform,opAlist) + for x in ancestorsOf(conform,nil) repeat + transferCodeCon(CAAR x,opAlist) + +transferCodeCon(con,opAlist) == + for pair in GETDATABASE(con,'DOCUMENTATION) + | FIXP (code := myLastAtom pair) repeat + u := ASSOC(QCAR pair,opAlist) => RPLACD(LASTNODE u,code) + +--======================================================================= +-- Filter Operation by Topic +--======================================================================= + +filterByTopic(opAlist,topic) == + bitNumber := HGET($topicHash,topic) + [x for x in opAlist + | FIXP (code := myLastAtom x) and LOGBITP(bitNumber,code)] + +listOfTopics(conname) == + doc := GETDATABASE(conname,'DOCUMENTATION) + u := ASSOC('constructor,doc) or return nil + code := myLastAtom u +--null FIXP code => nil + mySort [key for key in HKEYS($topicHash) | LOGBITP(HGET($topicHash,key),code)] + diff --git a/src/interp/trace.boot.pamphlet b/src/interp/trace.boot index 1563ea98..6cfd5d39 100644 --- a/src/interp/trace.boot.pamphlet +++ b/src/interp/trace.boot @@ -1,20 +1,3 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/trace.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,8 @@ -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> + +)package "BOOT" --% Code for tracing functions @@ -848,9 +830,3 @@ break msg == compileBoot fn == _/D_,1(LIST fn,'(_/COMP),nil,nil) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/varini.boot.pamphlet b/src/interp/varini.boot index 14233f02..aa70e21e 100644 --- a/src/interp/varini.boot.pamphlet +++ b/src/interp/varini.boot @@ -1,16 +1,3 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp varini.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<<license>>= -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. -- @@ -42,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>> )package "BOOT" @@ -66,7 +50,7 @@ $SpadNcIncludeRelPath := '"src/include/lang/" --$LibrariesSearchPath := [PathnameDirectory '"./x", -- SpadDirectory $SpadNcLibraryRelPath , --- SpadDirectory $SpadNcLibraryRelPathSrc] +-- SpadDirectory $SpadNcLibraryRelPathSrc] --$IncludesSearchPath := [PathnameDirectory '"./x", -- SpadDirectory $SpadNcIncludeRelPath] @@ -155,9 +139,9 @@ $LispViaSam := false -- the prefix $ncm, since catExcpts (in ncsetvar boot) strips the -- prefix and uses the name. ie. $ncmWarning ==> "Warning" $ncmPhase := NIL -$ncmWarning := 'T +$ncmWarning := "T" $ncmStatistic := NIL -$ncmRemark := 'T +$ncmRemark := "T" $statTmSpShow := 4 $compBugPrefix := '"Bug!" $compUnimplPrefix := '"Unimp" @@ -194,7 +178,7 @@ $ValueMode := 'ValueMode $FullMode := 'FullMode -- Miscellaneous nonsense. -$newcompInteractiveRecovery := 'T +$newcompInteractiveRecovery := "T" $newcompErrorCount := 0 $floatdolla := ['$elt, ['BigFloat], 'bigfloat] $floatilla := [ 'elt, ['BigFloat], 'bigfloat] @@ -244,11 +228,11 @@ $attrCats := ['$imPrGuys, '$toWhereGuys, '$repGuys] -- Soon to be obsolete $showConcrete1 := NIL $showConcrete2 := NIL -$showPhases := 'T +$showPhases := "T" $showSAM := NIL $showform := NIL $showsetr := NIL -$showval := 'T +$showval := "T" $tafon := NIL -- Inits for pseudo kaf files @@ -268,9 +252,3 @@ $oldLibraryInterface := nil -- don't consider old library information. --## Bug in RIOS version of KCL NeedAtLeastOneFunctionInThisFile(x) == x -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/wi2.boot.pamphlet b/src/interp/wi2.boot.pamphlet index 38601fea..e4dd5a8a 100644 --- a/src/interp/wi2.boot.pamphlet +++ b/src/interp/wi2.boot.pamphlet @@ -791,7 +791,7 @@ genDeltaEntry opMmPair == RPLACA(saveNRTdeltaListComp,compEntry) chk(saveNRTdeltaListComp,102) u := - [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index == + [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index() == (n:= POSN1(opModemapPair,$NRTdeltaList)) => n + 1 --n + 1 since $NRTdeltaLength is 1 too large $NRTdeltaList:= [opModemapPair,:$NRTdeltaList] diff --git a/src/interp/xrun.boot.pamphlet b/src/interp/xrun.boot index 9dcc9040..b6be04c5 100644 --- a/src/interp/xrun.boot.pamphlet +++ b/src/interp/xrun.boot @@ -1,16 +1,3 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp xrun.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<<license>>= -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. -- @@ -42,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>> )package "BOOT" @@ -56,26 +40,26 @@ $noSubsumption:=true NRTmakeCategoryAlist() == $depthAssocCache: local := MAKE_-HASHTABLE 'ID $catAncestorAlist: local := NIL - pcAlist := [:[[x,:'T] for x in $uncondAlist],:$condAlist] + pcAlist := [:[[x,:"T"] for x in $uncondAlist],:$condAlist] $levelAlist: local := depthAssocList [CAAR x for x in pcAlist] opcAlist := NREVERSE SORTBY(function NRTcatCompare,pcAlist) newPairlis := [[5 + i,:b] for [.,:b] in $pairlis for i in 1..] slot1 := [[a,:k] for [a,:b] in SUBLIS($pairlis,opcAlist) - | (k := predicateBitIndex b) ^= -1] + | (k := predicateBitIndex b) ^= -1] slot0 := [hasDefaultPackage opOf a for [a,:b] in slot1] sixEtc := [5 + i for i in 1..#$pairlis] formals := ASSOCRIGHT $pairlis for x in slot1 repeat RPLACA(x,EQSUBSTLIST(CONS("$$",sixEtc),CONS('$,formals),CAR x)) -----------code to make a new style slot4 ----------------- - predList := ASSOCRIGHT slot1 --is list of predicate indices + predList := ASSOCRIGHT slot1 --is list of predicate indices maxPredList := "MAX"/predList catformvec := ASSOCLEFT slot1 maxElement := "MAX"/$byteVec ['CONS, ['makeByteWordVec2,MAX(maxPredList,1),MKQ predList], ['CONS, MKQ LIST2VEC slot0, ['CONS, MKQ LIST2VEC [encodeCatform x for x in catformvec], - ['makeByteWordVec2,maxElement,MKQ $byteVec]]]] + ['makeByteWordVec2,maxElement,MKQ $byteVec]]]] --NOTE: this is new form: old form satisfies VECP CDDR form --------------------> NEW DEFINITION (see nrunopt.boot.pamphlet) @@ -120,7 +104,7 @@ replaceGoGetSlot env == slot --======================================================= --- Expand Signature from Encoded Slot Form +-- Expand Signature from Encoded Slot Form --======================================================= --------------------> NEW DEFINITION (see nrunfast.boot.pamphlet) newExpandGoGetTypeSlot(slot,dollar,domain) == @@ -136,22 +120,22 @@ newExpandTypeSlot(slot, dollar, domain) == newExpandLocalType(lazyt,dollar,domain) == VECP lazyt => lazyt.0 ATOM lazyt => lazyt - lazyt is [vec,.,:lazyForm] and VECP vec => --old style + lazyt is [vec,.,:lazyForm] and VECP vec => --old style newExpandLocalTypeForm(lazyForm,dollar,domain) - newExpandLocalTypeForm(lazyt,dollar,domain) --new style + newExpandLocalTypeForm(lazyt,dollar,domain) --new style --------------------> NEW DEFINITION (see nrunfast.boot.pamphlet) newExpandLocalTypeForm([functorName,:argl],dollar,domain) == MEMQ(functorName, '(Record Union)) and first argl is [":",:.] => [functorName,:[['_:,tag,newExpandLocalTypeArgs(dom,dollar,domain,true)] - for [.,tag,dom] in argl]] + for [.,tag,dom] in argl]] MEMQ(functorName, '(Union Mapping)) => - [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]] + [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]] functorName = 'QUOTE => [functorName,:argl] coSig := GETDATABASE(functorName,'COSIG) NULL coSig => error ["bad functorName", functorName] [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,flag) - for a in argl for flag in rest coSig]] + for a in argl for flag in rest coSig]] --------------------> NEW DEFINITION (see nrunfast.boot.pamphlet) newExpandLocalTypeArgs(u,dollar,domain,typeFlag) == @@ -162,7 +146,7 @@ newExpandLocalTypeArgs(u,dollar,domain,typeFlag) == u is ['NRTEVAL,y] => nrtEval(y,domain) u is ['QUOTE,y] => y u = "$$" => domain.0 - atom u => u --can be first, rest, etc. + atom u => u --can be first, rest, etc. newExpandLocalTypeForm(u,dollar,domain) --------------------> NEW DEFINITION (see nrunfast.boot.pamphlet) @@ -188,9 +172,9 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) == s = d.0 => true domainArg := ($isDefaultingPackage => domain.6.0; domain.0) KAR s = QCAR d.0 and - lazyMatchArgDollarCheck(replaceSharpCalls s,d.0,dollar.0,domainArg) - --VECP CAR d => lazyMatch(s,CDDR d,dollar,domain) --old style (erase) - lazyMatch(replaceSharpCalls s,d,dollar,domain) --new style + lazyMatchArgDollarCheck(replaceSharpCalls s,d.0,dollar.0,domainArg) + --VECP CAR d => lazyMatch(s,CDDR d,dollar,domain) --old style (erase) + lazyMatch(replaceSharpCalls s,d,dollar,domain) --new style a = '$ => s = devaluate dollar a = "$$" => s = devaluate domain STRINGP a => @@ -218,19 +202,19 @@ evalSlotDomain(u,dollar) == VECP (y := dollar.u) => y y is ['SETELT,:.] => eval y--lazy domains need to marked; this is dangerous? y is [v,:.] => - VECP v => lazyDomainSet(y,dollar,u) --old style has [$,code,:lazyt] + VECP v => lazyDomainSet(y,dollar,u) --old style has [$,code,:lazyt] constructor? v or MEMQ(v,'(Record Union Mapping)) => - lazyDomainSet(y,dollar,u) --new style has lazyt + lazyDomainSet(y,dollar,u) --new style has lazyt y y u is ['NRTEVAL,y] => eval y u is ['QUOTE,y] => y u is ['Record,:argl] => FUNCALL('Record0,[[tag,:evalSlotDomain(dom,dollar)] - for [.,tag,dom] in argl]) + for [.,tag,dom] in argl]) u is ['Union,:argl] and first argl is ['_:,.,.] => APPLY('Union,[['_:,tag,evalSlotDomain(dom,dollar)] - for [.,tag,dom] in argl]) + for [.,tag,dom] in argl]) u is [op,:argl] => APPLY(op,[evalSlotDomain(x,dollar) for x in argl]) systemErrorHere '"evalSlotDomain" @@ -242,8 +226,8 @@ lazyCompareSigEqual(s,tslot,dollar,domain) == tslot = '$ => s = tslot -- devaluate dollar --needed for browser INTEGERP tslot and PAIRP(lazyt:=domain.tslot) and PAIRP s => lazyt is [.,.,.,[.,item,.]] and - item is [.,[functorName,:.]] and functorName = CAR s => - compareSigEqual(s,(NRTevalDomain lazyt).0,dollar,domain) + item is [.,[functorName,:.]] and functorName = CAR s => + compareSigEqual(s,(NRTevalDomain lazyt).0,dollar,domain) nil compareSigEqual(s,NRTreplaceLocalTypes(tslot,domain),dollar,domain) @@ -251,7 +235,7 @@ lazyCompareSigEqual(s,tslot,dollar,domain) == --------------------> NEW DEFINITION (see i-funsel.boot.pamphlet) findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == - -- looks for a modemap for op with signature args1 -> tar + -- looks for a modemap for op with signature args1 -> tar -- in the domain of computation dc -- tar may be NIL (= unknown) null isLegitimateMode(tar, nil, nil) => nil @@ -261,16 +245,16 @@ findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == -- When domains no longer have to have Set, the hard coded 6 and 7 -- should go. op = '_= => - #args1 ^= 2 or args1.0 ^= dc or args1.1 ^= dc => NIL - tar and tar ^= '(Boolean) => NIL - [[[dc, '(Boolean), dc, dc], ['(Boolean),'$,'$], [NIL, NIL]]] + #args1 ^= 2 or args1.0 ^= dc or args1.1 ^= dc => NIL + tar and tar ^= '(Boolean) => NIL + [[[dc, '(Boolean), dc, dc], ['(Boolean),'$,'$], [NIL, NIL]]] op = 'coerce => - #args1 ^= 1 + #args1 ^= 1 dcName='Enumeration and (args1.0=$Symbol or tar=dc)=> [[[dc, dc, $Symbol], ['$,$Symbol], [NIL, NIL]]] args1.0 ^= dc => NIL - tar and tar ^= $Expression => NIL - [[[dc, $Expression, dc], [$Expression,'$], [NIL, NIL]]] + tar and tar ^= $Expression => NIL + [[[dc, $Expression, dc], [$Expression,'$], [NIL, NIL]]] member(dcName,'(Record Union)) => findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) NIL @@ -283,22 +267,22 @@ findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == q := NIL r := NIL for mm in CDR p repeat - -- CDAR of mm is the signature argument list - if isHomogeneousList CDAR mm then q := [mm,:q] - else r := [mm,:r] + -- CDAR of mm is the signature argument list + if isHomogeneousList CDAR mm then q := [mm,:q] + else r := [mm,:r] q := allOrMatchingMms(q,args1,tar,dc) for mm in q repeat - fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) + fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) r := reverse r else r := CDR p r := allOrMatchingMms(r,args1,tar,dc) if not fun then -- consider remaining modemaps for mm in r repeat - fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) + fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) if not fun and $reportBottomUpFlag then sayMSG concat ['" -> no appropriate",:bright op,'"found in", - :bright prefix2String dc] + :bright prefix2String dc] fun --------------------> NEW DEFINITION (see i-funsel.boot.pamphlet) @@ -321,9 +305,9 @@ findFunctionInDomain1(omm,op,tar,args1,args2,SL) == -- hmmmm: do Union check in following because (as in DP) -- Unions are subsumed by total modemaps which are in the -- mm list in findFunctionInDomain. - y := 'ELT -- if subsumed fails try it again + y := 'ELT -- if subsumed fails try it again not $SubDom and CAR sig isnt ['Union,:.] and slot is [tar,:args] and - (f := findFunctionInDomain(op,dc,tar,args,args,NIL,NIL)) => f + (f := findFunctionInDomain(op,dc,tar,args,args,NIL,NIL)) => f EQ(y,'ELT) => [[CONS(dc,sig),osig,nreverse $RTC]] EQ(y,'CONST) => [[CONS(dc,sig),osig,nreverse $RTC]] EQ(y,'ASCONST) => [[CONS(dc,sig),osig,nreverse $RTC]] @@ -333,7 +317,7 @@ findFunctionInDomain1(omm,op,tar,args1,args2,SL) == --------------------> NEW DEFINITION (see i-funsel.boot.pamphlet) findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == - -- looks for a modemap for op with signature args1 -> tar + -- looks for a modemap for op with signature args1 -> tar -- in the domain of computation dc -- tar may be NIL (= unknown) dcName:= CAR dc @@ -365,7 +349,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == if not fun and $reportBottomUpFlag then sayMSG concat ['" -> no appropriate",:bright op,'"found in", - :bright prefix2String dc] + :bright prefix2String dc] fun ------- from i-eval.boot ----------- @@ -379,45 +363,45 @@ evalForm(op,opName,argl,mmS) == #argl ^= #CDDR sig => 'skip ---> RDJ 6/95 form:= $genValue or null cond => - [getArgValue2(x,t,sideEffectedArg?(t,sig,opName),opName) or return NIL - for x in argl for t in CDDR sig] + [getArgValue2(x,t,sideEffectedArg?(t,sig,opName),opName) or return NIL + for x in argl for t in CDDR sig] [getArgValueComp2(x,t,c,sideEffectedArg?(t,sig,opName),opName) or return NIL - for x in argl for t in CDDR sig for c in cond] + for x in argl for t in CDDR sig for c in cond] form or null argl => dc:= CAR sig form := - dc='local => --[fun,:form] - atom fun => - fun in $localVars => ['SPADCALL,:form,fun] - [fun,:form,NIL] - ['SPADCALL,:form,fun] - dc is ["__FreeFunction__",:freeFun] => - ['SPADCALL,:form,freeFun] - fun is ['XLAM,xargs,:xbody] => - rec := first form - xbody is [['RECORDELT,.,ind,len]] => - optRECORDELT([CAAR xbody,rec,ind,len]) - xbody is [['SETRECORDELT,.,ind,len,.]] => - optSETRECORDELT([CAAR xbody,rec,ind,len,CADDR form]) - xbody is [['RECORDCOPY,.,len]] => - optRECORDCOPY([CAAR xbody,rec,len]) - ['FUNCALL,['function , ['LAMBDA,xargs,:xbody]],:TAKE(#xargs, form)] - dcVector := evalDomain dc - fun0 := - newType? CAAR mm => - mm' := first ncSigTransform mm - ncGetFunction(opName, first mm', rest mm') - NRTcompileEvalForm(opName,fun,dcVector) - null fun0 => throwKeyedMsg("S2IE0008",[opName]) - [bpi,:domain] := fun0 - EQ(bpi,function Undef) => - sayKeyedMsg("S2IE0009",[opName,formatSignature CDR sig,CAR sig]) - NIL - if $NRTmonitorIfTrue = true then - sayBrightlyNT ['"Applying ",first fun0,'" to:"] - pp [devaluateDeeply x for x in form] - _$:fluid := domain - ['SPADCALL, :form, fun0] + dc='local => --[fun,:form] + atom fun => + fun in $localVars => ['SPADCALL,:form,fun] + [fun,:form,NIL] + ['SPADCALL,:form,fun] + dc is ["__FreeFunction__",:freeFun] => + ['SPADCALL,:form,freeFun] + fun is ['XLAM,xargs,:xbody] => + rec := first form + xbody is [['RECORDELT,.,ind,len]] => + optRECORDELT([CAAR xbody,rec,ind,len]) + xbody is [['SETRECORDELT,.,ind,len,.]] => + optSETRECORDELT([CAAR xbody,rec,ind,len,CADDR form]) + xbody is [['RECORDCOPY,.,len]] => + optRECORDCOPY([CAAR xbody,rec,len]) + ['FUNCALL,['function , ['LAMBDA,xargs,:xbody]],:TAKE(#xargs, form)] + dcVector := evalDomain dc + fun0 := + newType? CAAR mm => + mm' := first ncSigTransform mm + ncGetFunction(opName, first mm', rest mm') + NRTcompileEvalForm(opName,fun,dcVector) + null fun0 => throwKeyedMsg("S2IE0008",[opName]) + [bpi,:domain] := fun0 + EQ(bpi,function Undef) => + sayKeyedMsg("S2IE0009",[opName,formatSignature CDR sig,CAR sig]) + NIL + if $NRTmonitorIfTrue = true then + sayBrightlyNT ['"Applying ",first fun0,'" to:"] + pp [devaluateDeeply x for x in form] + _$:fluid := domain + ['SPADCALL, :form, fun0] not form => nil -- not form => throwKeyedMsg("S2IE0008",[opName]) form='interpOnly => rewriteMap(op,opName,argl) @@ -452,7 +436,7 @@ coerceByFunction(T,m2) == dcVector := evalDomain ud fun := isWrapped x => - NRTcompiledLookup("=", [$Boolean, '$, '$], dcVector) + NRTcompiledLookup("=", [$Boolean, '$, '$], dcVector) NRTcompileEvalForm("=", [$Boolean, '$, '$], dcVector) [fn,:d]:= fun isWrapped x => @@ -470,7 +454,7 @@ coerceByFunction(T,m2) == fun:= --+ isWrapped x => - NRTcompiledLookup(funName,slot,dcVector) + NRTcompiledLookup(funName,slot,dcVector) NRTcompileEvalForm(funName,slot,dcVector) [fn,:d]:= fun fn = function Undef => NIL @@ -510,9 +494,3 @@ algEqual(object1, object2, domain) == -- eqfunc := getFunctionFromDomain("=",domain,[domain,domain]) eqfunc := compiledLookupCheck("=",[$Boolean,'$,'$],evalDomain domain) SPADCALL(object1,object2, eqfunc) -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/xruncomp.boot.pamphlet b/src/interp/xruncomp.boot index 3d8c2c55..4b558a3e 100644 --- a/src/interp/xruncomp.boot.pamphlet +++ b/src/interp/xruncomp.boot @@ -1,20 +1,3 @@ -\documentclass{article} -\usepackage{axiom} - -\title{\File{src/interp/xruncomp.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,8 @@ -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -@ -<<*>>= -<<license>> + +)package "BOOT" ------- from info.boot ----------- @@ -161,7 +143,7 @@ actOnInfo(u,$e) == -- SAY("augmenting ",name,": ",cat) -- put(name, "value", (vval, cat, venv), $e) member(cat,first ocatvec.4) or - ASSOC(cat,CADR ocatvec.4) is [.,'T,.] => $e + ASSOC(cat,CADR ocatvec.4) is [.,"T",.] => $e --SAY("Category extension error: --cat shouldn't be a join --what was being asserted is an ancestor of what was known @@ -204,18 +186,18 @@ genDeltaEntry opMmPair == -- sig := substitute('$,dc,sig) -- cform := substitute('$,dc,cform) opModemapPair := - [op,[dc,:[genDeltaSig x for x in nsig]],['T,cform]] -- force pred to T + [op,[dc,:[genDeltaSig x for x in nsig]],["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:= compOrCroak(odc,$EmptyMode,$e).expr + compEntry:= (compOrCroak(odc,$EmptyMode,$e)).expr -- dc RPLACA(saveNRTdeltaListComp,compEntry) u := - [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index == + [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index() == (n:= POSN1(opModemapPair,$NRTdeltaList)) => n + 1 --n + 1 since $NRTdeltaLength is 1 too large $NRTdeltaList:= [opModemapPair,:$NRTdeltaList] @@ -239,7 +221,7 @@ NRTencode(x,y) == encode(x,y,true) where encode(x,compForm,firstTime) == ['NRTEVAL,NRTreplaceAllLocalReferences COPY_-TREE lispize compForm] MEMQ(x,$formalArgList) => v := $FormalMapVariableList.(POSN1(x,$formalArgList)) - firstTime => ['local,v] + firstTime => ["local",v] v x = '$ => x x = "$$" => x @@ -277,7 +259,7 @@ NRTassignCapsuleFunctionSlot(op,sig) == if $insideCategoryPackageIfTrue then sig := substitute('$,CADR($functorForm),sig) sig := [genDeltaSig x for x in sig] - opModemapPair := [op,['_$,:sig],['T,implementation]] + opModemapPair := [op,['_$,:sig],["T",implementation]] POSN1(opModemapPair,$NRTdeltaList) => nil --already there $NRTdeltaList:= [opModemapPair,:$NRTdeltaList] $NRTdeltaListComp := [nil,:$NRTdeltaListComp] @@ -310,7 +292,7 @@ changeDirectoryInSlot1() == --called by NRTbuildFunctor $lastPred := pred newfnsel := fnsel is ['Subsumed,op1,sig1] => - ['Subsumed,op1,genSlotSig(sig1,'T,$newEnv)] + ['Subsumed,op1,genSlotSig(sig1,"T",$newEnv)] fnsel [[op, genSlotSig(sig,pred,$newEnv)] ,pred,newfnsel] @@ -346,9 +328,3 @@ LookUpSigSlots(sig,siglist) == REMDUP [implem for u in siglist | SigSlotsMatch(sig,first u,implem:=CADDR u) and KADDR implem] -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} |