diff --git a/changelog b/changelog index 73a33c3..c07cc93 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20090905 tpd src/axiom-website/patches.html 20090905.02.tpd.patch +20090905 tpd src/interp/ax.lisp fix typo 20090905 tpd src/axiom-website/patches.html 20090905.01.tpd.patch 20090905 tpd src/interp/Makefile move wi2.boot to wi2.lisp 20090905 tpd src/interp/wi2.lisp added, rewritten from wi2.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 5574e85..14c13e1 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1990,5 +1990,7 @@ src/interp/pspad2.lisp rewrite from boot to lisp
src/interp/wi1.lisp rewrite from boot to lisp
20090905.01.tpd.patch src/interp/wi2.lisp rewrite from boot to lisp
+20090905.02.tpd.patch +src/interp/ax.lisp fix typo
diff --git a/src/interp/ax.lisp.pamphlet b/src/interp/ax.lisp.pamphlet new file mode 100644 index 0000000..4dde17b --- /dev/null +++ b/src/interp/ax.lisp.pamphlet @@ -0,0 +1,2250 @@ +\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} +<<*>>= +;$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))) + ((MEMQ |typeform| |$TriangleVariableList|) + (SUBLISLIS |$FormalMapVariableList| + |$TriangleVariableList| |typeform|)) + ((MEMQ |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 (MEMQ |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))))))))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}