aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/interp/ChangeLog22
-rw-r--r--src/interp/Makefile.in23
-rw-r--r--src/interp/Makefile.pamphlet121
-rw-r--r--src/interp/interop.boot.pamphlet2
-rw-r--r--src/interp/mark.boot.pamphlet6
-rw-r--r--src/interp/parse.boot.pamphlet2
-rw-r--r--src/interp/postpar.boot.pamphlet2
-rw-r--r--src/interp/showimp.boot.pamphlet6
-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.boot240
-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.pamphlet2
-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}