diff --git a/changelog b/changelog index 5c4e354..804db21 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,8 @@ +20110803 tpd src/axiom-website/patches.html 20110803.02.tpd.patch +20110803 tpd src/interp/Makefile removed ax.lisp +20110803 tpd src/interp/util.lisp removed aldor compiler hooks +20110803 tpd src/interp/ax.boot removed aldor compiler hooks +20110803 tpd src/interp/ax.lisp removed aldor compiler hooks 20110803 tpd src/axiom-website/patches.html 20110803.01.tpd.patch 20110803 tpd books/bookvol5 remove as.lisp 20110803 tpd src/interp/Makefile remove as.lisp diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index f3d07e0..63bbddf 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3574,5 +3574,7 @@ books/bookvol9 treeshake compiler
src/interp/database.lisp removed
20110803.01.tpd.patch src/interp/as.lisp removed
+20110803.02.tpd.patch +src/interp/ax.lisp removed aldor compiler hooks diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index fa7e5aa..4155aa3 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -252,12 +252,6 @@ The {\bf ASCOMP} list contains files used by the {\bf Aldor} ASCOMP= ${OUT}/hashcode.${O} ${OUT}/foam_l.${O} @ -The {\bf ASAUTO} list contains files used by the {\bf Aldor} -\cite{5} compiler. These files are autoloaded as needed. -<>= -ASAUTO= ${AUTO}/ax.${O} - -@ Axiom versions are given as a string of the form: "Sunday September 21, 2003 at 20:38:05 " @@ -647,7 +641,7 @@ compiler::*suppress-compiler-notes* to true in order to reduce the noise. ${SAVESYS}: ${DEPSYS} ${OBJS} ${OUT}/bookvol5.${O} ${OUT}/util.${O} \ ${OUT}/nocompil.${LISP} ${OUT}/sys-pkg.${LISP} \ ${OUTINTERP} ${BROBJS} \ - ${OUT}/database.date ${INOBJS} ${ASCOMP} ${ASAUTO} \ + ${OUT}/database.date ${INOBJS} ${ASCOMP} \ ${NAGBROBJS} \ ${LOADSYS} \ ${SRC}/doc/msgs/s2-us.msgs \ @@ -683,7 +677,7 @@ ${SAVESYS}: ${DEPSYS} ${OBJS} ${OUT}/bookvol5.${O} ${OUT}/util.${O} \ '(quote ($(patsubst %, "%", ${BROBJS})))' \ nil \ '(quote ($(patsubst %, "%", ${NAGBROBJS})))' \ - '(quote ($(patsubst %, "%", ${ASAUTO})))' \ + nil \ '"${SPAD}" "${LSP}" "${SRC}" "${INT}"' \ '"${OBJ}" "${MNT}" "${SYS}")' >> ${OUT}/makeint.lisp @ echo '(in-package "SCRATCHPAD-COMPILER")' >> ${OUT}/makeint.lisp @@ -2940,36 +2934,6 @@ ${MID}/htcheck.lisp: ${IN}/htcheck.lisp.pamphlet @ -\subsection{ax.lisp} -<>= -${AUTO}/ax.${O}: ${OUT}/ax.${O} - @ echo 465 making ${AUTO}/ax.${O} from ${OUT}/ax.${O} - @ cp ${OUT}/ax.${O} ${AUTO} - -@ -<>= -${OUT}/ax.${O}: ${MID}/ax.lisp - @ echo 136 making ${OUT}/ax.${O} from ${MID}/ax.lisp - @ ( cd ${MID} ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/ax.lisp"' \ - ':output-file "${OUT}/ax.${O}") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (compile-file "${MID}/ax.lisp"' \ - ':output-file "${OUT}/ax.${O}") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ) - -@ -<>= -${MID}/ax.lisp: ${IN}/ax.lisp.pamphlet - @ echo 137 making ${MID}/ax.lisp from ${IN}/ax.lisp.pamphlet - @ (cd ${MID} ; \ - echo '(tangle "${IN}/ax.lisp.pamphlet" "*" "ax.lisp")' \ - | ${OBJ}/${SYS}/bin/lisp ) - -@ - \subsection{br-con.lisp} <>= ${AUTO}/br-con.${O}: ${OUT}/br-con.${O} @@ -3250,10 +3214,6 @@ clean: <> <> -<> -<> -<> - <> <> <> diff --git a/src/interp/ax.boot.pamphlet b/src/interp/ax.boot.pamphlet deleted file mode 100644 index bfbb7a3..0000000 --- a/src/interp/ax.boot.pamphlet +++ /dev/null @@ -1,862 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\newcommand{\file}[1]{\texttt{#1}} -\begin{document} -\title{\$SPAD/src/interp ax.boot} -\author{Ralf Hemmecke} -\maketitle -\begin{abstract} -We give an overview of what \file{ax.boot} does and in particular -describe the function \verb'makeAxExportForm'. -\end{abstract} -\eject -\tableofcontents -\eject -\section{New Aldor compiler changes} -This was changed so the open source version of axiom can work with the new -aldor compiler. -This used to read: -\begin{verbatim} - axForm := ['Sequence, ['Import, [], 'AxiomLib], :axForms] -\end{verbatim} -but was changed to read: -\begin{chunk}{aldor mod 1} - axForm := ['Sequence, _ - ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms] -\end{chunk} -\section{Overview} -\subsection{makeAxExportForm} -The most important function in \file{ax.boot} is the function -\verb'makeAxExportForm'. - -The function takes as input a filename and a list of constructors. -Via LISP it would be called like -\begin{verbatim} -(|makeAxExportForm| filename constructors) -\end{verbatim} -where \verb'filename' is actually unused and could be removed and -\verb'constructors' should be a list of constructor names, i.e., names -of categories, domains, and packages in their unabbreviated form. - -It returns a list that represents the \texttt{.ap} (parsed source) -(see \verb'aldor -hall') form of the constructors. However, since the -output is only needed for a construction of an Aldor-Axiom -interaction, \verb'makeAxExportForm' will only construct the category -part of the constructor. - -The function is actually used in \file{src/aldor/genax.lsp} and is an -auxiliary part in the construction of the interface for the -interaction of the Aldor compiler with Axiom. -\begin{chunk}{makeAxExportForm} -makeAxExportForm(filename, constructors) == - $defaultFlag : local := false - $literals := [] - axForms := - [modemapToAx(modemap) for cname in constructors | - (modemap:=GETDATABASE(cname,'CONSTRUCTORMODEMAP)) and - (not cname in '(Tuple Exit Type)) and - not isDefaultPackageName cname] - if $baseForms then - axForms := [:$baseForms, :axForms] - if $defaultFlag then - axForms := - [['Foreign, ['Declare, 'dummyDefault, 'Exit], 'Lisp], :axForms] - axForms := APPEND(axDoLiterals(), axForms) - axForm := ['Sequence, _ - ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms] - axForm - -\end{chunk} -The basic translation is easily demonstrated with a few examples. For -better readability, we look at the corresponding SPAD form of the -constructor (instead of its internal LISP representation). - -Let us first state what different situations we identified. -\begin{enumerate} -\item Ordinary domains. See Section~\ref{sec:Domain}. -\item Ordinary categories. See Section~\ref{sec:Category}. -\item Ordinary categories with default packages. See - Section~\ref{sec:Category+Default}. -\item Initial domains, i.e., domains that will be extended in the - course of building \file{libaxiom.al}. These domains are listed in - the variable \verb'$extendedDomains'. %$ - - See Sections~\ref{sec:InitDomain} and - \ref{sec:ParametrizedInitDomain}. There is a subdivision for these - domains. - \begin{enumerate} - \item For domains that take no arguments, see - Section~\ref{sec:InitDomain}. - \item For domains that take arguments, see - Section~\ref{sec:ParametrizedInitDomain}. - \end{enumerate} -\end{enumerate} -\section{Ordinary Domains}\label{sec:Domain} -The domain \verb'Stack'. -\begin{verbatim} -Stack(S:SetCategory): StackAggregate S with - stack: List S -> % - == add - Rep := Reference List S - ... -\end{verbatim} -It is translated into \ldots -\begin{verbatim} -(|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Export| - (|Declare| |Stack| - (|Apply| -> (|Declare| |#1| |SetCategory|) - (|With| NIL - (|Sequence| - (|Apply| |StackAggregate| |#1|) - (|Declare| |stack| - (|Apply| -> - (|Comma| (|Apply| |List| |#1|)) - %)))))) - NIL NIL)) -\end{verbatim} -That is the parsed source of the Aldor code \ldots -\begin{verbatim} -import from AxiomLib; -import from Boolean; -export Stack: (T: SetCategory) -> with { - StackAggregate T; - stack: List T -> %; - } -\end{verbatim} -Note that nothing appears before the \verb'with'. No problem because -that is equivalent to a \verb'Join' in Aldor. -\section{Ordinary Categories}\label{sec:Category} -The category \verb'SquareFreeNormalizedTriangularSetCategory' without -a default package. -\begin{verbatim} -SquareFreeNormalizedTriangularSetCategory(_ - R: GcdDomain,_ - E: OrderedAbelianMonoidSup,_ - V: OrderedSet,_ - P:RecursivePolynomialCategory(R, E, V)): Category == - Join(_ - SquareFreeRegularTriangularSetCategory(R,E,V,P),_ - NormalizedTriangularSetCategory(R,E,V,P)) -\end{verbatim} -It is translated into \ldots -\begin{verbatim} -(|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Define| - (|Declare| |SquareFreeNormalizedTriangularSetCategory| - (|Apply| -> - (|Comma| (|Declare| |#1| |GcdDomain|) - (|Declare| |#2| - |OrderedAbelianMonoidSup|) - (|Declare| |#3| |OrderedSet|) - (|Declare| |#4| - (|Apply| |RecursivePolynomialCategory| - |#1| |#2| |#3|))) - |Category|)) - (|Lambda| - (|Comma| (|Declare| |#1| |GcdDomain|) - (|Declare| |#2| |OrderedAbelianMonoidSup|) - (|Declare| |#3| |OrderedSet|) - (|Declare| |#4| - (|Apply| |RecursivePolynomialCategory| |#1| - |#2| |#3|))) - |Category| - (|Label| |SquareFreeNormalizedTriangularSetCategory| - (|With| NIL - (|Sequence| - (|Apply| |SquareFreeRegularTriangularSetCategory| - |#1| |#2| |#3| |#4|) - (|Apply| |NormalizedTriangularSetCategory| - |#1| |#2| |#3| |#4|))))))) -\end{verbatim} -That is the parsed source of the Aldor code \ldots -\begin{verbatim} -import from AxiomLib; -import from Boolean; -SquareFreeNormalizedTriangularSetCategory: ( - R: GcdDomain, - E: OrderedAbelianMonoidSup, - V: OrderedSet, - P: RecursivePolynomialCategory(R, E, V) -) -> Category == ( - R: GcdDomain, - E: OrderedAbelianMonoidSup, - V: OrderedSet, - P: RecursivePolynomialCategory(R, E, V) -): Category +-> with { - SquareFreeRegularTriangularSetCategory(R, E, V, P), - NormalizedTriangularSetCategory(R, E, V, P) -} -\end{verbatim} - Again, nothing appears in front of the \verb'with'. No problem - because that is equivalent to a \verb'Join' in Aldor. -\section{Ordinary Categories with Default Packages} -\label{sec:Category+Default} -The category \verb'StringAggregate' with default package. -\begin{verbatim} -StringAggregate: Category == OneDimensionalArrayAggregate Character with - lowerCase : % -> % - lowerCase_!: % -> % - upperCase : % -> % - ... - rightTrim: (%, CharacterClass) -> % - elt: (%, %) -> % - add - trim(s: %, c: Character) == leftTrim(rightTrim(s, c), c) - trim(s: %, cc: CharacterClass) == leftTrim(rightTrim(s, cc), cc) - lowerCase s == lowerCase_! copy s - upperCase s == upperCase_! copy s - prefix?(s, t) == substring?(s, t, minIndex t) - coerce(c:Character):% == new(1, c) - elt(s:%, t:%): % == concat(s,t)$% -\end{verbatim} -It is translated into \ldots -\begin{verbatim} -(|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) - (|Define| (|Declare| |StringAggregate| |Category|) - (|With| NIL - (|Sequence| - (|Apply| |OneDimensionalArrayAggregate| - |Character|) - (|Declare| |lowerCase| (|Apply| -> (|Comma| %) %)) - (|Declare| |lowerCase!| (|Apply| -> (|Comma| %) %)) - (|Declare| |upperCase| (|Apply| -> (|Comma| %) %)) - ... - (|Declare| |rightTrim| - (|Apply| -> (|Comma| % |CharacterClass|) %)) - (|Declare| |apply| (|Apply| -> (|Comma| % %) %)) - (|Default| - (|Sequence| - (|Define| - (|Declare| |coerce| - (|Apply| -> (|Comma| |Character|) - %)) - (|Lambda| - (|Comma| - (|Declare| |t#1| |Character|)) - % - (|Label| |coerce| |dummyDefault|))) - (|Define| - (|Declare| |apply| - (|Apply| -> (|Comma| % %) %)) - (|Lambda| - (|Comma| (|Declare| |t#1| %) - (|Declare| |t#2| %)) - % (|Label| |apply| |dummyDefault|))) - (|Define| - (|Declare| |lowerCase| - (|Apply| -> (|Comma| %) %)) - (|Lambda| (|Comma| (|Declare| |t#1| %)) - % - (|Label| |lowerCase| - |dummyDefault|))) - ... - )))))) -\end{verbatim} -That is the parsed source of the Aldor code \ldots -\begin{verbatim} -import from AxiomLib; -import from Boolean; -import dummyDefault: Exit from Foreign Lisp; -StringAggregate: Category == with { - OneDimensionalArrayAggregate Character; - lowerCase: % -> %; - lowerCase!: % -> %; - upperCase: % -> %; - ... - rightTrim: (%, CharacterClass) -> %; - apply: (%, %) -> % - default { - coerce: Character -> % == (t: Character): % +-> dummyDefault; - apply: (%, %) -> % == (t1: %, t2: %): % +-> dummyDefault; - lowerCase: % -> % == (t: %): % +-> dummyDefault; - ... -} -\end{verbatim} -It is important to note that the actual default functions are given by -a dummy implementation that is imported from LISP. - -And again, nothing appears in front of the \verb'with'. No problem -because that is equivalent to a \verb'Join' in Aldor. - -Note that the \verb'elt' function is translated into \verb'apply'. -\section{Initial Domains without Arguments} -\label{sec:InitDomain} -\begin{verbatim} -SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with - canonical - canonicalsClosed - noetherian - max : () -> % - min : () -> % - "not": % -> % - "~" : % -> % - "/\": (%, %) -> % - "\/" : (%, %) -> % - "xor": (%, %) -> % - Not : % -> % - And : (%,%) -> % - Or : (%,%) -> % - == add - ... -\end{verbatim} -It is translated into \ldots -\begin{verbatim} -(|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Extend| - (|Define| - (|Declare| |SingleInteger| - (|With| NIL - (|Sequence| |IntegerNumberSystem| |Logic| - |OpenMath| - (|RestrictTo| |canonical| |Category|) - (|RestrictTo| |canonicalsClosed| - |Category|) - (|RestrictTo| |noetherian| |Category|) - (|Declare| |max| (|Apply| -> (|Comma|) %)) - (|Declare| |min| (|Apply| -> (|Comma|) %)) - (|Declare| |not| - (|Apply| -> (|Comma| %) %)) - (|Declare| ~ (|Apply| -> (|Comma| %) %)) - (|Declare| |/\\| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |\\/| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |xor| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |Not| - (|Apply| -> (|Comma| %) %)) - (|Declare| |And| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |Or| - (|Apply| -> (|Comma| % %) %))))) - (|Add| (|PretendTo| (|Add| NIL NIL) - (|With| NIL - (|Sequence| |IntegerNumberSystem| - |Logic| |OpenMath| - (|RestrictTo| |canonical| - |Category|) - (|RestrictTo| |canonicalsClosed| - |Category|) - (|RestrictTo| |noetherian| - |Category|) - (|Declare| |max| - (|Apply| -> (|Comma|) %)) - (|Declare| |min| - (|Apply| -> (|Comma|) %)) - (|Declare| |not| - (|Apply| -> (|Comma| %) %)) - (|Declare| ~ - (|Apply| -> (|Comma| %) %)) - (|Declare| |/\\| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |\\/| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |xor| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |Not| - (|Apply| -> (|Comma| %) %)) - (|Declare| |And| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |Or| - (|Apply| -> (|Comma| % %) %))))) - NIL)))) -\end{verbatim} -That is the parsed source of the Aldor code \ldots -\begin{verbatim} -import from AxiomLib; -import from Boolean; -extend SingleInteger: with { - IntegerNumberSystem; - Logic; - OpenMath; - canonical @ Category; - canonicalsClosed @ Category; - noetherian @ Category; - max: () -> %; - min: () -> %; - _not: % -> %; - ~: % -> %; - /\: (%, %) -> %; - \/: (%, %) -> %; - xor: (%, %) -> %; - Not: % -> %; - And: (%,%) -> %; - Or : (%,%) -> %; -} - == (add pretend with { - IntegerNumberSystem; - Logic; - OpenMath; - canonical @ Category; - canonicalsClosed @ Category; - noetherian @ Category; - max: () -> %; - min: () -> %; - _not: % -> %; - ~: % -> %; - /\: (%, %) -> %; - \/: (%, %) -> %; - xor: (%, %) -> %; - Not: % -> %; - And: (%,%) -> %; - Or : (%,%) -> %; -}) add; -\end{verbatim} -\section{Initial Domains with Arguments} -\label{sec:ParametrizedInitDomain} -\begin{verbatim} -SegmentBinding(S:Type): Type with - equation: (Symbol, Segment S) -> % - variable: % -> Symbol - segment : % -> Segment S - if S has SetCategory then SetCategory - == add - Rep := Record(var:Symbol, seg:Segment S) - ... -\end{verbatim} -It is translated into \ldots -\begin{verbatim} -(|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Sequence| - (|Define| - (|Declare| |SegmentBindingExtendCategory| - (|Apply| -> (|Declare| |#1| |Type|) |Category|)) - (|Lambda| (|Comma| (|Declare| |#1| |Type|)) |Category| - (|Label| |SegmentBindingExtendCategory| - (|With| NIL - (|Sequence| - (|Declare| |equation| - (|Apply| -> - (|Comma| |Symbol| - (|Apply| |Segment| |#1|)) - %)) - (|Declare| |variable| - (|Apply| -> (|Comma| %) |Symbol|)) - (|Declare| |segment| - (|Apply| -> (|Comma| %) - (|Apply| |Segment| |#1|))) - (|If| - (|Test| - (|Has| |#1| |SetCategory|)) - |SetCategory| NIL)))))) - (|Extend| - (|Define| - (|Declare| |SegmentBinding| - (|Apply| -> (|Declare| |#1| |Type|) - (|Apply| |SegmentBindingExtendCategory| - |#1|))) - (|Lambda| (|Comma| (|Declare| |#1| |Type|)) - (|Apply| |SegmentBindingExtendCategory| |#1|) - (|Label| |SegmentBinding| - (|Add| (|PretendTo| (|Add| NIL NIL) - (|Apply| - |SegmentBindingExtendCategory| - |#1|)) - NIL))))))) -\end{verbatim} -That is the parsed source of the Aldor code \ldots -\begin{verbatim} -import from AxiomLib; -import from Boolean; -SegmentBindingExtendCategory: (S: Type) -> Category == - (T: Type): Category +-> with { - equation: (Symbol, Segment S) -> %; - variable: % -> Symbol; - segment : % -> Segment S; - if S has SetCategory then SetCategory; -} -extend SegmentBinding: (S: Type) -> SegmentBindingExtendCategory S == - (S: Type): SegmentBindingExtendCategory S +-> - (add pretend SegmentBindingExtendCategory S) add; -\end{verbatim} -The last lines are actually equivalent to -\begin{verbatim} -extend SegmentBinding(S: Type): SegmentBindingExtendCategory S == - (add pretend SegmentBindingExtendCategory S) add; -\end{verbatim} - -\section{axFormatPref} -Here we add an else clause. The original code read: -\begin{verbatim} - if name = '$ then name := '% -\end{verbatim} -It appears that Aldor allows a richer syntax for [[has]] -conditions since the call to [[axFormatOp]] appears to allow -nested IF conditions.OQ -\begin{chunk}{axFormatPred aldor change} -axFormatPred pred == - atom pred => pred - [op,:args] := pred - op = 'IF => axFormatOp pred - op = 'has => - [name,type] := args - if name = '$ then name := '% - else name := axFormatOp name - ftype := axFormatOp type - if ftype is ['Declare,:.] then - ftype := ['With, [], ftype] - ['Test,['Has,name, ftype]] - axArglist := [axFormatPred arg for arg in args] - op = 'AND => ['And,:axArglist] - op = 'OR => ['Or,:axArglist] - op = 'NOT => ['Not,:axArglist] - error "unknown predicate" - -\end{chunk} -\section{License} -\begin{verbatim} --- 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. - -\end{verbatim} -\begin{chunk}{*} - -$stripTypes := false -$pretendFlag := false -$defaultFlag := false -$baseForms := nil -$literals := nil - -spad2AxTranslatorAutoloadOnceTrigger any == true - -sourceFilesToAxFile(filename, sourceFiles) == - makeAxFile(filename, MAPCAN('fileConstructors, sourceFiles)) - - -$extendedDomains := nil - -setExtendedDomains(l) == - $extendedDomains := l - -fileConstructors name == - [INTERN(con,"BOOT") for con in SRCABBREVS SOURCEPATH STRING name] - -makeAxFile(filename, constructors) == - $defaultFlag : local := false - $literals := [] - axForms := - [modemapToAx(modemap) for cname in constructors | - (modemap:=GETDATABASE(cname,'CONSTRUCTORMODEMAP)) and - (not cname in '(Tuple Exit Type)) and - not isDefaultPackageName cname] - if $baseForms then - axForms := [:$baseForms, :axForms] - if $defaultFlag then - axForms := - [['Foreign, ['Declare, 'dummyDefault, 'Exit], 'Lisp], :axForms] - axForms := APPEND(axDoLiterals(), axForms) -\getchunk{aldor mod 1} - st := MAKE_-OUTSTREAM(filename) - PPRINT(axForm,st) - CLOSE st - -\getchunk{makeAxExportForm} - -stripType type == - $stripTypes => - categoryForm? type => 'Type - type - type - -modemapToAx(modemap) == - modemap is [[consform, target,:argtypes],.] - consform is [constructor,:args] - argdecls:=['Comma, : [axFormatDecl(a,stripType t) for a in args for t in argtypes]] - resultType := axFormatType stripType target - categoryForm? constructor => - categoryInfo := GETDATABASE(constructor,'CONSTRUCTORCATEGORY) - categoryInfo := SUBLISLIS($FormalMapVariableList, $TriangleVariableList, - categoryInfo) - NULL args => - ['Define,['Declare, constructor,'Category], - addDefaults(constructor, axFormatType categoryInfo)] - ['Define, - ['Declare, constructor, ['Apply, "->", optcomma argdecls, 'Category]], - ['Lambda, argdecls, 'Category, - ['Label, constructor, - addDefaults(constructor, axFormatType categoryInfo)]]] - constructor in $extendedDomains => - NULL args => - ['Extend, ['Define, ['Declare, constructor, resultType], - ['Add, ['PretendTo, ['Add, [], []], resultType], []]]] - conscat := INTERN(STRCONC(SYMBOL_-NAME(constructor), "ExtendCategory"),"BOOT") - rtype := ['Apply, conscat, :args] --- if resultType is ['With,a,b] then --- if not(b is ['Sequence,:withseq]) then withseq := [b] --- cosigs := rest GETDATABASE(constructor, 'COSIG) --- exportargs := [['Export, [], arg, []] for arg in args for p in cosigs | p] --- resultType := ['With,a,['Sequence,:APPEND(exportargs, withseq)]] - consdef := ['Define, - ['Declare, conscat, ['Apply, "->", optcomma argdecls, 'Category]], - ['Lambda, argdecls, 'Category, ['Label, conscat, resultType]]] - ['Sequence, consdef, - ['Extend, ['Define, - ['Declare, constructor, ['Apply, "->", optcomma argdecls, rtype]], - ['Lambda, argdecls, rtype, - ['Label, constructor, - ['Add, ['PretendTo, ['Add, [], []], rtype], []]]]]]] - NULL args => - ['Export, ['Declare, constructor, resultType],[],[]] --- if resultType is ['With,a,b] then --- if not(b is ['Sequence,:withseq]) then withseq := [b] --- cosigs := rest GETDATABASE(constructor, 'COSIG) --- exportargs := [['Export, [], arg, []] for arg in args for p in cosigs | p] --- resultType := ['With,a,['Sequence,:APPEND(exportargs, withseq)]] - ['Export, ['Declare, constructor, ['Apply, "->", optcomma argdecls, resultType]],[],[]] - -optcomma [op,:args] == - # args = 1 => first args - [op,:args] - -axFormatDecl(sym, type) == - if sym = '$ then sym := '% - opOf type in '(StreamAggregate FiniteLinearAggregate) => - ['Declare, sym, 'Type] - ['Declare, sym, axFormatType type] - -makeTypeSequence l == - ['Sequence,: delete('Type, l)] - -axFormatAttrib(typeform) == - atom typeform => typeform - axFormatType typeform - -axFormatType(typeform) == - atom typeform => - typeform = '$ => '% - STRINGP typeform => - ['Apply,'Enumeration, INTERN typeform] - INTEGERP typeform => - -- need to test for PositiveInteger vs Integer - axAddLiteral('integer, 'PositiveInteger, 'Literal) - ['RestrictTo, ['LitInteger, STRINGIMAGE typeform ], 'PositiveInteger] - FLOATP typeform => ['LitFloat, STRINGIMAGE typeform] - MEMQ(typeform,$TriangleVariableList) => - SUBLISLIS($FormalMapVariableList, $TriangleVariableList, typeform) - MEMQ(typeform, $FormalMapVariableList) => typeform - axAddLiteral('string, 'Symbol, 'Literal) - ['RestrictTo, ['LitString, PNAME typeform], 'Symbol] - typeform is ['construct,: args] => - axAddLiteral('bracket, ['Apply, 'List, 'Symbol], [ 'Apply, 'Tuple, 'Symbol]) - axAddLiteral('string, 'Symbol, 'Literal) - ['RestrictTo, ['Apply, 'bracket, - :[axFormatType a for a in args]], - ['Apply, 'List, 'Symbol] ] - typeform is [op] => - op = '$ => '% - op = 'Void => ['Comma] - op - typeform is ['local, val] => axFormatType val - typeform is ['QUOTE, val] => axFormatType val - typeform is ['Join,:cats,lastcat] => - lastcat is ['CATEGORY,type,:ops] => - ['With, [], - makeTypeSequence( - APPEND([axFormatType c for c in cats], - [axFormatOp op for op in ops]))] - ['With, [], makeTypeSequence([axFormatType c for c in rest typeform])] - typeform is ['CATEGORY, type, :ops] => - ['With, [], axFormatOpList ops] - typeform is ['Mapping, target, :argtypes] => - ['Apply, "->", - ['Comma, :[axFormatType t for t in argtypes]], - axFormatType target] - typeform is ['_:, name, type] => axFormatDecl(name,type) - typeform is ['Union, :args] => - first args is ['_:,.,.] => - ['Apply, 'Union, :[axFormatType a for a in args]] - taglist := [] - valueCount := 0 - for x in args repeat - tag := - STRINGP x => INTERN x - x is ['QUOTE,val] and STRINGP val => INTERN val - valueCount := valueCount + 1 - INTERNL("value", STRINGIMAGE valueCount) - taglist := [tag ,: taglist] - ['Apply, 'Union, :[axFormatDecl(name,type) for name in reverse taglist - for type in args]] - typeform is ['Dictionary,['Record,:args]] => - ['Apply, 'Dictionary, - ['PretendTo, axFormatType CADR typeform, 'SetCategory]] - typeform is ['FileCategory,xx,['Record,:args]] => - ['Apply, 'FileCategory, axFormatType xx, - ['PretendTo, axFormatType CADDR typeform, 'SetCategory]] - typeform is [op,:args] => - $pretendFlag and constructor? op and - GETDATABASE(op,'CONSTRUCTORMODEMAP) is [[.,target,:argtypes],.] => - ['Apply, op, - :[['PretendTo, axFormatType a, axFormatType t] - for a in args for t in argtypes]] - MEMQ(op, '(SquareMatrix SquareMatrixCategory DirectProduct - DirectProductCategory RadixExpansion)) and - GETDATABASE(op,'CONSTRUCTORMODEMAP) is [[.,target,arg1type,:restargs],.] => - ['Apply, op, - ['PretendTo, axFormatType first args, axFormatType arg1type], - :[axFormatType a for a in rest args]] - ['Apply, op, :[axFormatType a for a in args]] - error "unknown entry type" - -axFormatOpList ops == ['Sequence,:[axFormatOp o for o in ops]] - -axOpTran(name) == - ATOM name => - name = 'elt => 'apply - name = 'setelt => 'set! - name = 'SEGMENT => ".." - name = 1 => '_1 - name = 0 => '_0 - name - opOf name = 'Zero => '_0 - opOf name = 'One => '_1 - error "bad op name" - -axFormatOpSig(name, [result,:argtypes]) == - ['Declare, axOpTran name, - ['Apply, "->", ['Comma, :[axFormatType t for t in argtypes]], - axFormatType result]] - -axFormatConstantOp(name, [result]) == - ['Declare, axOpTran name, axFormatType result] - -\getchunk{axFormatPred aldor change} - -axFormatCondOp op == - $pretendFlag:local := true - axFormatOp op - - -axFormatOp op == - op is ['IF, pred, trueops, falseops] => - NULL(trueops) or trueops='noBranch => - ['If, ['Test,['Not, axFormatPred pred]], - axFormatCondOp falseops, - axFormatCondOp trueops] - ['If, axFormatPred pred, - axFormatCondOp trueops, - axFormatCondOp falseops] - -- ops are either single op or ['PROGN, ops] - op is ['SIGNATURE, name, type] => axFormatOpSig(name,type) - op is ['SIGNATURE, name, type, 'constant] => - axFormatConstantOp(name,type) - op is ['ATTRIBUTE, attributeOrCategory] => - categoryForm? attributeOrCategory => - axFormatType attributeOrCategory - ['RestrictTo, axFormatAttrib attributeOrCategory, 'Category] - op is ['PROGN, :ops] => axFormatOpList ops - op is 'noBranch => [] - axFormatType op - -addDefaults(catname, withform) == - withform isnt ['With, joins, ['Sequence,: oplist]] => - error "bad category body" - null(defaults := getDefaultingOps catname) => withform - defaultdefs := [makeDefaultDef(decl) for decl in defaults] - ['With, joins, - ['Sequence, :oplist, ['Default, ['Sequence,: defaultdefs]]]] - -makeDefaultDef(decl) == - decl isnt ['Declare, op, type] => - error "bad default definition" - $defaultFlag := true - type is ['Apply, "->", args, result] => - ['Define, decl, ['Lambda, makeDefaultArgs args, result, - ['Label, op, 'dummyDefault]]] - ['Define, ['Declare, op, type], 'dummyDefault] - -makeDefaultArgs args == - args isnt ['Comma,:argl] => error "bad default argument list" - ['Comma,: [['Declare,v,t] for v in $TriangleVariableList for t in argl]] - -getDefaultingOps catname == - not(name:=hasDefaultPackage catname) => nil - $infovec: local := getInfovec name - opTable := $infovec.1 - $opList:local := nil - for i in 0..MAXINDEX opTable repeat - op := opTable.i - i := i + 1 - startIndex := opTable.i - stopIndex := - i + 1 > MAXINDEX opTable => MAXINDEX getCodeVector() - opTable.(i + 2) - curIndex := startIndex - while curIndex < stopIndex repeat - curIndex := get1defaultOp(op,curIndex) - $pretendFlag : local := true - catops := GETDATABASE(catname, 'OPERATIONALIST) - [axFormatDefaultOpSig(op,sig,catops) for opsig in $opList | opsig is [op,sig]] - -axFormatDefaultOpSig(op, sig, catops) == - #sig > 1 => axFormatOpSig(op,sig) - nsig := MSUBST('$,'($), sig) -- dcSig listifies '$ ?? - (catsigs := LASSOC(op, catops)) and - (catsig := assoc(nsig, catsigs)) and last(catsig) = 'CONST => - axFormatConstantOp(op, sig) - axFormatOpSig(op,sig) - -get1defaultOp(op,index) == - numvec := getCodeVector() - segment := getOpSegment index - numOfArgs := numvec.index - index := index + 1 - predNumber := numvec.index - index := index + 1 - signumList := - -- following substitution fixes the problem that default packages - -- have $ added as a first arg, thus other arg counts are off by 1. - SUBLISLIS($FormalMapVariableList, rest $FormalMapVariableList, - dcSig(numvec,index,numOfArgs)) - index := index + numOfArgs + 1 - slotNumber := numvec.index - if not([op,signumList] in $opList) then - $opList := [[op,signumList],:$opList] - index + 1 - -axAddLiteral(name, type, dom) == - elt := [name, type, dom] - if not member( elt, $literals) then - $literals := [elt, :$literals] - -axDoLiterals() == - [ [ 'Import, - [ 'With, [], - ['Declare, name, [ 'Apply, '_-_> , dom , '_% ]]], - type ] for [name, type, dom] in $literals] - -\end{chunk} -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/ax.lisp.pamphlet b/src/interp/ax.lisp.pamphlet deleted file mode 100644 index 35c64b3..0000000 --- a/src/interp/ax.lisp.pamphlet +++ /dev/null @@ -1,2250 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\newcommand{\file}[1]{\texttt{#1}} -\begin{document} -\title{\$SPAD/src/interp ax.lisp} -\author{Ralf Hemmecke} -\maketitle -\begin{abstract} -We give an overview of what \file{ax.boot} does and in particular -describe the function \verb'makeAxExportForm'. -\end{abstract} -\eject -\tableofcontents -\eject -\section{New Aldor compiler changes} -This was changed so the open source version of axiom can work with the new -aldor compiler. -This used to read: -\begin{verbatim} - axForm := ['Sequence, ['Import, [], 'AxiomLib], :axForms] -\end{verbatim} -but was changed to read: -\begin{verbatim} - axForm := ['Sequence, _ - ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms] -\end{verbatim} -\section{Overview} -\subsection{makeAxExportForm} -The most important function in \file{ax.boot} is the function -\verb'makeAxExportForm'. - -The function takes as input a filename and a list of constructors. -Via LISP it would be called like -\begin{verbatim} -(|makeAxExportForm| filename constructors) -\end{verbatim} -where \verb'filename' is actually unused and could be removed and -\verb'constructors' should be a list of constructor names, i.e., names -of categories, domains, and packages in their unabbreviated form. - -It returns a list that represents the \texttt{.ap} (parsed source) -(see \verb'aldor -hall') form of the constructors. However, since the -output is only needed for a construction of an Aldor-Axiom -interaction, \verb'makeAxExportForm' will only construct the category -part of the constructor. - -The function is actually used in \file{src/aldor/genax.lsp} and is an -auxiliary part in the construction of the interface for the -interaction of the Aldor compiler with Axiom. -\begin{verbatim} -makeAxExportForm(filename, constructors) == - $defaultFlag : local := false - $literals := [] - axForms := - [modemapToAx(modemap) for cname in constructors | - (modemap:=GETDATABASE(cname,'CONSTRUCTORMODEMAP)) and - (not cname in '(Tuple Exit Type)) and - not isDefaultPackageName cname] - if $baseForms then - axForms := [:$baseForms, :axForms] - if $defaultFlag then - axForms := - [['Foreign, ['Declare, 'dummyDefault, 'Exit], 'Lisp], :axForms] - axForms := APPEND(axDoLiterals(), axForms) - axForm := ['Sequence, _ - ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms] - axForm - -\end{verbatim} -The basic translation is easily demonstrated with a few examples. For -better readability, we look at the corresponding SPAD form of the -constructor (instead of its internal LISP representation). - -Let us first state what different situations we identified. -\begin{enumerate} -\item Ordinary domains. See Section~\ref{sec:Domain}. -\item Ordinary categories. See Section~\ref{sec:Category}. -\item Ordinary categories with default packages. See - Section~\ref{sec:Category+Default}. -\item Initial domains, i.e., domains that will be extended in the - course of building \file{libaxiom.al}. These domains are listed in - the variable \verb'$extendedDomains'. %$ - - See Sections~\ref{sec:InitDomain} and - \ref{sec:ParametrizedInitDomain}. There is a subdivision for these - domains. - \begin{enumerate} - \item For domains that take no arguments, see - Section~\ref{sec:InitDomain}. - \item For domains that take arguments, see - Section~\ref{sec:ParametrizedInitDomain}. - \end{enumerate} -\end{enumerate} -\section{Ordinary Domains}\label{sec:Domain} -The domain \verb'Stack'. -\begin{verbatim} -Stack(S:SetCategory): StackAggregate S with - stack: List S -> % - == add - Rep := Reference List S - ... -\end{verbatim} -It is translated into \ldots -\begin{verbatim} -(|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Export| - (|Declare| |Stack| - (|Apply| -> (|Declare| |#1| |SetCategory|) - (|With| NIL - (|Sequence| - (|Apply| |StackAggregate| |#1|) - (|Declare| |stack| - (|Apply| -> - (|Comma| (|Apply| |List| |#1|)) - %)))))) - NIL NIL)) -\end{verbatim} -That is the parsed source of the Aldor code \ldots -\begin{verbatim} -import from AxiomLib; -import from Boolean; -export Stack: (T: SetCategory) -> with { - StackAggregate T; - stack: List T -> %; - } -\end{verbatim} -Note that nothing appears before the \verb'with'. No problem because -that is equivalent to a \verb'Join' in Aldor. -\section{Ordinary Categories}\label{sec:Category} -The category \verb'SquareFreeNormalizedTriangularSetCategory' without -a default package. -\begin{verbatim} -SquareFreeNormalizedTriangularSetCategory(_ - R: GcdDomain,_ - E: OrderedAbelianMonoidSup,_ - V: OrderedSet,_ - P:RecursivePolynomialCategory(R, E, V)): Category == - Join(_ - SquareFreeRegularTriangularSetCategory(R,E,V,P),_ - NormalizedTriangularSetCategory(R,E,V,P)) -\end{verbatim} -It is translated into \ldots -\begin{verbatim} -(|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Define| - (|Declare| |SquareFreeNormalizedTriangularSetCategory| - (|Apply| -> - (|Comma| (|Declare| |#1| |GcdDomain|) - (|Declare| |#2| - |OrderedAbelianMonoidSup|) - (|Declare| |#3| |OrderedSet|) - (|Declare| |#4| - (|Apply| |RecursivePolynomialCategory| - |#1| |#2| |#3|))) - |Category|)) - (|Lambda| - (|Comma| (|Declare| |#1| |GcdDomain|) - (|Declare| |#2| |OrderedAbelianMonoidSup|) - (|Declare| |#3| |OrderedSet|) - (|Declare| |#4| - (|Apply| |RecursivePolynomialCategory| |#1| - |#2| |#3|))) - |Category| - (|Label| |SquareFreeNormalizedTriangularSetCategory| - (|With| NIL - (|Sequence| - (|Apply| |SquareFreeRegularTriangularSetCategory| - |#1| |#2| |#3| |#4|) - (|Apply| |NormalizedTriangularSetCategory| - |#1| |#2| |#3| |#4|))))))) -\end{verbatim} -That is the parsed source of the Aldor code \ldots -\begin{verbatim} -import from AxiomLib; -import from Boolean; -SquareFreeNormalizedTriangularSetCategory: ( - R: GcdDomain, - E: OrderedAbelianMonoidSup, - V: OrderedSet, - P: RecursivePolynomialCategory(R, E, V) -) -> Category == ( - R: GcdDomain, - E: OrderedAbelianMonoidSup, - V: OrderedSet, - P: RecursivePolynomialCategory(R, E, V) -): Category +-> with { - SquareFreeRegularTriangularSetCategory(R, E, V, P), - NormalizedTriangularSetCategory(R, E, V, P) -} -\end{verbatim} - Again, nothing appears in front of the \verb'with'. No problem - because that is equivalent to a \verb'Join' in Aldor. -\section{Ordinary Categories with Default Packages} -\label{sec:Category+Default} -The category \verb'StringAggregate' with default package. -\begin{verbatim} -StringAggregate: Category == OneDimensionalArrayAggregate Character with - lowerCase : % -> % - lowerCase_!: % -> % - upperCase : % -> % - ... - rightTrim: (%, CharacterClass) -> % - elt: (%, %) -> % - add - trim(s: %, c: Character) == leftTrim(rightTrim(s, c), c) - trim(s: %, cc: CharacterClass) == leftTrim(rightTrim(s, cc), cc) - lowerCase s == lowerCase_! copy s - upperCase s == upperCase_! copy s - prefix?(s, t) == substring?(s, t, minIndex t) - coerce(c:Character):% == new(1, c) - elt(s:%, t:%): % == concat(s,t)$% -\end{verbatim} -It is translated into \ldots -\begin{verbatim} -(|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Foreign| (|Declare| |dummyDefault| |Exit|) |Lisp|) - (|Define| (|Declare| |StringAggregate| |Category|) - (|With| NIL - (|Sequence| - (|Apply| |OneDimensionalArrayAggregate| - |Character|) - (|Declare| |lowerCase| (|Apply| -> (|Comma| %) %)) - (|Declare| |lowerCase!| (|Apply| -> (|Comma| %) %)) - (|Declare| |upperCase| (|Apply| -> (|Comma| %) %)) - ... - (|Declare| |rightTrim| - (|Apply| -> (|Comma| % |CharacterClass|) %)) - (|Declare| |apply| (|Apply| -> (|Comma| % %) %)) - (|Default| - (|Sequence| - (|Define| - (|Declare| |coerce| - (|Apply| -> (|Comma| |Character|) - %)) - (|Lambda| - (|Comma| - (|Declare| |t#1| |Character|)) - % - (|Label| |coerce| |dummyDefault|))) - (|Define| - (|Declare| |apply| - (|Apply| -> (|Comma| % %) %)) - (|Lambda| - (|Comma| (|Declare| |t#1| %) - (|Declare| |t#2| %)) - % (|Label| |apply| |dummyDefault|))) - (|Define| - (|Declare| |lowerCase| - (|Apply| -> (|Comma| %) %)) - (|Lambda| (|Comma| (|Declare| |t#1| %)) - % - (|Label| |lowerCase| - |dummyDefault|))) - ... - )))))) -\end{verbatim} -That is the parsed source of the Aldor code \ldots -\begin{verbatim} -import from AxiomLib; -import from Boolean; -import dummyDefault: Exit from Foreign Lisp; -StringAggregate: Category == with { - OneDimensionalArrayAggregate Character; - lowerCase: % -> %; - lowerCase!: % -> %; - upperCase: % -> %; - ... - rightTrim: (%, CharacterClass) -> %; - apply: (%, %) -> % - default { - coerce: Character -> % == (t: Character): % +-> dummyDefault; - apply: (%, %) -> % == (t1: %, t2: %): % +-> dummyDefault; - lowerCase: % -> % == (t: %): % +-> dummyDefault; - ... -} -\end{verbatim} -It is important to note that the actual default functions are given by -a dummy implementation that is imported from LISP. - -And again, nothing appears in front of the \verb'with'. No problem -because that is equivalent to a \verb'Join' in Aldor. - -Note that the \verb'elt' function is translated into \verb'apply'. -\section{Initial Domains without Arguments} -\label{sec:InitDomain} -\begin{verbatim} -SingleInteger(): Join(IntegerNumberSystem,Logic,OpenMath) with - canonical - canonicalsClosed - noetherian - max : () -> % - min : () -> % - "not": % -> % - "~" : % -> % - "/\": (%, %) -> % - "\/" : (%, %) -> % - "xor": (%, %) -> % - Not : % -> % - And : (%,%) -> % - Or : (%,%) -> % - == add - ... -\end{verbatim} -It is translated into \ldots -\begin{verbatim} -(|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Extend| - (|Define| - (|Declare| |SingleInteger| - (|With| NIL - (|Sequence| |IntegerNumberSystem| |Logic| - |OpenMath| - (|RestrictTo| |canonical| |Category|) - (|RestrictTo| |canonicalsClosed| - |Category|) - (|RestrictTo| |noetherian| |Category|) - (|Declare| |max| (|Apply| -> (|Comma|) %)) - (|Declare| |min| (|Apply| -> (|Comma|) %)) - (|Declare| |not| - (|Apply| -> (|Comma| %) %)) - (|Declare| ~ (|Apply| -> (|Comma| %) %)) - (|Declare| |/\\| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |\\/| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |xor| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |Not| - (|Apply| -> (|Comma| %) %)) - (|Declare| |And| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |Or| - (|Apply| -> (|Comma| % %) %))))) - (|Add| (|PretendTo| (|Add| NIL NIL) - (|With| NIL - (|Sequence| |IntegerNumberSystem| - |Logic| |OpenMath| - (|RestrictTo| |canonical| - |Category|) - (|RestrictTo| |canonicalsClosed| - |Category|) - (|RestrictTo| |noetherian| - |Category|) - (|Declare| |max| - (|Apply| -> (|Comma|) %)) - (|Declare| |min| - (|Apply| -> (|Comma|) %)) - (|Declare| |not| - (|Apply| -> (|Comma| %) %)) - (|Declare| ~ - (|Apply| -> (|Comma| %) %)) - (|Declare| |/\\| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |\\/| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |xor| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |Not| - (|Apply| -> (|Comma| %) %)) - (|Declare| |And| - (|Apply| -> (|Comma| % %) %)) - (|Declare| |Or| - (|Apply| -> (|Comma| % %) %))))) - NIL)))) -\end{verbatim} -That is the parsed source of the Aldor code \ldots -\begin{verbatim} -import from AxiomLib; -import from Boolean; -extend SingleInteger: with { - IntegerNumberSystem; - Logic; - OpenMath; - canonical @ Category; - canonicalsClosed @ Category; - noetherian @ Category; - max: () -> %; - min: () -> %; - _not: % -> %; - ~: % -> %; - /\: (%, %) -> %; - \/: (%, %) -> %; - xor: (%, %) -> %; - Not: % -> %; - And: (%,%) -> %; - Or : (%,%) -> %; -} - == (add pretend with { - IntegerNumberSystem; - Logic; - OpenMath; - canonical @ Category; - canonicalsClosed @ Category; - noetherian @ Category; - max: () -> %; - min: () -> %; - _not: % -> %; - ~: % -> %; - /\: (%, %) -> %; - \/: (%, %) -> %; - xor: (%, %) -> %; - Not: % -> %; - And: (%,%) -> %; - Or : (%,%) -> %; -}) add; -\end{verbatim} -\section{Initial Domains with Arguments} -\label{sec:ParametrizedInitDomain} -\begin{verbatim} -SegmentBinding(S:Type): Type with - equation: (Symbol, Segment S) -> % - variable: % -> Symbol - segment : % -> Segment S - if S has SetCategory then SetCategory - == add - Rep := Record(var:Symbol, seg:Segment S) - ... -\end{verbatim} -It is translated into \ldots -\begin{verbatim} -(|Sequence| (|Import| NIL |AxiomLib|) (|Import| NIL |Boolean|) - (|Sequence| - (|Define| - (|Declare| |SegmentBindingExtendCategory| - (|Apply| -> (|Declare| |#1| |Type|) |Category|)) - (|Lambda| (|Comma| (|Declare| |#1| |Type|)) |Category| - (|Label| |SegmentBindingExtendCategory| - (|With| NIL - (|Sequence| - (|Declare| |equation| - (|Apply| -> - (|Comma| |Symbol| - (|Apply| |Segment| |#1|)) - %)) - (|Declare| |variable| - (|Apply| -> (|Comma| %) |Symbol|)) - (|Declare| |segment| - (|Apply| -> (|Comma| %) - (|Apply| |Segment| |#1|))) - (|If| - (|Test| - (|Has| |#1| |SetCategory|)) - |SetCategory| NIL)))))) - (|Extend| - (|Define| - (|Declare| |SegmentBinding| - (|Apply| -> (|Declare| |#1| |Type|) - (|Apply| |SegmentBindingExtendCategory| - |#1|))) - (|Lambda| (|Comma| (|Declare| |#1| |Type|)) - (|Apply| |SegmentBindingExtendCategory| |#1|) - (|Label| |SegmentBinding| - (|Add| (|PretendTo| (|Add| NIL NIL) - (|Apply| - |SegmentBindingExtendCategory| - |#1|)) - NIL))))))) -\end{verbatim} -That is the parsed source of the Aldor code \ldots -\begin{verbatim} -import from AxiomLib; -import from Boolean; -SegmentBindingExtendCategory: (S: Type) -> Category == - (T: Type): Category +-> with { - equation: (Symbol, Segment S) -> %; - variable: % -> Symbol; - segment : % -> Segment S; - if S has SetCategory then SetCategory; -} -extend SegmentBinding: (S: Type) -> SegmentBindingExtendCategory S == - (S: Type): SegmentBindingExtendCategory S +-> - (add pretend SegmentBindingExtendCategory S) add; -\end{verbatim} -The last lines are actually equivalent to -\begin{verbatim} -extend SegmentBinding(S: Type): SegmentBindingExtendCategory S == - (add pretend SegmentBindingExtendCategory S) add; -\end{verbatim} - -\section{axFormatPref} -Here we add an else clause. The original code read: -\begin{verbatim} - if name = '$ then name := '% -\end{verbatim} -It appears that Aldor allows a richer syntax for [[has]] -conditions since the call to [[axFormatOp]] appears to allow -nested IF conditions.OQ -\begin{verbatim} -axFormatPred pred == - atom pred => pred - [op,:args] := pred - op = 'IF => axFormatOp pred - op = 'has => - [name,type] := args - if name = '$ then name := '% - else name := axFormatOp name - ftype := axFormatOp type - if ftype is ['Declare,:.] then - ftype := ['With, [], ftype] - ['Test,['Has,name, ftype]] - axArglist := [axFormatPred arg for arg in args] - op = 'AND => ['And,:axArglist] - op = 'OR => ['Or,:axArglist] - op = 'NOT => ['Not,:axArglist] - error "unknown predicate" - -\end{verbatim} -\begin{chunk}{*} -;$stripTypes := false - -(SPADLET |$stripTypes| NIL) -;$pretendFlag := false - -(SPADLET |$pretendFlag| NIL) - -;$defaultFlag := false - -(SPADLET |$defaultFlag| NIL) - -;$baseForms := nil - -(SPADLET |$baseForms| NIL) - -;$literals := nil - -(SPADLET |$literals| NIL) - -;spad2AxTranslatorAutoloadOnceTrigger any == true - -(defun |spad2AxTranslatorAutoloadOnceTrigger| (|any|) - (declare (ignore |any|)) - t) - -;sourceFilesToAxFile(filename, sourceFiles) == -; makeAxFile(filename, MAPCAN('fileConstructors, sourceFiles)) - -(DEFUN |sourceFilesToAxFile| (|filename| |sourceFiles|) - (|makeAxFile| |filename| (MAPCAN '|fileConstructors| |sourceFiles|))) - -;$extendedDomains := nil - -(SPADLET |$extendedDomains| NIL) - -;setExtendedDomains(l) == -; $extendedDomains := l - -(DEFUN |setExtendedDomains| (|l|) - (declare (special |$extendedDomains|)) - (SPADLET |$extendedDomains| |l|)) - -;fileConstructors name == -; [INTERN(con,"BOOT") for con in SRCABBREVS SOURCEPATH STRING name] - -(DEFUN |fileConstructors| (|name|) - (PROG () - (RETURN - (SEQ (PROG (G166071) - (SPADLET G166071 NIL) - (RETURN - (DO ((G166076 - (SRCABBREVS (SOURCEPATH (STRING |name|))) - (CDR G166076)) - (|con| NIL)) - ((OR (ATOM G166076) - (PROGN (SETQ |con| (CAR G166076)) NIL)) - (NREVERSE0 G166071)) - (SEQ (EXIT (SETQ G166071 - (CONS (INTERN |con| 'BOOT) G166071))))))))))) - -;makeAxFile(filename, constructors) == -; $defaultFlag : local := false -; $literals := [] -; axForms := -; [modemapToAx(modemap) for cname in constructors | -; (modemap:=GETDATABASE(cname,'CONSTRUCTORMODEMAP)) and -; (not cname in '(Tuple Exit Type)) and -; not isDefaultPackageName cname] -; if $baseForms then -; axForms := [:$baseForms, :axForms] -; if $defaultFlag then -; axForms := -; [['Foreign, ['Declare, 'dummyDefault, 'Exit], 'Lisp], :axForms] -; axForms := APPEND(axDoLiterals(), axForms) -; axForm := ['Sequence, _ -; ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms] -; st := MAKE_-OUTSTREAM(filename) -; PPRINT(axForm,st) -; CLOSE st - -(DEFUN |makeAxFile| (|filename| |constructors|) - (PROG (|$defaultFlag| |modemap| |axForms| |axForm| |st|) - (DECLARE (SPECIAL |$defaultFlag| |$baseForms| |$literals|)) - (RETURN - (SEQ (PROGN - (SPADLET |$defaultFlag| NIL) - (SPADLET |$literals| NIL) - (SPADLET |axForms| - (PROG (G166092) - (SPADLET G166092 NIL) - (RETURN - (DO ((G166098 |constructors| - (CDR G166098)) - (|cname| NIL)) - ((OR (ATOM G166098) - (PROGN - (SETQ |cname| (CAR G166098)) - NIL)) - (NREVERSE0 G166092)) - (SEQ (EXIT (COND - ((AND - (SPADLET |modemap| - (GETDATABASE |cname| - 'CONSTRUCTORMODEMAP)) - (NULL - (|member| |cname| - '(|Tuple| |Exit| |Type|))) - (NULL - (|isDefaultPackageName| - |cname|))) - (SETQ G166092 - (CONS - (|modemapToAx| |modemap|) - G166092)))))))))) - (COND - (|$baseForms| - (SPADLET |axForms| (APPEND |$baseForms| |axForms|)))) - (COND - (|$defaultFlag| - (SPADLET |axForms| - (CONS (CONS '|Foreign| - (CONS - (CONS '|Declare| - (CONS '|dummyDefault| - (CONS '|Exit| NIL))) - (CONS '|Lisp| NIL))) - |axForms|)))) - (SPADLET |axForms| (APPEND (|axDoLiterals|) |axForms|)) - (SPADLET |axForm| - (CONS '|Sequence| - (CONS (CONS '|Import| - (CONS NIL - (CONS '|AxiomLib| NIL))) - (CONS (CONS '|Import| - (CONS NIL - (CONS '|Boolean| NIL))) - |axForms|)))) - (SPADLET |st| (MAKE-OUTSTREAM |filename|)) - (PPRINT |axForm| |st|) - (CLOSE |st|)))))) - -;makeAxExportForm(filename, constructors) == -; $defaultFlag : local := false -; $literals := [] -; axForms := -; [modemapToAx(modemap) for cname in constructors | -; (modemap:=GETDATABASE(cname,'CONSTRUCTORMODEMAP)) and -; (not cname in '(Tuple Exit Type)) and -; not isDefaultPackageName cname] -; if $baseForms then -; axForms := [:$baseForms, :axForms] -; if $defaultFlag then -; axForms := -; [['Foreign, ['Declare, 'dummyDefault, 'Exit], 'Lisp], :axForms] -; axForms := APPEND(axDoLiterals(), axForms) -; axForm := ['Sequence, _ -; ['Import, [], 'AxiomLib], ['Import, [], 'Boolean], :axForms] -; axForm - -(DEFUN |makeAxExportForm| (|filename| |constructors|) - (declare (ignore |filename|)) - (PROG (|$defaultFlag| |modemap| |axForms| |axForm|) - (DECLARE (SPECIAL |$defaultFlag| |$baseForms| |$literals|)) - (RETURN - (SEQ (PROGN - (SPADLET |$defaultFlag| NIL) - (SPADLET |$literals| NIL) - (SPADLET |axForms| - (PROG (G166125) - (SPADLET G166125 NIL) - (RETURN - (DO ((G166131 |constructors| - (CDR G166131)) - (|cname| NIL)) - ((OR (ATOM G166131) - (PROGN - (SETQ |cname| (CAR G166131)) - NIL)) - (NREVERSE0 G166125)) - (SEQ (EXIT (COND - ((AND - (SPADLET |modemap| - (GETDATABASE |cname| - 'CONSTRUCTORMODEMAP)) - (NULL - (|member| |cname| - '(|Tuple| |Exit| |Type|))) - (NULL - (|isDefaultPackageName| - |cname|))) - (SETQ G166125 - (CONS - (|modemapToAx| |modemap|) - G166125)))))))))) - (COND - (|$baseForms| - (SPADLET |axForms| (APPEND |$baseForms| |axForms|)))) - (COND - (|$defaultFlag| - (SPADLET |axForms| - (CONS (CONS '|Foreign| - (CONS - (CONS '|Declare| - (CONS '|dummyDefault| - (CONS '|Exit| NIL))) - (CONS '|Lisp| NIL))) - |axForms|)))) - (SPADLET |axForms| (APPEND (|axDoLiterals|) |axForms|)) - (SPADLET |axForm| - (CONS '|Sequence| - (CONS (CONS '|Import| - (CONS NIL - (CONS '|AxiomLib| NIL))) - (CONS (CONS '|Import| - (CONS NIL - (CONS '|Boolean| NIL))) - |axForms|)))) - |axForm|))))) - -;stripType type == -; $stripTypes => -; categoryForm? type => 'Type -; type -; type - -(DEFUN |stripType| (|type|) - (declare (special |$stripTypes|)) - (COND - (|$stripTypes| - (COND ((|categoryForm?| |type|) '|Type|) ('T |type|))) - ('T |type|))) - -;modemapToAx(modemap) == -; modemap is [[consform, target,:argtypes],.] -; consform is [constructor,:args] -; argdecls:=['Comma, : [axFormatDecl(a,stripType t) for a in args for t in argtypes]] -; resultType := axFormatType stripType target -; categoryForm? constructor => -; categoryInfo := GETDATABASE(constructor,'CONSTRUCTORCATEGORY) -; categoryInfo := SUBLISLIS($FormalMapVariableList, $TriangleVariableList, -; categoryInfo) -; NULL args => -; ['Define,['Declare, constructor,'Category], -; addDefaults(constructor, axFormatType categoryInfo)] -; ['Define, -; ['Declare, constructor, ['Apply, "->", optcomma argdecls, 'Category]], -; ['Lambda, argdecls, 'Category, -; ['Label, constructor, -; addDefaults(constructor, axFormatType categoryInfo)]]] -; constructor in $extendedDomains => -; NULL args => -; ['Extend, ['Define, ['Declare, constructor, resultType], -; ['Add, ['PretendTo, ['Add, [], []], resultType], []]]] -; conscat := INTERN(STRCONC(SYMBOL_-NAME(constructor), "ExtendCategory"),"BOOT") -; rtype := ['Apply, conscat, :args] -;-- if resultType is ['With,a,b] then -;-- if not(b is ['Sequence,:withseq]) then withseq := [b] -;-- cosigs := rest GETDATABASE(constructor, 'COSIG) -;-- exportargs := [['Export, [], arg, []] for arg in args for p in cosigs | p] -;-- resultType := ['With,a,['Sequence,:APPEND(exportargs, withseq)]] -; consdef := ['Define, -; ['Declare, conscat, ['Apply, "->", optcomma argdecls, 'Category]], -; ['Lambda, argdecls, 'Category, ['Label, conscat, resultType]]] -; ['Sequence, consdef, -; ['Extend, ['Define, -; ['Declare, constructor, ['Apply, "->", optcomma argdecls, rtype]], -; ['Lambda, argdecls, rtype, -; ['Label, constructor, -; ['Add, ['PretendTo, ['Add, [], []], rtype], []]]]]]] -; NULL args => -; ['Export, ['Declare, constructor, resultType],[],[]] -;-- if resultType is ['With,a,b] then -;-- if not(b is ['Sequence,:withseq]) then withseq := [b] -;-- cosigs := rest GETDATABASE(constructor, 'COSIG) -;-- exportargs := [['Export, [], arg, []] for arg in args for p in cosigs | p] -;-- resultType := ['With,a,['Sequence,:APPEND(exportargs, withseq)]] -; ['Export, ['Declare, constructor, ['Apply, "->", optcomma argdecls, resultType]],[],[]] - -(DEFUN |modemapToAx| (|modemap|) - (PROG (|ISTMP#1| |consform| |ISTMP#2| |target| |argtypes| |ISTMP#3| - |constructor| |args| |argdecls| |resultType| |categoryInfo| - |conscat| |rtype| |consdef|) - (declare (special |$extendedDomains| |$TriangleVariableList| - |$FormalMapVariableList|)) - (RETURN - (SEQ (PROGN - (AND (PAIRP |modemap|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |modemap|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |consform| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |target| (QCAR |ISTMP#2|)) - (SPADLET |argtypes| (QCDR |ISTMP#2|)) - 'T))))) - (PROGN - (SPADLET |ISTMP#3| (QCDR |modemap|)) - (AND (PAIRP |ISTMP#3|) (EQ (QCDR |ISTMP#3|) NIL)))) - (AND (PAIRP |consform|) - (PROGN - (SPADLET |constructor| (QCAR |consform|)) - (SPADLET |args| (QCDR |consform|)) - 'T)) - (SPADLET |argdecls| - (CONS '|Comma| - (PROG (G166191) - (SPADLET G166191 NIL) - (RETURN - (DO ((G166197 |args| (CDR G166197)) - (|a| NIL) - (G166198 |argtypes| - (CDR G166198)) - (|t| NIL)) - ((OR (ATOM G166197) - (PROGN - (SETQ |a| (CAR G166197)) - NIL) - (ATOM G166198) - (PROGN - (SETQ |t| (CAR G166198)) - NIL)) - (NREVERSE0 G166191)) - (SEQ (EXIT - (SETQ G166191 - (CONS - (|axFormatDecl| |a| - (|stripType| |t|)) - G166191))))))))) - (SPADLET |resultType| - (|axFormatType| (|stripType| |target|))) - (COND - ((|categoryForm?| |constructor|) - (SPADLET |categoryInfo| - (GETDATABASE |constructor| - 'CONSTRUCTORCATEGORY)) - (SPADLET |categoryInfo| - (SUBLISLIS |$FormalMapVariableList| - |$TriangleVariableList| |categoryInfo|)) - (COND - ((NULL |args|) - (CONS '|Define| - (CONS (CONS '|Declare| - (CONS |constructor| - (CONS '|Category| NIL))) - (CONS (|addDefaults| |constructor| - (|axFormatType| |categoryInfo|)) - NIL)))) - ('T - (CONS '|Define| - (CONS (CONS '|Declare| - (CONS |constructor| - (CONS - (CONS '|Apply| - (CONS '-> - (CONS (|optcomma| |argdecls|) - (CONS '|Category| NIL)))) - NIL))) - (CONS (CONS '|Lambda| - (CONS |argdecls| - (CONS '|Category| - (CONS - (CONS '|Label| - (CONS |constructor| - (CONS - (|addDefaults| - |constructor| - (|axFormatType| - |categoryInfo|)) - NIL))) - NIL)))) - NIL)))))) - ((|member| |constructor| |$extendedDomains|) - (COND - ((NULL |args|) - (CONS '|Extend| - (CONS (CONS '|Define| - (CONS - (CONS '|Declare| - (CONS |constructor| - (CONS |resultType| NIL))) - (CONS - (CONS '|Add| - (CONS - (CONS '|PretendTo| - (CONS - (CONS '|Add| - (CONS NIL (CONS NIL NIL))) - (CONS |resultType| NIL))) - (CONS NIL NIL))) - NIL))) - NIL))) - ('T - (SPADLET |conscat| - (INTERN (STRCONC - (SYMBOL-NAME |constructor|) - '|ExtendCategory|) - 'BOOT)) - (SPADLET |rtype| - (CONS '|Apply| (CONS |conscat| |args|))) - (SPADLET |consdef| - (CONS '|Define| - (CONS (CONS '|Declare| - (CONS |conscat| - (CONS - (CONS '|Apply| - (CONS '-> - (CONS - (|optcomma| |argdecls|) - (CONS '|Category| NIL)))) - NIL))) - (CONS - (CONS '|Lambda| - (CONS |argdecls| - (CONS '|Category| - (CONS - (CONS '|Label| - (CONS |conscat| - (CONS |resultType| NIL))) - NIL)))) - NIL)))) - (CONS '|Sequence| - (CONS |consdef| - (CONS (CONS '|Extend| - (CONS - (CONS '|Define| - (CONS - (CONS '|Declare| - (CONS |constructor| - (CONS - (CONS '|Apply| - (CONS '-> - (CONS - (|optcomma| |argdecls|) - (CONS |rtype| NIL)))) - NIL))) - (CONS - (CONS '|Lambda| - (CONS |argdecls| - (CONS |rtype| - (CONS - (CONS '|Label| - (CONS |constructor| - (CONS - (CONS '|Add| - (CONS - (CONS '|PretendTo| - (CONS - (CONS '|Add| - (CONS NIL - (CONS NIL NIL))) - (CONS |rtype| NIL))) - (CONS NIL NIL))) - NIL))) - NIL)))) - NIL))) - NIL)) - NIL)))))) - ((NULL |args|) - (CONS '|Export| - (CONS (CONS '|Declare| - (CONS |constructor| - (CONS |resultType| NIL))) - (CONS NIL (CONS NIL NIL))))) - ('T - (CONS '|Export| - (CONS (CONS '|Declare| - (CONS |constructor| - (CONS - (CONS '|Apply| - (CONS '-> - (CONS - (|optcomma| |argdecls|) - (CONS |resultType| NIL)))) - NIL))) - (CONS NIL (CONS NIL NIL))))))))))) - -;optcomma [op,:args] == -; # args = 1 => first args -; [op,:args] - -(DEFUN |optcomma| (G166227) - (PROG (|op| |args|) - (RETURN - (PROGN - (SPADLET |op| (CAR G166227)) - (SPADLET |args| (CDR G166227)) - (COND - ((EQL (|#| |args|) 1) (CAR |args|)) - ('T (CONS |op| |args|))))))) - -;axFormatDecl(sym, type) == -; if sym = '$ then sym := '% -; opOf type in '(StreamAggregate FiniteLinearAggregate) => -; ['Declare, sym, 'Type] -; ['Declare, sym, axFormatType type] - -(DEFUN |axFormatDecl| (|sym| |type|) - (PROGN - (COND ((BOOT-EQUAL |sym| '$) (SPADLET |sym| '%))) - (COND - ((|member| (|opOf| |type|) - '(|StreamAggregate| |FiniteLinearAggregate|)) - (CONS '|Declare| (CONS |sym| (CONS '|Type| NIL)))) - ('T - (CONS '|Declare| - (CONS |sym| (CONS (|axFormatType| |type|) NIL))))))) - -;makeTypeSequence l == -; ['Sequence,: delete('Type, l)] - -(DEFUN |makeTypeSequence| (|l|) - (CONS '|Sequence| (|delete| '|Type| |l|))) - -;axFormatAttrib(typeform) == -; atom typeform => typeform -; axFormatType typeform - -(DEFUN |axFormatAttrib| (|typeform|) - (COND - ((ATOM |typeform|) |typeform|) - ('T (|axFormatType| |typeform|)))) - -;axFormatType(typeform) == -; atom typeform => -; typeform = '$ => '% -; STRINGP typeform => -; ['Apply,'Enumeration, INTERN typeform] -; INTEGERP typeform => -; -- need to test for PositiveInteger vs Integer -; axAddLiteral('integer, 'PositiveInteger, 'Literal) -; ['RestrictTo, ['LitInteger, STRINGIMAGE typeform ], 'PositiveInteger] -; FLOATP typeform => ['LitFloat, STRINGIMAGE typeform] -; MEMQ(typeform,$TriangleVariableList) => -; SUBLISLIS($FormalMapVariableList, $TriangleVariableList, typeform) -; MEMQ(typeform, $FormalMapVariableList) => typeform -; axAddLiteral('string, 'Symbol, 'Literal) -; ['RestrictTo, ['LitString, PNAME typeform], 'Symbol] -; typeform is ['construct,: args] => -; axAddLiteral('bracket, ['Apply, 'List, 'Symbol], [ 'Apply, 'Tuple, 'Symbol]) -; axAddLiteral('string, 'Symbol, 'Literal) -; ['RestrictTo, ['Apply, 'bracket, -; :[axFormatType a for a in args]], -; ['Apply, 'List, 'Symbol] ] -; typeform is [op] => -; op = '$ => '% -; op = 'Void => ['Comma] -; op -; typeform is ['local, val] => axFormatType val -; typeform is ['QUOTE, val] => axFormatType val -; typeform is ['Join,:cats,lastcat] => -; lastcat is ['CATEGORY,type,:ops] => -; ['With, [], -; makeTypeSequence( -; APPEND([axFormatType c for c in cats], -; [axFormatOp op for op in ops]))] -; ['With, [], makeTypeSequence([axFormatType c for c in rest typeform])] -; typeform is ['CATEGORY, type, :ops] => -; ['With, [], axFormatOpList ops] -; typeform is ['Mapping, target, :argtypes] => -; ['Apply, "->", -; ['Comma, :[axFormatType t for t in argtypes]], -; axFormatType target] -; typeform is ['_:, name, type] => axFormatDecl(name,type) -; typeform is ['Union, :args] => -; first args is ['_:,.,.] => -; ['Apply, 'Union, :[axFormatType a for a in args]] -; taglist := [] -; valueCount := 0 -; for x in args repeat -; tag := -; STRINGP x => INTERN x -; x is ['QUOTE,val] and STRINGP val => INTERN val -; valueCount := valueCount + 1 -; INTERNL("value", STRINGIMAGE valueCount) -; taglist := [tag ,: taglist] -; ['Apply, 'Union, :[axFormatDecl(name,type) for name in reverse taglist -; for type in args]] -; typeform is ['Dictionary,['Record,:args]] => -; ['Apply, 'Dictionary, -; ['PretendTo, axFormatType CADR typeform, 'SetCategory]] -; typeform is ['FileCategory,xx,['Record,:args]] => -; ['Apply, 'FileCategory, axFormatType xx, -; ['PretendTo, axFormatType CADDR typeform, 'SetCategory]] -; typeform is [op,:args] => -; $pretendFlag and constructor? op and -; GETDATABASE(op,'CONSTRUCTORMODEMAP) is [[.,target,:argtypes],.] => -; ['Apply, op, -; :[['PretendTo, axFormatType a, axFormatType t] -; for a in args for t in argtypes]] -; MEMQ(op, '(SquareMatrix SquareMatrixCategory DirectProduct -; DirectProductCategory RadixExpansion)) and -; GETDATABASE(op,'CONSTRUCTORMODEMAP) is [[.,target,arg1type,:restargs],.] => -; ['Apply, op, -; ['PretendTo, axFormatType first args, axFormatType arg1type], -; :[axFormatType a for a in rest args]] -; ['Apply, op, :[axFormatType a for a in args]] -; error "unknown entry type" - -(DEFUN |axFormatType| (|typeform|) - (PROG (|lastcat| |cats| |ops| |name| |type| |val| |valueCount| |tag| - |taglist| |xx| |op| |args| |argtypes| |ISTMP#1| |ISTMP#2| - |ISTMP#3| |target| |ISTMP#4| |arg1type| |restargs| - |ISTMP#5|) - (declare (special |$pretendFlag| |$FormalMapVariableList| - |$TriangleVariableList|)) - (RETURN - (SEQ (COND - ((ATOM |typeform|) - (COND - ((BOOT-EQUAL |typeform| '$) '%) - ((STRINGP |typeform|) - (CONS '|Apply| - (CONS '|Enumeration| - (CONS (INTERN |typeform|) NIL)))) - ((INTEGERP |typeform|) - (|axAddLiteral| '|integer| '|PositiveInteger| - '|Literal|) - (CONS '|RestrictTo| - (CONS (CONS '|LitInteger| - (CONS (STRINGIMAGE |typeform|) NIL)) - (CONS '|PositiveInteger| NIL)))) - ((FLOATP |typeform|) - (CONS '|LitFloat| (CONS (STRINGIMAGE |typeform|) NIL))) - ((member |typeform| |$TriangleVariableList|) - (SUBLISLIS |$FormalMapVariableList| - |$TriangleVariableList| |typeform|)) - ((member |typeform| |$FormalMapVariableList|) |typeform|) - ('T (|axAddLiteral| '|string| '|Symbol| '|Literal|) - (CONS '|RestrictTo| - (CONS (CONS '|LitString| - (CONS (PNAME |typeform|) NIL)) - (CONS '|Symbol| NIL)))))) - ((AND (PAIRP |typeform|) - (EQ (QCAR |typeform|) '|construct|) - (PROGN (SPADLET |args| (QCDR |typeform|)) 'T)) - (|axAddLiteral| '|bracket| - (CONS '|Apply| (CONS '|List| (CONS '|Symbol| NIL))) - (CONS '|Apply| (CONS '|Tuple| (CONS '|Symbol| NIL)))) - (|axAddLiteral| '|string| '|Symbol| '|Literal|) - (CONS '|RestrictTo| - (CONS (CONS '|Apply| - (CONS '|bracket| - (PROG (G166458) - (SPADLET G166458 NIL) - (RETURN - (DO - ((G166463 |args| - (CDR G166463)) - (|a| NIL)) - ((OR (ATOM G166463) - (PROGN - (SETQ |a| - (CAR G166463)) - NIL)) - (NREVERSE0 G166458)) - (SEQ - (EXIT - (SETQ G166458 - (CONS - (|axFormatType| |a|) - G166458))))))))) - (CONS (CONS '|Apply| - (CONS '|List| - (CONS '|Symbol| NIL))) - NIL)))) - ((AND (PAIRP |typeform|) (EQ (QCDR |typeform|) NIL) - (PROGN (SPADLET |op| (QCAR |typeform|)) 'T)) - (COND - ((BOOT-EQUAL |op| '$) '%) - ((BOOT-EQUAL |op| '|Void|) (CONS '|Comma| NIL)) - ('T |op|))) - ((AND (PAIRP |typeform|) (EQ (QCAR |typeform|) '|local|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |typeform|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |val| (QCAR |ISTMP#1|)) 'T)))) - (|axFormatType| |val|)) - ((AND (PAIRP |typeform|) (EQ (QCAR |typeform|) 'QUOTE) - (PROGN - (SPADLET |ISTMP#1| (QCDR |typeform|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |val| (QCAR |ISTMP#1|)) 'T)))) - (|axFormatType| |val|)) - ((AND (PAIRP |typeform|) (EQ (QCAR |typeform|) '|Join|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |typeform|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) - 'T) - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |lastcat| (QCAR |ISTMP#2|)) - (SPADLET |cats| (QCDR |ISTMP#2|)) - 'T) - (PROGN - (SPADLET |cats| (NREVERSE |cats|)) - 'T)))) - (COND - ((AND (PAIRP |lastcat|) (EQ (QCAR |lastcat|) 'CATEGORY) - (PROGN - (SPADLET |ISTMP#1| (QCDR |lastcat|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |type| (QCAR |ISTMP#1|)) - (SPADLET |ops| (QCDR |ISTMP#1|)) - 'T)))) - (CONS '|With| - (CONS NIL - (CONS (|makeTypeSequence| - (APPEND - (PROG (G166473) - (SPADLET G166473 NIL) - (RETURN - (DO - ((G166478 |cats| - (CDR G166478)) - (|c| NIL)) - ((OR (ATOM G166478) - (PROGN - (SETQ |c| - (CAR G166478)) - NIL)) - (NREVERSE0 G166473)) - (SEQ - (EXIT - (SETQ G166473 - (CONS - (|axFormatType| |c|) - G166473))))))) - (PROG (G166488) - (SPADLET G166488 NIL) - (RETURN - (DO - ((G166493 |ops| - (CDR G166493)) - (|op| NIL)) - ((OR (ATOM G166493) - (PROGN - (SETQ |op| - (CAR G166493)) - NIL)) - (NREVERSE0 G166488)) - (SEQ - (EXIT - (SETQ G166488 - (CONS (|axFormatOp| |op|) - G166488))))))))) - NIL)))) - ('T - (CONS '|With| - (CONS NIL - (CONS (|makeTypeSequence| - (PROG (G166503) - (SPADLET G166503 NIL) - (RETURN - (DO - ((G166508 (CDR |typeform|) - (CDR G166508)) - (|c| NIL)) - ((OR (ATOM G166508) - (PROGN - (SETQ |c| (CAR G166508)) - NIL)) - (NREVERSE0 G166503)) - (SEQ - (EXIT - (SETQ G166503 - (CONS (|axFormatType| |c|) - G166503)))))))) - NIL)))))) - ((AND (PAIRP |typeform|) (EQ (QCAR |typeform|) 'CATEGORY) - (PROGN - (SPADLET |ISTMP#1| (QCDR |typeform|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |type| (QCAR |ISTMP#1|)) - (SPADLET |ops| (QCDR |ISTMP#1|)) - 'T)))) - (CONS '|With| - (CONS NIL (CONS (|axFormatOpList| |ops|) NIL)))) - ((AND (PAIRP |typeform|) (EQ (QCAR |typeform|) '|Mapping|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |typeform|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |target| (QCAR |ISTMP#1|)) - (SPADLET |argtypes| (QCDR |ISTMP#1|)) - 'T)))) - (CONS '|Apply| - (CONS '-> - (CONS (CONS '|Comma| - (PROG (G166518) - (SPADLET G166518 NIL) - (RETURN - (DO - ((G166523 |argtypes| - (CDR G166523)) - (|t| NIL)) - ((OR (ATOM G166523) - (PROGN - (SETQ |t| - (CAR G166523)) - NIL)) - (NREVERSE0 G166518)) - (SEQ - (EXIT - (SETQ G166518 - (CONS - (|axFormatType| |t|) - G166518)))))))) - (CONS (|axFormatType| |target|) NIL))))) - ((AND (PAIRP |typeform|) (EQ (QCAR |typeform|) '|:|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |typeform|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |name| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |type| (QCAR |ISTMP#2|)) - 'T)))))) - (|axFormatDecl| |name| |type|)) - ((AND (PAIRP |typeform|) (EQ (QCAR |typeform|) '|Union|) - (PROGN (SPADLET |args| (QCDR |typeform|)) 'T)) - (COND - ((PROGN - (SPADLET |ISTMP#1| (CAR |args|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) '|:|) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL))))))) - (CONS '|Apply| - (CONS '|Union| - (PROG (G166533) - (SPADLET G166533 NIL) - (RETURN - (DO ((G166538 |args| - (CDR G166538)) - (|a| NIL)) - ((OR (ATOM G166538) - (PROGN - (SETQ |a| (CAR G166538)) - NIL)) - (NREVERSE0 G166533)) - (SEQ - (EXIT - (SETQ G166533 - (CONS (|axFormatType| |a|) - G166533)))))))))) - ('T (SPADLET |taglist| NIL) (SPADLET |valueCount| 0) - (DO ((G166553 |args| (CDR G166553)) (|x| NIL)) - ((OR (ATOM G166553) - (PROGN (SETQ |x| (CAR G166553)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |tag| - (COND - ((STRINGP |x|) (INTERN |x|)) - ((AND (PAIRP |x|) - (EQ (QCAR |x|) 'QUOTE) - (PROGN - (SPADLET |ISTMP#1| - (QCDR |x|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) - NIL) - (PROGN - (SPADLET |val| - (QCAR |ISTMP#1|)) - 'T))) - (STRINGP |val|)) - (INTERN |val|)) - ('T - (SPADLET |valueCount| - (PLUS |valueCount| 1)) - (INTERNL '|value| - (STRINGIMAGE |valueCount|))))) - (SPADLET |taglist| - (CONS |tag| |taglist|)))))) - (CONS '|Apply| - (CONS '|Union| - (PROG (G166564) - (SPADLET G166564 NIL) - (RETURN - (DO ((G166570 (REVERSE |taglist|) - (CDR G166570)) - (|name| NIL) - (G166571 |args| - (CDR G166571)) - (|type| NIL)) - ((OR (ATOM G166570) - (PROGN - (SETQ |name| (CAR G166570)) - NIL) - (ATOM G166571) - (PROGN - (SETQ |type| (CAR G166571)) - NIL)) - (NREVERSE0 G166564)) - (SEQ - (EXIT - (SETQ G166564 - (CONS - (|axFormatDecl| |name| |type|) - G166564)))))))))))) - ((AND (PAIRP |typeform|) - (EQ (QCAR |typeform|) '|Dictionary|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |typeform|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) '|Record|) - (PROGN - (SPADLET |args| (QCDR |ISTMP#2|)) - 'T)))))) - (CONS '|Apply| - (CONS '|Dictionary| - (CONS (CONS '|PretendTo| - (CONS - (|axFormatType| - (CADR |typeform|)) - (CONS '|SetCategory| NIL))) - NIL)))) - ((AND (PAIRP |typeform|) - (EQ (QCAR |typeform|) '|FileCategory|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |typeform|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |xx| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (EQ (QCAR |ISTMP#3|) '|Record|) - (PROGN - (SPADLET |args| (QCDR |ISTMP#3|)) - 'T)))))))) - (CONS '|Apply| - (CONS '|FileCategory| - (CONS (|axFormatType| |xx|) - (CONS (CONS '|PretendTo| - (CONS - (|axFormatType| - (CADDR |typeform|)) - (CONS '|SetCategory| NIL))) - NIL))))) - ((AND (PAIRP |typeform|) - (PROGN - (SPADLET |op| (QCAR |typeform|)) - (SPADLET |args| (QCDR |typeform|)) - 'T)) - (COND - ((AND |$pretendFlag| (|constructor?| |op|) - (PROGN - (SPADLET |ISTMP#1| - (GETDATABASE |op| 'CONSTRUCTORMODEMAP)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |ISTMP#3| - (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (PROGN - (SPADLET |target| - (QCAR |ISTMP#3|)) - (SPADLET |argtypes| - (QCDR |ISTMP#3|)) - 'T))))) - (PROGN - (SPADLET |ISTMP#4| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#4|) - (EQ (QCDR |ISTMP#4|) NIL)))))) - (CONS '|Apply| - (CONS |op| - (PROG (G166585) - (SPADLET G166585 NIL) - (RETURN - (DO ((G166591 |args| - (CDR G166591)) - (|a| NIL) - (G166592 |argtypes| - (CDR G166592)) - (|t| NIL)) - ((OR (ATOM G166591) - (PROGN - (SETQ |a| (CAR G166591)) - NIL) - (ATOM G166592) - (PROGN - (SETQ |t| (CAR G166592)) - NIL)) - (NREVERSE0 G166585)) - (SEQ - (EXIT - (SETQ G166585 - (CONS - (CONS '|PretendTo| - (CONS (|axFormatType| |a|) - (CONS (|axFormatType| |t|) - NIL))) - G166585)))))))))) - ((AND (member |op| - '(|SquareMatrix| |SquareMatrixCategory| - |DirectProduct| - |DirectProductCategory| - |RadixExpansion|)) - (PROGN - (SPADLET |ISTMP#1| - (GETDATABASE |op| 'CONSTRUCTORMODEMAP)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |ISTMP#3| - (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (PROGN - (SPADLET |target| - (QCAR |ISTMP#3|)) - (SPADLET |ISTMP#4| - (QCDR |ISTMP#3|)) - (AND (PAIRP |ISTMP#4|) - (PROGN - (SPADLET |arg1type| - (QCAR |ISTMP#4|)) - (SPADLET |restargs| - (QCDR |ISTMP#4|)) - 'T))))))) - (PROGN - (SPADLET |ISTMP#5| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#5|) - (EQ (QCDR |ISTMP#5|) NIL)))))) - (CONS '|Apply| - (CONS |op| - (CONS (CONS '|PretendTo| - (CONS (|axFormatType| (CAR |args|)) - (CONS (|axFormatType| |arg1type|) - NIL))) - (PROG (G166605) - (SPADLET G166605 NIL) - (RETURN - (DO - ((G166610 (CDR |args|) - (CDR G166610)) - (|a| NIL)) - ((OR (ATOM G166610) - (PROGN - (SETQ |a| (CAR G166610)) - NIL)) - (NREVERSE0 G166605)) - (SEQ - (EXIT - (SETQ G166605 - (CONS (|axFormatType| |a|) - G166605))))))))))) - ('T - (CONS '|Apply| - (CONS |op| - (PROG (G166620) - (SPADLET G166620 NIL) - (RETURN - (DO ((G166625 |args| - (CDR G166625)) - (|a| NIL)) - ((OR (ATOM G166625) - (PROGN - (SETQ |a| (CAR G166625)) - NIL)) - (NREVERSE0 G166620)) - (SEQ - (EXIT - (SETQ G166620 - (CONS (|axFormatType| |a|) - G166620)))))))))))) - ('T (|error| '|unknown entry type|))))))) - -;axFormatOpList ops == ['Sequence,:[axFormatOp o for o in ops]] - -(DEFUN |axFormatOpList| (|ops|) - (PROG () - (RETURN - (SEQ (CONS '|Sequence| - (PROG (G166707) - (SPADLET G166707 NIL) - (RETURN - (DO ((G166712 |ops| (CDR G166712)) (|o| NIL)) - ((OR (ATOM G166712) - (PROGN (SETQ |o| (CAR G166712)) NIL)) - (NREVERSE0 G166707)) - (SEQ (EXIT (SETQ G166707 - (CONS (|axFormatOp| |o|) - G166707)))))))))))) - -;axOpTran(name) == -; ATOM name => -; name = 'elt => 'apply -; name = 'setelt => 'set! -; name = 'SEGMENT => ".." -; name = 1 => '_1 -; name = 0 => '_0 -; name -; opOf name = 'Zero => '_0 -; opOf name = 'One => '_1 -; error "bad op name" - -(DEFUN |axOpTran| (|name|) - (COND - ((ATOM |name|) - (COND - ((BOOT-EQUAL |name| '|elt|) '|apply|) - ((BOOT-EQUAL |name| '|setelt|) '|set!|) - ((BOOT-EQUAL |name| 'SEGMENT) (INTERN ".." "BOOT")) - ((EQL |name| 1) '|1|) - ((EQL |name| 0) '|0|) - ('T |name|))) - ((BOOT-EQUAL (|opOf| |name|) '|Zero|) '|0|) - ((BOOT-EQUAL (|opOf| |name|) '|One|) '|1|) - ('T (|error| '|bad op name|)))) - -;axFormatOpSig(name, [result,:argtypes]) == -; ['Declare, axOpTran name, -; ['Apply, "->", ['Comma, :[axFormatType t for t in argtypes]], -; axFormatType result]] - -(DEFUN |axFormatOpSig| (|name| G166727) - (PROG (|result| |argtypes|) - (RETURN - (SEQ (PROGN - (SPADLET |result| (CAR G166727)) - (SPADLET |argtypes| (CDR G166727)) - (CONS '|Declare| - (CONS (|axOpTran| |name|) - (CONS (CONS '|Apply| - (CONS '-> - (CONS - (CONS '|Comma| - (PROG (G166740) - (SPADLET G166740 NIL) - (RETURN - (DO - ((G166745 |argtypes| - (CDR G166745)) - (|t| NIL)) - ((OR (ATOM G166745) - (PROGN - (SETQ |t| - (CAR G166745)) - NIL)) - (NREVERSE0 G166740)) - (SEQ - (EXIT - (SETQ G166740 - (CONS - (|axFormatType| |t|) - G166740)))))))) - (CONS (|axFormatType| |result|) - NIL)))) - NIL)))))))) - -;axFormatConstantOp(name, [result]) == -; ['Declare, axOpTran name, axFormatType result] - -(DEFUN |axFormatConstantOp| (|name| G166757) - (PROG (|result|) - (RETURN - (PROGN - (SPADLET |result| (CAR G166757)) - (CONS '|Declare| - (CONS (|axOpTran| |name|) - (CONS (|axFormatType| |result|) NIL))))))) - -;axFormatPred pred == -; atom pred => pred -; [op,:args] := pred -; op = 'IF => axFormatOp pred -; op = 'has => -; [name,type] := args -; if name = '$ then name := '% -; else name := axFormatOp name -; ftype := axFormatOp type -; if ftype is ['Declare,:.] then -; ftype := ['With, [], ftype] -; ['Test,['Has,name, ftype]] -; axArglist := [axFormatPred arg for arg in args] -; op = 'AND => ['And,:axArglist] -; op = 'OR => ['Or,:axArglist] -; op = 'NOT => ['Not,:axArglist] -; error "unknown predicate" - -(DEFUN |axFormatPred| (|pred|) - (PROG (|op| |args| |type| |name| |ftype| |axArglist|) - (RETURN - (SEQ (COND - ((ATOM |pred|) |pred|) - ('T (SPADLET |op| (CAR |pred|)) - (SPADLET |args| (CDR |pred|)) - (COND - ((BOOT-EQUAL |op| 'IF) (|axFormatOp| |pred|)) - ((BOOT-EQUAL |op| '|has|) (SPADLET |name| (CAR |args|)) - (SPADLET |type| (CADR |args|)) - (COND - ((BOOT-EQUAL |name| '$) (SPADLET |name| '%)) - ('T (SPADLET |name| (|axFormatOp| |name|)))) - (SPADLET |ftype| (|axFormatOp| |type|)) - (COND - ((AND (PAIRP |ftype|) - (EQ (QCAR |ftype|) '|Declare|)) - (SPADLET |ftype| - (CONS '|With| - (CONS NIL (CONS |ftype| NIL)))))) - (CONS '|Test| - (CONS (CONS '|Has| - (CONS |name| (CONS |ftype| NIL))) - NIL))) - ('T - (SPADLET |axArglist| - (PROG (G166780) - (SPADLET G166780 NIL) - (RETURN - (DO ((G166785 |args| (CDR G166785)) - (|arg| NIL)) - ((OR (ATOM G166785) - (PROGN - (SETQ |arg| (CAR G166785)) - NIL)) - (NREVERSE0 G166780)) - (SEQ (EXIT - (SETQ G166780 - (CONS (|axFormatPred| |arg|) - G166780)))))))) - (COND - ((BOOT-EQUAL |op| 'AND) (CONS '|And| |axArglist|)) - ((BOOT-EQUAL |op| 'OR) (CONS '|Or| |axArglist|)) - ((BOOT-EQUAL |op| 'NOT) (CONS '|Not| |axArglist|)) - ('T (|error| '|unknown predicate|))))))))))) - -;axFormatCondOp op == -; $pretendFlag:local := true -; axFormatOp op - -(DEFUN |axFormatCondOp| (|op|) - (PROG (|$pretendFlag|) - (DECLARE (SPECIAL |$pretendFlag|)) - (RETURN (PROGN (SPADLET |$pretendFlag| 'T) (|axFormatOp| |op|))))) - -;axFormatOp op == -; op is ['IF, pred, trueops, falseops] => -; NULL(trueops) or trueops='noBranch => -; ['If, ['Test,['Not, axFormatPred pred]], -; axFormatCondOp falseops, -; axFormatCondOp trueops] -; ['If, axFormatPred pred, -; axFormatCondOp trueops, -; axFormatCondOp falseops] -; -- ops are either single op or ['PROGN, ops] -; op is ['SIGNATURE, name, type] => axFormatOpSig(name,type) -; op is ['SIGNATURE, name, type, 'constant] => -; axFormatConstantOp(name,type) -; op is ['ATTRIBUTE, attributeOrCategory] => -; categoryForm? attributeOrCategory => -; axFormatType attributeOrCategory -; ['RestrictTo, axFormatAttrib attributeOrCategory, 'Category] -; op is ['PROGN, :ops] => axFormatOpList ops -; op is 'noBranch => [] -; axFormatType op - -(DEFUN |axFormatOp| (|op|) - (PROG (|pred| |trueops| |falseops| |name| |ISTMP#2| |type| |ISTMP#3| - |ISTMP#1| |attributeOrCategory| |ops|) - (RETURN - (COND - ((AND (PAIRP |op|) (EQ (QCAR |op|) 'IF) - (PROGN - (SPADLET |ISTMP#1| (QCDR |op|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |pred| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |trueops| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN - (SPADLET |falseops| - (QCAR |ISTMP#3|)) - 'T)))))))) - (COND - ((OR (NULL |trueops|) (BOOT-EQUAL |trueops| '|noBranch|)) - (CONS '|If| - (CONS (CONS '|Test| - (CONS (CONS '|Not| - (CONS (|axFormatPred| |pred|) NIL)) - NIL)) - (CONS (|axFormatCondOp| |falseops|) - (CONS (|axFormatCondOp| |trueops|) NIL))))) - ('T - (CONS '|If| - (CONS (|axFormatPred| |pred|) - (CONS (|axFormatCondOp| |trueops|) - (CONS (|axFormatCondOp| |falseops|) NIL))))))) - ((AND (PAIRP |op|) (EQ (QCAR |op|) 'SIGNATURE) - (PROGN - (SPADLET |ISTMP#1| (QCDR |op|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |name| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |type| (QCAR |ISTMP#2|)) - 'T)))))) - (|axFormatOpSig| |name| |type|)) - ((AND (PAIRP |op|) (EQ (QCAR |op|) 'SIGNATURE) - (PROGN - (SPADLET |ISTMP#1| (QCDR |op|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |name| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |type| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (EQ (QCAR |ISTMP#3|) '|constant|)))))))) - (|axFormatConstantOp| |name| |type|)) - ((AND (PAIRP |op|) (EQ (QCAR |op|) 'ATTRIBUTE) - (PROGN - (SPADLET |ISTMP#1| (QCDR |op|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |attributeOrCategory| (QCAR |ISTMP#1|)) - 'T)))) - (COND - ((|categoryForm?| |attributeOrCategory|) - (|axFormatType| |attributeOrCategory|)) - ('T - (CONS '|RestrictTo| - (CONS (|axFormatAttrib| |attributeOrCategory|) - (CONS '|Category| NIL)))))) - ((AND (PAIRP |op|) (EQ (QCAR |op|) 'PROGN) - (PROGN (SPADLET |ops| (QCDR |op|)) 'T)) - (|axFormatOpList| |ops|)) - ((EQ |op| '|noBranch|) NIL) - ('T (|axFormatType| |op|)))))) - -;addDefaults(catname, withform) == -; withform isnt ['With, joins, ['Sequence,: oplist]] => -; error "bad category body" -; null(defaults := getDefaultingOps catname) => withform -; defaultdefs := [makeDefaultDef(decl) for decl in defaults] -; ['With, joins, -; ['Sequence, :oplist, ['Default, ['Sequence,: defaultdefs]]]] - -(DEFUN |addDefaults| (|catname| |withform|) - (PROG (|ISTMP#1| |joins| |ISTMP#2| |ISTMP#3| |oplist| |defaults| - |defaultdefs|) - (RETURN - (SEQ (COND - ((NULL (AND (PAIRP |withform|) - (EQ (QCAR |withform|) '|With|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |withform|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |joins| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |ISTMP#3| - (QCAR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (EQ (QCAR |ISTMP#3|) - '|Sequence|) - (PROGN - (SPADLET |oplist| - (QCDR |ISTMP#3|)) - 'T))))))))) - (|error| '|bad category body|)) - ((NULL (SPADLET |defaults| (|getDefaultingOps| |catname|))) - |withform|) - ('T - (SPADLET |defaultdefs| - (PROG (G166944) - (SPADLET G166944 NIL) - (RETURN - (DO ((G166949 |defaults| (CDR G166949)) - (|decl| NIL)) - ((OR (ATOM G166949) - (PROGN - (SETQ |decl| (CAR G166949)) - NIL)) - (NREVERSE0 G166944)) - (SEQ (EXIT (SETQ G166944 - (CONS - (|makeDefaultDef| |decl|) - G166944)))))))) - (CONS '|With| - (CONS |joins| - (CONS (CONS '|Sequence| - (APPEND |oplist| - (CONS - (CONS '|Default| - (CONS - (CONS '|Sequence| - |defaultdefs|) - NIL)) - NIL))) - NIL))))))))) - -;makeDefaultDef(decl) == -; decl isnt ['Declare, op, type] => -; error "bad default definition" -; $defaultFlag := true -; type is ['Apply, "->", args, result] => -; ['Define, decl, ['Lambda, makeDefaultArgs args, result, -; ['Label, op, 'dummyDefault]]] -; ['Define, ['Declare, op, type], 'dummyDefault] - -(DEFUN |makeDefaultDef| (|decl|) - (PROG (|op| |type| |ISTMP#1| |ISTMP#2| |args| |ISTMP#3| |result|) - (declare (special |$defaultFlag|)) - (RETURN - (COND - ((NULL (AND (PAIRP |decl|) (EQ (QCAR |decl|) '|Declare|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |decl|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |op| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |type| (QCAR |ISTMP#2|)) - 'T))))))) - (|error| '|bad default definition|)) - ('T (SPADLET |$defaultFlag| 'T) - (COND - ((AND (PAIRP |type|) (EQ (QCAR |type|) '|Apply|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |type|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) '->) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |args| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN - (SPADLET |result| - (QCAR |ISTMP#3|)) - 'T)))))))) - (CONS '|Define| - (CONS |decl| - (CONS (CONS '|Lambda| - (CONS (|makeDefaultArgs| |args|) - (CONS |result| - (CONS - (CONS '|Label| - (CONS |op| - (CONS '|dummyDefault| NIL))) - NIL)))) - NIL)))) - ('T - (CONS '|Define| - (CONS (CONS '|Declare| (CONS |op| (CONS |type| NIL))) - (CONS '|dummyDefault| NIL)))))))))) - -;makeDefaultArgs args == -; args isnt ['Comma,:argl] => error "bad default argument list" -; ['Comma,: [['Declare,v,t] for v in $TriangleVariableList for t in argl]] - -(DEFUN |makeDefaultArgs| (|args|) - (PROG (|argl|) - (declare (special |$TriangleVariableList|)) - (RETURN - (SEQ (COND - ((NULL (AND (PAIRP |args|) (EQ (QCAR |args|) '|Comma|) - (PROGN (SPADLET |argl| (QCDR |args|)) 'T))) - (|error| '|bad default argument list|)) - ('T - (CONS '|Comma| - (PROG (G167027) - (SPADLET G167027 NIL) - (RETURN - (DO ((G167033 |$TriangleVariableList| - (CDR G167033)) - (|v| NIL) - (G167034 |argl| (CDR G167034)) - (|t| NIL)) - ((OR (ATOM G167033) - (PROGN - (SETQ |v| (CAR G167033)) - NIL) - (ATOM G167034) - (PROGN - (SETQ |t| (CAR G167034)) - NIL)) - (NREVERSE0 G167027)) - (SEQ (EXIT (SETQ G167027 - (CONS - (CONS '|Declare| - (CONS |v| (CONS |t| NIL))) - G167027)))))))))))))) - -;getDefaultingOps catname == -; not(name:=hasDefaultPackage catname) => nil -; $infovec: local := getInfovec name -; opTable := $infovec.1 -; $opList:local := nil -; for i in 0..MAXINDEX opTable repeat -; op := opTable.i -; i := i + 1 -; startIndex := opTable.i -; stopIndex := -; i + 1 > MAXINDEX opTable => MAXINDEX getCodeVector() -; opTable.(i + 2) -; curIndex := startIndex -; while curIndex < stopIndex repeat -; curIndex := get1defaultOp(op,curIndex) -; $pretendFlag : local := true -; catops := GETDATABASE(catname, 'OPERATIONALIST) -; [axFormatDefaultOpSig(op,sig,catops) for opsig in $opList | opsig is [op,sig]] - -(DEFUN |getDefaultingOps| (|catname|) - (PROG (|$infovec| |$opList| |$pretendFlag| |name| |opTable| - |startIndex| |stopIndex| |curIndex| |catops| |op| |ISTMP#1| - |sig|) - (DECLARE (SPECIAL |$infovec| |$opList| |$pretendFlag|)) - (RETURN - (SEQ (COND - ((NULL (SPADLET |name| (|hasDefaultPackage| |catname|))) - NIL) - ('T (SPADLET |$infovec| (|getInfovec| |name|)) - (SPADLET |opTable| (ELT |$infovec| 1)) - (SPADLET |$opList| NIL) - (DO ((G167069 (MAXINDEX |opTable|)) - (|i| 0 (QSADD1 |i|))) - ((QSGREATERP |i| G167069) NIL) - (SEQ (EXIT (PROGN - (SPADLET |op| (ELT |opTable| |i|)) - (SPADLET |i| (PLUS |i| 1)) - (SPADLET |startIndex| (ELT |opTable| |i|)) - (SPADLET |stopIndex| - (COND - ((> (PLUS |i| 1) - (MAXINDEX |opTable|)) - (MAXINDEX (|getCodeVector|))) - ('T - (ELT |opTable| (PLUS |i| 2))))) - (SPADLET |curIndex| |startIndex|) - (DO () - ((NULL (> |stopIndex| |curIndex|)) - NIL) - (SEQ (EXIT - (SPADLET |curIndex| - (|get1defaultOp| |op| |curIndex|))))))))) - (SPADLET |$pretendFlag| 'T) - (SPADLET |catops| - (GETDATABASE |catname| 'OPERATIONALIST)) - (PROG (G167084) - (SPADLET G167084 NIL) - (RETURN - (DO ((G167090 |$opList| (CDR G167090)) - (|opsig| NIL)) - ((OR (ATOM G167090) - (PROGN (SETQ |opsig| (CAR G167090)) NIL)) - (NREVERSE0 G167084)) - (SEQ (EXIT (COND - ((AND (PAIRP |opsig|) - (PROGN - (SPADLET |op| (QCAR |opsig|)) - (SPADLET |ISTMP#1| - (QCDR |opsig|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |sig| - (QCAR |ISTMP#1|)) - 'T)))) - (SETQ G167084 - (CONS - (|axFormatDefaultOpSig| |op| - |sig| |catops|) - G167084))))))))))))))) - -;axFormatDefaultOpSig(op, sig, catops) == -; #sig > 1 => axFormatOpSig(op,sig) -; nsig := MSUBST('$,'($), sig) -- dcSig listifies '$ ?? -; (catsigs := LASSOC(op, catops)) and -; (catsig := assoc(nsig, catsigs)) and last(catsig) = 'CONST => -; axFormatConstantOp(op, sig) -; axFormatOpSig(op,sig) - -(DEFUN |axFormatDefaultOpSig| (|op| |sig| |catops|) - (PROG (|nsig| |catsigs| |catsig|) - (RETURN - (COND - ((> (|#| |sig|) 1) (|axFormatOpSig| |op| |sig|)) - ('T (SPADLET |nsig| (MSUBST '$ '($) |sig|)) - (COND - ((AND (SPADLET |catsigs| (LASSOC |op| |catops|)) - (SPADLET |catsig| (|assoc| |nsig| |catsigs|)) - (BOOT-EQUAL (|last| |catsig|) 'CONST)) - (|axFormatConstantOp| |op| |sig|)) - ('T (|axFormatOpSig| |op| |sig|)))))))) - -;get1defaultOp(op,index) == -; numvec := getCodeVector() -; segment := getOpSegment index -; numOfArgs := numvec.index -; index := index + 1 -; predNumber := numvec.index -; index := index + 1 -; signumList := -; -- following substitution fixes the problem that default packages -; -- have $ added as a first arg, thus other arg counts are off by 1. -; SUBLISLIS($FormalMapVariableList, rest $FormalMapVariableList, -; dcSig(numvec,index,numOfArgs)) -; index := index + numOfArgs + 1 -; slotNumber := numvec.index -; if not([op,signumList] in $opList) then -; $opList := [[op,signumList],:$opList] -; index + 1 - -(DEFUN |get1defaultOp| (|op| |index|) - (PROG (|numvec| |segment| |numOfArgs| |predNumber| |signumList| - |slotNumber|) - (declare (special |$opList| |$FormalMapVariableList|)) - (RETURN - (PROGN - (SPADLET |numvec| (|getCodeVector|)) - (SPADLET |segment| (|getOpSegment| |index|)) - (SPADLET |numOfArgs| (ELT |numvec| |index|)) - (SPADLET |index| (PLUS |index| 1)) - (SPADLET |predNumber| (ELT |numvec| |index|)) - (SPADLET |index| (PLUS |index| 1)) - (SPADLET |signumList| - (SUBLISLIS |$FormalMapVariableList| - (CDR |$FormalMapVariableList|) - (|dcSig| |numvec| |index| |numOfArgs|))) - (SPADLET |index| (PLUS (PLUS |index| |numOfArgs|) 1)) - (SPADLET |slotNumber| (ELT |numvec| |index|)) - (COND - ((NULL (|member| (CONS |op| (CONS |signumList| NIL)) - |$opList|)) - (SPADLET |$opList| - (CONS (CONS |op| (CONS |signumList| NIL)) - |$opList|)))) - (PLUS |index| 1))))) - -;axAddLiteral(name, type, dom) == -; elt := [name, type, dom] -; if not member( elt, $literals) then -; $literals := [elt, :$literals] - -(DEFUN |axAddLiteral| (|name| |type| |dom|) - (PROG (|elt|) - (declare (special |$literals|)) - (RETURN - (PROGN - (SPADLET |elt| (CONS |name| (CONS |type| (CONS |dom| NIL)))) - (COND - ((NULL (|member| |elt| |$literals|)) - (SPADLET |$literals| (CONS |elt| |$literals|))) - ('T NIL)))))) - -;axDoLiterals() == -; [ [ 'Import, -; [ 'With, [], -; ['Declare, name, [ 'Apply, '_-_> , dom , '_% ]]], -; type ] for [name, type, dom] in $literals] - -(DEFUN |axDoLiterals| () - (PROG (|name| |type| |dom|) - (declare (special |$literals|)) - (RETURN - (SEQ (PROG (G167158) - (SPADLET G167158 NIL) - (RETURN - (DO ((G167164 |$literals| (CDR G167164)) - (G167148 NIL)) - ((OR (ATOM G167164) - (PROGN (SETQ G167148 (CAR G167164)) NIL) - (PROGN - (PROGN - (SPADLET |name| (CAR G167148)) - (SPADLET |type| (CADR G167148)) - (SPADLET |dom| (CADDR G167148)) - G167148) - NIL)) - (NREVERSE0 G167158)) - (SEQ (EXIT (SETQ G167158 - (CONS (CONS '|Import| - (CONS - (CONS '|With| - (CONS NIL - (CONS - (CONS '|Declare| - (CONS |name| - (CONS - (CONS '|Apply| - (CONS '-> - (CONS |dom| - (CONS '% NIL)))) - NIL))) - NIL))) - (CONS |type| NIL))) - G167158))))))))))) - -\end{chunk} -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/util.lisp.pamphlet b/src/interp/util.lisp.pamphlet index b2496b4..57ea0fa 100644 --- a/src/interp/util.lisp.pamphlet +++ b/src/interp/util.lisp.pamphlet @@ -152,7 +152,6 @@ After this function is called the image is clean and can be saved. (|setBootAutloadProperties| browse-functions browse-files) (|setBootAutloadProperties| translate-functions translate-files) (|setNAGBootAutloadProperties| nagbr-functions nagbr-files) - (|setBootAutloadProperties| asauto-functions asauto-files) (setf (symbol-function 'boot::|addConsDB|) #'identity) (resethashtables) ; the databases into core, then close the streams ) @@ -572,26 +571,6 @@ from {\bf Spad} code. Frankly, I'd be amazed if it worked. )) \end{chunk} -\subsubsection{asauto-functions} -This is part of the {\bf ALDOR subsystem}. These will be loaded -if you compile a {\bf .as} file rather than a {\bf .spad} file. -{\bf ALDOR} is an external compiler that gets automatically called -if the file extension is {\bf .as}. -\begin{chunk}{asauto-functions} -(setq asauto-functions '( - loadas -;; |as| ;; now in as.boot -;; |astran| ;; now in as.boot - |spad2AxTranslatorAutoloadOnceTrigger| - |sourceFilesToAxcliqueAxFile| - |sourceFilesToAxFile| - |setExtendedDomains| - |makeAxFile| - |makeAxcliqueAxFile| - |nrlibsToAxFile| - |attributesToAxFile| )) - -\end{chunk} \subsubsection{debug-functions} These are some {\bf debugging} functions that I use. I can't imagine why you might autoload them but they don't need to be in a running @@ -1467,7 +1446,6 @@ function assumes that \\ can only appear as first character of name. \getchunk{comp-functions} \getchunk{browse-functions} \getchunk{translate-functions} -\getchunk{asauto-functions} \getchunk{debug-functions} \getchunk{anna-functions} \getchunk{nagbr-functions}