diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index cfd3113..b5885a9 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -47812,7 +47812,7 @@ Given \verb|("one" "two" "three")| generate \verb|"(one,two,three)"| G166783) nil)) nil) - (SEQ (EXIT (setq z (MSUBST replace pvar z))))) + (SEQ (EXIT (setq z (subst replace pvar z :test #'equal))))) z))))) \end{chunk} @@ -50993,7 +50993,6 @@ There are 8 parts of an htPage: \calls{dbSearchOrder}{simpCatPredicate} \calls{dbSearchOrder}{sublislis} \calls{dbSearchOrder}{kTestPred} -\calls{dbSearchOrder}{msubst} \calls{dbSearchOrder}{devaluate} \calls{dbSearchOrder}{kFormatSlotDomain} \calls{dbSearchOrder}{dbSubConform} @@ -51029,7 +51028,7 @@ There are 8 parts of an htPage: (|kTestPred| (elt catpredvec i)))) (if |$domain| (eval p) p)))) (when (and domname (contained '$ pred)) - (setq pred (msubst domname '$ pred))) + (setq pred (subst domname '$ pred :test #'equal))) (and (setq pak (elt catinfo i)) pred)) (setq t1 (cons @@ -51041,7 +51040,7 @@ There are 8 parts of an htPage: (setq catform (|kFormatSlotDomain| (elt catvec i))) (setq res (|dbSubConform| (cdr conform) (cons pak (cons '$ (cdr catform))))) - (when domname (setq res (msubst domname '$ res))) + (when domname (setq res (subst domname '$ res :test #'equal))) res)) pred) t1)))))) @@ -52616,6 +52615,412 @@ There are 8 parts of an htPage: \end{chunk} +\defun{dbConsHeading}{dbConsHeading} +\calls{dbConsHeading}{htpProperty} +\calls{dbConsHeading}{length} +\calls{dbConsHeading}{remdup} +\calls{dbConsHeading}{stringimage} +\calls{dbConsHeading}{form2HtString} +\calls{dbConsHeading}{capitalize} +\calls{dbConsHeading}{pluralize} +\calls{dbConsHeading}{member} +\calls{dbConsHeading}{nequal} +\usesdollar{dbConsHeading}{exposedOnlyIfTrue} +\begin{chunk}{defun dbConsHeading} +(defun |dbConsHeading| (htPage conlist view kind) + (let (thing place count rank modifier exposureWord firstWord prefix + placepart connective heading) +(declare (special |$exposedOnlyIfTrue|)) + (setq thing (or (and htPage (|htpProperty| htPage '|thing|)) "constructor")) + (setq place + (when htPage + (or (|htpProperty| htPage '|domname|) (|htpProperty| htPage '|conform|)))) + (setq count (|#| (remdup conlist))) + (cond + ((string= thing "benefactor") + (list (stringimage count) " Constructors Used by " + (|form2HtString| place nil t) )) + (t + (setq modifier + (cond + ((string= thing "argument") + (setq rank (and htPage (|htpProperty| htPage '|rank|))) + (list " Possible " rank " ")) + ((eq kind '|constructor|) + (list " ")) + (t + (cons " " (|capitalize| (stringimage kind)) " ")))) + (setq exposureWord (when |$exposedOnlyIfTrue| '(" Exposed "))) + (setq prefix + (cond + ((eql count 1) + (cons (stringimage count) + (append modifier (list (|capitalize| thing))))) + (t + (setq firstWord (if (eql count 0) "No "(stringimage count))) + (cons firstWord + (append exposureWord + (append modifier + (list (|capitalize| (|pluralize| thing))))))))) + (setq placepart + (when place (list " of {\\em " (|form2HtString| place nil t) '}))) + (setq heading (append prefix placepart)) + (setq connective + (if (|member| view '(|abbrs| |files| |kinds|)) " as " " with ")) + (cond + ((and (nequal count 0) + (|member| view '(|abbrs| |files| |parameters| |conditions|))) + (setq heading + (append heading + (list " viewed" connective "{\\em " (stringimage view) "}"))))) + heading)))) + +\end{chunk} + +\defun{dbShowConstructorLines}{dbShowConstructorLines} +\calls{dbShowConstructorLines}{getConstructorForm} +\calls{dbShowConstructorLines}{intern} +\calls{dbShowConstructorLines}{dbName} +\calls{dbShowConstructorLines}{dbShowCons1} +\calls{dbShowConstructorLines}{listSort} +\calls{dbShowConstructorLines}{function} +\calls{dbShowConstructorLines}{glesseqp} +\begin{chunk}{defun dbShowConstructorLines} +(defun |dbShowConstructorLines| (lines) + (let (cAlist) + (setq cAlist + (loop for line in lines + collect (cons (|getConstructorForm| (|intern| (|dbName| line))) t))) + (|dbShowCons1| nil (|listSort| (|function| glesseqp) cAlist) '|names|))) + +\end{chunk} + +\defun{bcUnixTable}{bcUnixTable} +\calls{bcUnixTable}{htSay} +\calls{bcUnixTable}{htBeginTable} +\calls{bcUnixTable}{htSaySaturn} +\calls{bcUnixTable}{namestring} +\calls{bcUnixTable}{findfile} +\calls{bcUnixTable}{stringimage} +\calls{bcUnixTable}{htMakePage} +\calls{bcUnixTable}{htEndTable} +\begin{chunk}{defun bcUnixTable} +(defun |bcUnixTable| (u) + (let (firstTime filename) + (|htSay| "\\newline") + (|htBeginTable|) + (setq firstTime t) + (loop for x in u do + (if firstTime (setq firstTime nil) (|htSaySaturn| "&")) + (|htSay| "{") + (setq filename (namestring ($findfile (stringimage x) "SPAD"))) + (|htMakePage| + (list + (list '|text| "\\unixcommand{" (pathname-name x) + "}{$AXIOM/lib/SPADEDIT " filename "} "))) + (|htSay| "}")) + (|htEndTable|))) + +\end{chunk} + +\subsection{Special Code for Union, Mapping, and Record} + +\defun{dbSpecialDescription}{dbSpecialDescription} +\calls{dbSpecialDescription}{getConstructorForm} +\calls{dbSpecialDescription}{form2HtString} +\calls{dbSpecialDescription}{htInitPage} +\calls{dbSpecialDescription}{htpSetProperty} +\calls{dbSpecialDescription}{dbShowConsDoc1} +\calls{dbSpecialDescription}{htShowPage} +\usesdollar{dbSpecialDescription}{conformsAreDomains} +\begin{chunk}{defun dbSpecialDescription} +(defun |dbSpecialDescription| (conname) + (let (conform heading page) + (declare (special |$conformsAreDomains|)) + (setq conform (|getConstructorForm| conname)) + (setq heading + (list "Description of Domain {\\sf " (|form2HtString| conform) "}")) + (setq page (|htInitPage| heading nil)) + (|htpSetProperty| page '|conname| conname) + (setq |$conformsAreDomains| nil) + (|dbShowConsDoc1| page conform nil) + (|htShowPage|))) + +\end{chunk} + +\defun{dbSpecialOperations}{dbSpecialOperations} +\calls{dbSpecialOperations}{htInitPage} +\calls{dbSpecialOperations}{getConstructorForm} +\calls{dbSpecialOperations}{dbSpecialExpandIfNecessary} +\calls{dbSpecialOperations}{getl} +\calls{dbSpecialOperations}{form2HtString} +\calls{dbSpecialOperations}{htpSetProperty} +\calls{dbSpecialOperations}{dbShowOp1} +\begin{chunk}{defun dbSpecialOperations} +(defun |dbSpecialOperations| (conname) + (let (page conform opAlist fromHeading) + (setq page (|htInitPage| nil nil)) + (setq conform (|getConstructorForm| conname)) + (setq opAlist + (|dbSpecialExpandIfNecessary| conform + (cdr (getl conname '|documentation|)))) + (setq fromHeading (list " from domain {\\sf " (|form2HtString| conform) "}")) + (|htpSetProperty| page '|fromHeading| fromHeading) + (|htpSetProperty| page '|conform| conform) + (|htpSetProperty| page '|opAlist| opAlist) + (|htpSetProperty| page '|noUsage| t) + (|htpSetProperty| page '|condition?| '|no|) + (|dbShowOp1| page opAlist "operation" '|names|))) + +\end{chunk} + +\defun{dbSpecialExports}{dbSpecialExports} +\calls{dbSpecialExports}{getConstructorForm} +\calls{dbSpecialExports}{htInitPage} +\calls{dbSpecialExports}{form2HtString} +\calls{dbSpecialExports}{dbSpecialExpandIfNecessary} +\calls{dbSpecialExports}{getl} +\calls{dbSpecialExports}{kePageDisplay} +\calls{dbSpecialExports}{htShowPage} +\begin{chunk}{defun dbSpecialExports} +(defun |dbSpecialExports| (conname) + (let (conform page opAlist) + (setq conform (|getConstructorForm| conname)) + (setq page + (|htInitPage| (list "Exports of {\\sf " (|form2HtString| conform) "}"))) + (setq opAlist + (|dbSpecialExpandIfNecessary| conform + (cdr (getl conname '|documentation|)))) + (|kePageDisplay| page "operation" opAlist) + (|htShowPage|))) + +\end{chunk} + +\defun{dbSpecialExpandIfNecessary}{dbSpecialExpandIfNecessary} +\calls{dbSpecialExpandIfNecessary}{qcar} +\calls{dbSpecialExpandIfNecessary}{qcdar} +\calls{dbSpecialExpandIfNecessary}{qcadar} +\calls{dbSpecialExpandIfNecessary}{qcdr} +\begin{chunk}{defun dbSpecialExpandIfNecessary} +(defun |dbSpecialExpandIfNecessary| (conform opAlist) + (if (and (consp opAlist) (consp (qcar opAlist)) (consp (qcdar opAlist)) + (consp (qcadar opAlist)) (cdr (qcdr (qcadar opAlist)))) + opAlist + (dolist (item opAlist) + (dolist (pair (cdr item)) + (rplacd pair (list t conform t (second pair)))))) + opAlist) + +\end{chunk} + +\begin{chunk}{initvars} +(defvar message1 (concatenate 'string + "{\\sf Record(a:A,b:B)} is used to create the class of pairs of objects " + "made up of a value of type {\\em A} selected by the symbol {\\em a} and " + "a value of type {\\em B} selected by the symbol {\\em b}. " + "In general, the {\\sf Record} constructor can take any number of arguments " + "and thus can be used to create aggregates of heterogeneous components of " + "arbitrary size selectable by name. " + "{\\sf Record} is a primitive domain of Axiom which cannot be " + "defined in the Axiom language.")) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) +(put '|Record| '|documentation| + (subst message1 'message + `((|constructor| (nil message)) + (= (((|Boolean|) $ $) + "\\spad{r = s} tests for equality of two records \\spad{r} and \\spad{s}")) + (|coerce| (((|OutputForm|) $) + "\\spad{coerce(r)} returns an representation of \\spad{r} as an output form") + (($ (|List| (|Any|))) + ,(concatenate 'string +"\\spad{coerce(u)}, where \\spad{u} is the list \\spad{[x,y]} for \\spad{x} " +"of type \\spad{A} and \\spad{y} of type \\spad{B}, returns the record " +"\\spad{[a:x,b:y]}"))) + (|elt| ((A $ "a") + ,(concatenate 'string + "\\spad{r . a} returns the value stored in record \\spad{r} under " + "selector \\spad{a}.")) + ((B $ "b") + ,(concatenate 'string +"\\spad{r . b} returns the value stored in record \\spad{r} " + "under selector \\spad{b}."))) + (|setelt| ((A $ "a" A) + ,(concatenate 'string +"\\spad{r . a := x} destructively replaces the value stored in " +"record \\spad{r} under selector \\spad{a} by the value of \\spad{x}. " +"Error: if \\spad{r} has not been previously assigned a value.")) + ((B $ "b" B) + ,(concatenate 'string +"\\spad{r . b := y} destructively replaces the value stored in " +"record \\spad{r} under selector \\spad{b} by the value of \\spad{y}. " +"Error: if \\spad{r} has not been previously assigned a value.")))) + :test #'equal))) + +\end{chunk} + +\begin{chunk}{initvars} +(defvar message2 (concatenate 'string +"{\\sf Union(A,B)} denotes the class of objects which are which are either " +"members of domain {\\em A} or of domain {\\em B}. The {\\sf Union} " +"constructor can take any number of arguments. " +"For an alternate form of {\\sf Union} with \"tags\", see " +"\\downlink{Union(a:A,b:B)}{DomainUnion}. {\\sf Union} is a primitive " +"domain of Axiom which cannot be defined in the Axiom language.")) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) +(put '|UntaggedUnion| '|documentation| + (subst message2 'message + `((|constructor| (nil message)) + (= (((|Boolean|) $ $) + ,(concatenate 'string +"\\spad{u = v} tests if two objects of the union are equal, " +"that is, u and v are hold objects of same branch which are equal."))) + (|case| (((|Boolean|) $ "A") + ,(concatenate 'string +"\\spad{u case A} tests if \\spad{u} is of the type \\spad{A} " +"branch of the union.")) + (((|Boolean|) $ "B") + ,(concatenate 'string +"\\spad{u case B} tests if \\spad{u} is of the \\spad{B} branch " +"of the union."))) + (|coerce| ((A $) + ,(concatenate 'string +"\\spad{coerce(u)} returns \\spad{x} of type \\spad{A} if " +"\\spad{x} is of the \\spad{A} branch of the union. " +"Error: if \\spad{u} is of the \\spad{B} branch of the union.")) + ((B $) + ,(concatenate 'string +"\\spad{coerce(u)} returns \\spad{x} of type \\spad{B} if " +"\\spad{x} is of the \\spad{B} branch of the union. " +"Error: if \\spad{u} is of the \\spad{A} branch of the union.")) + (($ A) + ,(concatenate 'string +"\\spad{coerce(x)}, where \\spad{x} has type \\spad{A}, " +"returns \\spad{x} as a union type.")) + (($ B) + ,(concatenate 'string +"\\spad{coerce(y)}, where \\spad{y} has type \\spad{B}, " +"returns \\spad{y} as a union type.")))) + :test #'equal))) + +\end{chunk} + +\begin{chunk}{initvars} +(defvar message3 (concatenate 'string + "{\\sf Union(a:A,b:B)} denotes the class of objects which are either " +"members of domain {\\em A} or of domain {\\em B}. " +"The symbols {\\em a} and {\\em b} are called \"tags\" and are used to " +"identify the two \"branches\" of the union. " +"The {\\sf Union} constructor can take any number of arguments and has an " +"alternate form without {\\em tags} " +"(see \\downlink{Union(A,B)}{UntaggedUnion}). " +"This tagged {\\sf Union} type is necessary, for example, to disambiguate " +"two branches of a union where {\\em A} and {\\em B} denote the same type. " +"{\\sf Union} is a primitive domain of Axiom which cannot be " +"defined in the Axiom language.")) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) +(put '|Union| '|documentation| + (subst message3 'message + `((|constructor| (NIL MESSAGE)) + (= (((|Boolean|) $ $) + ,(concatenate 'string +"\\spad{u = v} tests if two objects of the union are equal, that " +"is, \\spad{u} and \\spad{v} are objects of same branch which are equal."))) + (|case| (((|Boolean|) $ "A") + "\\spad{u case a} tests if \\spad{u} is of branch \\spad{a} of the union.") + (((|Boolean|) $ "B") + "\\spad{u case b} tests if \\spad{u} is of branch \\spad{b} of the union.")) + (|coerce| ((A $) + ,(concatenate 'string +"\\spad{coerce(u)} returns \\spad{x} of type \\spad{A} if " +"\\spad{x} is of branch \\spad{a} of the union. " +"Error: if \\spad{u} is of branch \\spad{b} of the union.")) + ((B $) + ,(concatenate 'string +"\\spad{coerce(u)} returns \\spad{x} of type \\spad{B} if " +"\\spad{x} is of branch \\spad{b} branch of the union. " +"Error: if \\spad{u} is of the \\spad{a} branch of the union.")) + (($ A) + ,(concatenate 'string +"\\spad{coerce(x)}, where \\spad{x} has type \\spad{A}, returns " +"\\spad{x} as a union type.")) + (($ B) + ,(concatenate 'string +"\\spad{coerce(y)}, where \\spad{y} has type \\spad{B}, returns " +"\\spad{y} as a union type.")))) + :test #'equal))) + +\end{chunk} + +\begin{chunk}{initvars} +(defvar message4 (concatenate 'string +"{\\sf Mapping(T,S,...)} denotes the class of objects which are mappings from " +"a source domain ({\\em S,...}) into a target domain {\\em T}. The " +"{\\sf Mapping} constructor can take any number of arguments." +" All but the first argument is regarded as part of a source tuple for the " +"mapping. For example, {\\sf Mapping(T,A,B)} denotes the class of mappings " +"from {\\em (A,B)} into {\\em T}. " +"{\\sf Mapping} is a primitive domain of Axiom which cannot be defined in " +"the Axiom language.")) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) +(put '|Mapping| '|documentation| + (subst message4 'message + '((|constructor| (NIL MESSAGE)) + (= (((|Boolean|) $ $) + "\\spad{u = v} tests if mapping objects are equal."))) + :test #'equal))) + +\end{chunk} + +\begin{chunk}{initvars} +(defvar message5 (concatenate 'string +"{\\em Enumeration(a1, a2 ,..., aN)} creates an object which is exactly one " +"of the N symbols {\\em a1}, {\\em a2}, ..., or {\\em aN}, N > 0. " +" The {\\em Enumeration} can constructor can take any number of symbols as " +"arguments.")) + +\end{chunk} + +\begin{chunk}{postvars} +(eval-when (eval load) +(put '|Enumeration| '|documentation| + (subst message5 'message + `((|constructor| (nil message)) + (= (((|Boolean|) $ $) + ,(concatenate 'string +"\\spad{e = f} tests for equality of two enumerations \\spad{e} " +"and \\spad{f}"))) + (^= (((|Boolean|) $ $) + ,(concatenate 'string +"\\spad{e ^= f} tests that two enumerations \\spad{e} and " +"\\spad{f} are not equal"))) + (|coerce| (((|OutputForm|) $) + ,(concatenate 'string +"\\spad{coerce(e)} returns a representation of enumeration " +"\\spad{r} as an output form")) + (($ (|Symbol|)) + ,(concatenate 'string +"\\spad{coerce(s)} converts a symbol \\spad{s} into an " +"enumeration which has \\spad{s} as a member symbol")))) + :test #'equal))) + +\end{chunk} + \chapter{The Interpreter} \begin{chunk}{Interpreter} (setq *print-array* nil) @@ -53145,6 +53550,7 @@ There are 8 parts of an htPage: \getchunk{defun bcSystemSolve} \getchunk{defun bcTaylorSeries} \getchunk{defun bcTaylorSeriesGen} +\getchunk{defun bcUnixTable} \getchunk{defun bcVectorGen} \getchunk{defun bcvspace} \getchunk{defun bcwords2liststring} @@ -53220,6 +53626,7 @@ There are 8 parts of an htPage: \getchunk{defun dbAddDocTable} \getchunk{defun dbCompositeWithMap} \getchunk{defun dbConsExposureMessage} +\getchunk{defun dbConsHeading} \getchunk{defun dbConstructorDoc} \getchunk{defun dbConstructorDoc,hn} \getchunk{defun dbConstructorDoc,gn} @@ -53237,6 +53644,11 @@ There are 8 parts of an htPage: \getchunk{defun dbShowConsDoc} \getchunk{defun dbShowConsDoc1} \getchunk{defun dbShowConsKindsFilter} +\getchunk{defun dbShowConstructorLines} +\getchunk{defun dbSpecialDescription} +\getchunk{defun dbSpecialExpandIfNecessary} +\getchunk{defun dbSpecialExports} +\getchunk{defun dbSpecialOperations} \getchunk{defun dbSubConform} \getchunk{defun decideHowMuch} \getchunk{defun defaultTargetFE} diff --git a/buglist b/buglist index 8b9dd28..66d1112 100644 --- a/buglist +++ b/buglist @@ -26431,8 +26431,6 @@ Compiling /research2/test0819/int/interp/br-con.clisp. ;; The compiler will assume this variable is a global. ; (DEFUN |dbSelectCon| ...) is being compiled. ;; Warning: The variable |which| is not used. -; (DEFUN |isAsharpFileName?| ...) is being compiled. -;; Warning: The variable |con| is not used. ============================================================================ diff --git a/changelog b/changelog index d9b8385..069e917 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20130623 tpd src/axiom-website/patches.html 20130623.01.tpd.patch +20130623 tpd src/interp/br-con.lisp move code to bookvol5 +20130623 tpd books/bookvol5 move code from br-con.lisp +20130623 tpd buglist 20130622 tpd src/axiom-website/patches.html 20130622.01.tpd.patch 20130622 tpd src/interp/br-con.lisp move code to bookvol5 20130622 tpd books/bookvol5 move code from br-con.lisp diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index c806b54..b9c86dc 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -4216,6 +4216,8 @@ books/bookvol5 move code from br-con.lisp books/bookvol5 move code from br-con.lisp 20130622.01.tpd.patch books/bookvol5 move code from br-con.lisp +20130623.01.tpd.patch +books/bookvol5 move code from br-con.lisp diff --git a/src/interp/br-con.lisp.pamphlet b/src/interp/br-con.lisp.pamphlet index 35429a8..0fb42b8 100644 --- a/src/interp/br-con.lisp.pamphlet +++ b/src/interp/br-con.lisp.pamphlet @@ -12,602 +12,6 @@ \begin{chunk}{*} (IN-PACKAGE "BOOT" ) -;dbConsHeading(htPage,conlist,view,kind) == -; thing := htPage and htpProperty(htPage,'thing) or '"constructor" -; place := -; htPage => htpProperty(htPage,'domname) or htpProperty(htPage,'conform) -; nil -; count := #(REMDUP conlist) -; -- count := #conlist -; thing = '"benefactor" => -; [STRINGIMAGE count,'" Constructors Used by ",form2HtString(place,nil,true)] -; modifier := -; thing = '"argument" => -; rank := htPage and htpProperty(htPage,'rank) -; ['" Possible ",rank,'" "] -; kind = 'constructor => ['" "] -; ['" ",capitalize STRINGIMAGE kind,'" "] -;-- count = 1 => -;-- ['"Select name or a {\em view} at the bottom"] -; exposureWord := -; $exposedOnlyIfTrue => '(" Exposed ") -; nil -; prefix := -; count = 1 => [STRINGIMAGE count,:modifier,capitalize thing] -; firstWord := (count = 0 => '"No "; STRINGIMAGE count) -; [firstWord,:exposureWord, :modifier,capitalize pluralize thing] -; placepart := -; place => ['" of {\em ",form2HtString(place,nil,true),"}"] -; nil -; heading := [:prefix,:placepart] -; connective := -; MEMBER(view,'(abbrs files kinds)) => '" as " -; '" with " -; if count ^= 0 and MEMBER(view,'(abbrs files parameters conditions)) then heading:= [:heading,'" viewed",connective,'"{\em ",STRINGIMAGE view,'"}"] -; heading - -(DEFUN |dbConsHeading| (|htPage| |conlist| |view| |kind|) - (PROG (|thing| |place| |count| |rank| |modifier| |exposureWord| - |firstWord| |prefix| |placepart| |connective| - |heading|) - (declare (special |$exposedOnlyIfTrue|)) - (RETURN - (PROGN - (SPADLET |thing| - (OR (AND |htPage| (|htpProperty| |htPage| '|thing|)) - "constructor")) - (SPADLET |place| - (COND - (|htPage| - (OR (|htpProperty| |htPage| '|domname|) - (|htpProperty| |htPage| '|conform|))) - ('T NIL))) - (SPADLET |count| (|#| (REMDUP |conlist|))) - (COND - ((BOOT-EQUAL |thing| "benefactor") - (CONS (STRINGIMAGE |count|) - (CONS " Constructors Used by " - (CONS (|form2HtString| |place| NIL 'T) NIL)))) - ('T - (SPADLET |modifier| - (COND - ((BOOT-EQUAL |thing| "argument") - (SPADLET |rank| - (AND |htPage| - (|htpProperty| |htPage| '|rank|))) - (CONS " Possible " - (CONS |rank| (CONS " " NIL)))) - ((BOOT-EQUAL |kind| '|constructor|) - (CONS " " NIL)) - ('T - (CONS " " - (CONS (|capitalize| (STRINGIMAGE |kind|)) - (CONS " " NIL)))))) - (SPADLET |exposureWord| - (COND - (|$exposedOnlyIfTrue| '(" Exposed ")) - ('T NIL))) - (SPADLET |prefix| - (COND - ((EQL |count| 1) - (CONS (STRINGIMAGE |count|) - (APPEND |modifier| - (CONS (|capitalize| |thing|) NIL)))) - ('T - (SPADLET |firstWord| - (COND - ((EQL |count| 0) "No ") - ('T (STRINGIMAGE |count|)))) - (CONS |firstWord| - (APPEND |exposureWord| - (APPEND |modifier| - (CONS - (|capitalize| - (|pluralize| |thing|)) - NIL))))))) - (SPADLET |placepart| - (COND - (|place| (CONS " of {\\em " - (CONS - (|form2HtString| |place| NIL 'T) - (CONS '} NIL)))) - ('T NIL))) - (SPADLET |heading| (APPEND |prefix| |placepart|)) - (SPADLET |connective| - (COND - ((|member| |view| '(|abbrs| |files| |kinds|)) - " as ") - ('T " with "))) - (COND - ((AND (NEQUAL |count| 0) - (|member| |view| - '(|abbrs| |files| |parameters| |conditions|))) - (SPADLET |heading| - (APPEND |heading| - (CONS " viewed" - (CONS |connective| - (CONS "{\\em " - (CONS (STRINGIMAGE |view|) - (CONS "}" NIL))))))))) - |heading|)))))) - -;dbShowConstructorLines lines == -; cAlist := [[getConstructorForm intern dbName line,:true] for line in lines] -; dbShowCons1(nil,listSort(function GLESSEQP,cAlist),'names) - -(DEFUN |dbShowConstructorLines| (|lines|) - (PROG (|cAlist|) - (RETURN - (SEQ (PROGN - (SPADLET |cAlist| - (PROG (G167833) - (SPADLET G167833 NIL) - (RETURN - (DO ((G167838 |lines| (CDR G167838)) - (|line| NIL)) - ((OR (ATOM G167838) - (PROGN - (SETQ |line| (CAR G167838)) - NIL)) - (NREVERSE0 G167833)) - (SEQ (EXIT (SETQ G167833 - (CONS - (CONS - (|getConstructorForm| - (|intern| (|dbName| |line|))) - 'T) - G167833)))))))) - (|dbShowCons1| NIL - (|listSort| (|function| GLESSEQP) |cAlist|) '|names|)))))) - -;bcUnixTable(u) == -; htSay '"\newline" -; htBeginTable() -; firstTime := true -; for x in u repeat -; if firstTime then firstTime := false -; else htSaySaturn '"&" -; htSay '"{" -; ft := -; isAsharpFileName? x => '("AS") -; '("SPAD") -; filename := NAMESTRING $FINDFILE(STRINGIMAGE x, ft) -; htMakePage [['text, '"\unixcommand{",PATHNAME_-NAME x, '"}{$AXIOM/lib/SPADEDIT ", filename, '"} "]] -; htSay '"}" -; htEndTable() - -(DEFUN |bcUnixTable| (|u|) - (PROG (|firstTime| |ft| |filename|) - (RETURN - (SEQ (PROGN - (|htSay| "\\newline") - (|htBeginTable|) - (SPADLET |firstTime| 'T) - (DO ((G167861 |u| (CDR G167861)) (|x| NIL)) - ((OR (ATOM G167861) - (PROGN (SETQ |x| (CAR G167861)) NIL)) - NIL) - (SEQ (EXIT (PROGN - (COND - (|firstTime| (SPADLET |firstTime| NIL)) - ('T (|htSaySaturn| "&"))) - (|htSay| "{") - (SPADLET |ft| - (COND - ((|isAsharpFileName?| |x|) - '("AS")) - ('T '("SPAD")))) - (SPADLET |filename| - (NAMESTRING - ($FINDFILE (STRINGIMAGE |x|) - |ft|))) - (|htMakePage| - (CONS (CONS '|text| - (CONS - "\\unixcommand{" - (CONS (PATHNAME-NAME |x|) - (CONS - "}{$AXIOM/lib/SPADEDIT " - (CONS |filename| - (CONS "} " NIL)))))) - NIL)) - (|htSay| "}"))))) - (|htEndTable|)))))) - -;isAsharpFileName? con == false - -(DEFUN |isAsharpFileName?| (|con|) - (declare (ignore |con|)) - NIL) - -;--======================================================================= -;-- Special Code for Union, Mapping, and Record -;--======================================================================= -;dbSpecialDescription(conname) == -; conform := getConstructorForm conname -; heading := ['"Description of Domain {\sf ",form2HtString conform,'"}"] -; page := htInitPage(heading,nil) -; htpSetProperty(page,'conname,conname) -; $conformsAreDomains := nil -; dbShowConsDoc1(page,conform,nil) -; htShowPage() - -(DEFUN |dbSpecialDescription| (|conname|) - (PROG (|conform| |heading| |page|) - (declare (special |$conformsAreDomains|)) - (RETURN - (PROGN - (SPADLET |conform| (|getConstructorForm| |conname|)) - (SPADLET |heading| - (CONS "Description of Domain {\\sf " - (CONS (|form2HtString| |conform|) - (CONS "}" NIL)))) - (SPADLET |page| (|htInitPage| |heading| NIL)) - (|htpSetProperty| |page| '|conname| |conname|) - (SPADLET |$conformsAreDomains| NIL) - (|dbShowConsDoc1| |page| |conform| NIL) - (|htShowPage|))))) - -;dbSpecialOperations(conname) == -; page := htInitPage(nil,nil) -; conform := getConstructorForm conname -; opAlist := dbSpecialExpandIfNecessary(conform,rest GET(conname,'documentation)) -; fromHeading := ['" from domain {\sf ",form2HtString conform,'"}"] -; htpSetProperty(page,'fromHeading,fromHeading) -; htpSetProperty(page,'conform,conform) -; htpSetProperty(page,'opAlist,opAlist) -; htpSetProperty(page,'noUsage,true) -; htpSetProperty(page,'condition?,'no) -; dbShowOp1(page,opAlist,'"operation",'names) - -(DEFUN |dbSpecialOperations| (|conname|) - (PROG (|page| |conform| |opAlist| |fromHeading|) - (RETURN - (PROGN - (SPADLET |page| (|htInitPage| NIL NIL)) - (SPADLET |conform| (|getConstructorForm| |conname|)) - (SPADLET |opAlist| - (|dbSpecialExpandIfNecessary| |conform| - (CDR (GETL |conname| '|documentation|)))) - (SPADLET |fromHeading| - (CONS " from domain {\\sf " - (CONS (|form2HtString| |conform|) - (CONS "}" NIL)))) - (|htpSetProperty| |page| '|fromHeading| |fromHeading|) - (|htpSetProperty| |page| '|conform| |conform|) - (|htpSetProperty| |page| '|opAlist| |opAlist|) - (|htpSetProperty| |page| '|noUsage| 'T) - (|htpSetProperty| |page| '|condition?| '|no|) - (|dbShowOp1| |page| |opAlist| "operation" - '|names|))))) - -;dbSpecialExports(conname) == -; conform := getConstructorForm conname -; page := htInitPage(['"Exports of {\sf ",form2HtString conform,'"}"],nil) -; opAlist := dbSpecialExpandIfNecessary(conform,rest GET(conname,'documentation)) -; kePageDisplay(page,'"operation",opAlist) -; htShowPage() - -(DEFUN |dbSpecialExports| (|conname|) - (PROG (|conform| |page| |opAlist|) - (RETURN - (PROGN - (SPADLET |conform| (|getConstructorForm| |conname|)) - (SPADLET |page| - (|htInitPage| - (CONS "Exports of {\\sf " - (CONS (|form2HtString| |conform|) - (CONS "}" NIL))) - NIL)) - (SPADLET |opAlist| - (|dbSpecialExpandIfNecessary| |conform| - (CDR (GETL |conname| '|documentation|)))) - (|kePageDisplay| |page| "operation" |opAlist|) - (|htShowPage|))))) - -;dbSpecialExpandIfNecessary(conform,opAlist) == -; opAlist is [[op,[sig,:r],:.],:.] and rest r => opAlist -; for [op,:u] in opAlist repeat -; for pair in u repeat -; [sig,comments] := pair -; RPLACD(pair,['T,conform,'T,comments]) --[sig,pred,origin,exposeFg,doc] -; opAlist - -(DEFUN |dbSpecialExpandIfNecessary| (|conform| |opAlist|) - (PROG (|ISTMP#1| |ISTMP#2| |ISTMP#3| |r| |op| |u| |sig| |comments|) - (RETURN - (SEQ (COND - ((AND (CONSP |opAlist|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |opAlist|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (SPADLET |op| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (PROGN - (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) - (AND (CONSP |ISTMP#3|) - (PROGN - (SPADLET |sig| (QCAR |ISTMP#3|)) - (SPADLET |r| (QCDR |ISTMP#3|)) - 'T))))))) - (CDR |r|)) - |opAlist|) - ('T - (DO ((G167949 |opAlist| (CDR G167949)) - (G167937 NIL)) - ((OR (ATOM G167949) - (PROGN (SETQ G167937 (CAR G167949)) NIL) - (PROGN - (PROGN - (SPADLET |op| (CAR G167937)) - (SPADLET |u| (CDR G167937)) - G167937) - NIL)) - NIL) - (SEQ (EXIT (DO ((G167962 |u| (CDR G167962)) - (|pair| NIL)) - ((OR (ATOM G167962) - (PROGN - (SETQ |pair| (CAR G167962)) - NIL)) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |sig| (CAR |pair|)) - (SPADLET |comments| - (CADR |pair|)) - (RPLACD |pair| - (CONS 'T - (CONS |conform| - (CONS 'T - (CONS |comments| NIL)))))))))))) - |opAlist|)))))) - -;X := '"{\sf Record(a:A,b:B)} is used to create the class of pairs of objects made up of a value of type {\em A} selected by the symbol {\em a} and a value of type {\em B} selected by the symbol {\em b}. " - -(SPADLET X - "{\\sf Record(a:A,b:B)} is used to create the class of pairs of objects made up of a value of type {\\em A} selected by the symbol {\\em a} and a value of type {\\em B} selected by the symbol {\\em b}. ") - -;Y := '"In general, the {\sf Record} constructor can take any number of arguments and thus can be used to create aggregates of heterogeneous components of arbitrary size selectable by name. " - -(SPADLET Y - "In general, the {\\sf Record} constructor can take any number of arguments and thus can be used to create aggregates of heterogeneous components of arbitrary size selectable by name. ") - -;Z := '"{\sf Record} is a primitive domain of \Language{} which cannot be defined in the \Language{} language." - -(SPADLET Z - "{\\sf Record} is a primitive domain of \\Language{} which cannot be defined in the \\Language{} language.") - -;MESSAGE := STRCONC(X,Y,Z) - -(SPADLET MESSAGE (STRCONC X Y Z)) - -;PUT('Record,'documentation,SUBST(MESSAGE,'MESSAGE,'( -; (constructor (NIL MESSAGE)) -; (_= (((Boolean) _$ _$) -; "\spad{r = s} tests for equality of two records \spad{r} and \spad{s}")) -; (coerce (((OutputForm) _$) -; "\spad{coerce(r)} returns an representation of \spad{r} as an output form") -; ((_$ (List (Any))) -; "\spad{coerce(u)}, where \spad{u} is the list \spad{[x,y]} for \spad{x} of type \spad{A} and \spad{y} of type \spad{B}, returns the record \spad{[a:x,b:y]}")) -; (elt ((A $ "a") -; "\spad{r . a} returns the value stored in record \spad{r} under selector \spad{a}.") -; ((B $ "b") -; "\spad{r . b} returns the value stored in record \spad{r} under selector \spad{b}.")) -; (setelt ((A $ "a" A) -; "\spad{r . a := x} destructively replaces the value stored in record \spad{r} under selector \spad{a} by the value of \spad{x}. Error: if \spad{r} has not been previously assigned a value.") -; ((B $ "b" B) -; "\spad{r . b := y} destructively replaces the value stored in record \spad{r} under selector \spad{b} by the value of \spad{y}. Error: if \spad{r} has not been previously assigned a value.")) -; ))) - -(PUT '|Record| '|documentation| - (MSUBST MESSAGE 'MESSAGE - '((|constructor| (NIL MESSAGE)) - (= (((|Boolean|) $ $) - "\\spad{r = s} tests for equality of two records \\spad{r} and \\spad{s}")) - (|coerce| - (((|OutputForm|) $) - "\\spad{coerce(r)} returns an representation of \\spad{r} as an output form") - (($ (|List| (|Any|))) - "\\spad{coerce(u)}, where \\spad{u} is the list \\spad{[x,y]} for \\spad{x} of type \\spad{A} and \\spad{y} of type \\spad{B}, returns the record \\spad{[a:x,b:y]}")) - (|elt| ((A $ "a") - "\\spad{r . a} returns the value stored in record \\spad{r} under selector \\spad{a}.") - ((B $ "b") - "\\spad{r . b} returns the value stored in record \\spad{r} under selector \\spad{b}.")) - (|setelt| - ((A $ "a" A) - "\\spad{r . a := x} destructively replaces the value stored in record \\spad{r} under selector \\spad{a} by the value of \\spad{x}. Error: if \\spad{r} has not been previously assigned a value.") - ((B $ "b" B) - "\\spad{r . b := y} destructively replaces the value stored in record \\spad{r} under selector \\spad{b} by the value of \\spad{y}. Error: if \\spad{r} has not been previously assigned a value."))))) - -;X := '"{\sf Union(A,B)} denotes the class of objects which are which are either members of domain {\em A} or of domain {\em B}. The {\sf Union} constructor can take any number of arguments. " - -(SPADLET X - "{\\sf Union(A,B)} denotes the class of objects which are which are either members of domain {\\em A} or of domain {\\em B}. The {\\sf Union} constructor can take any number of arguments. ") - -;Y := '"For an alternate form of {\sf Union} with _"tags_", see \downlink{Union(a:A,b:B)}{DomainUnion}. {\sf Union} is a primitive domain of \Language{} which cannot be defined in the \Language{} language." - -(SPADLET Y - "For an alternate form of {\\sf Union} with \"tags\", see \\downlink{Union(a:A,b:B)}{DomainUnion}. {\\sf Union} is a primitive domain of \\Language{} which cannot be defined in the \\Language{} language.") - -;MESSAGE := STRCONC(X,Y) - -(SPADLET MESSAGE (STRCONC X Y)) - -;PUT('UntaggedUnion,'documentation,SUBST(MESSAGE,'MESSAGE,'( -; (constructor (NIL MESSAGE)) -; (_= (((Boolean) $ $) -; "\spad{u = v} tests if two objects of the union are equal, that is, u and v are hold objects of same branch which are equal.")) -; (case (((Boolean) $ "A") -; "\spad{u case A} tests if \spad{u} is of the type \spad{A} branch of the union.") -; (((Boolean) $ "B") -; "\spad{u case B} tests if \spad{u} is of the \spad{B} branch of the union.")) -; (coerce ((A $) -; "\spad{coerce(u)} returns \spad{x} of type \spad{A} if \spad{x} is of the \spad{A} branch of the union. Error: if \spad{u} is of the \spad{B} branch of the union.") -; ((B $) -; "\spad{coerce(u)} returns \spad{x} of type \spad{B} if \spad{x} is of the \spad{B} branch of the union. Error: if \spad{u} is of the \spad{A} branch of the union.") -; (($ A) -; "\spad{coerce(x)}, where \spad{x} has type \spad{A}, returns \spad{x} as a union type.") -; (($ B) -; "\spad{coerce(y)}, where \spad{y} has type \spad{B}, returns \spad{y} as a union type.")) -; ))) - -(PUT '|UntaggedUnion| '|documentation| - (MSUBST MESSAGE 'MESSAGE - '((|constructor| (NIL MESSAGE)) - (= (((|Boolean|) $ $) - "\\spad{u = v} tests if two objects of the union are equal, that is, u and v are hold objects of same branch which are equal.")) - (|case| (((|Boolean|) $ "A") - "\\spad{u case A} tests if \\spad{u} is of the type \\spad{A} branch of the union.") - (((|Boolean|) $ "B") - "\\spad{u case B} tests if \\spad{u} is of the \\spad{B} branch of the union.")) - (|coerce| - ((A $) - "\\spad{coerce(u)} returns \\spad{x} of type \\spad{A} if \\spad{x} is of the \\spad{A} branch of the union. Error: if \\spad{u} is of the \\spad{B} branch of the union.") - ((B $) - "\\spad{coerce(u)} returns \\spad{x} of type \\spad{B} if \\spad{x} is of the \\spad{B} branch of the union. Error: if \\spad{u} is of the \\spad{A} branch of the union.") - (($ A) - "\\spad{coerce(x)}, where \\spad{x} has type \\spad{A}, returns \\spad{x} as a union type.") - (($ B) - "\\spad{coerce(y)}, where \\spad{y} has type \\spad{B}, returns \\spad{y} as a union type."))))) - -;X := '"{\sf Union(a:A,b:B)} denotes the class of objects which are either members of domain {\em A} or of domain {\em B}. " - -(SPADLET X - "{\\sf Union(a:A,b:B)} denotes the class of objects which are either members of domain {\\em A} or of domain {\\em B}. ") - -;Y := '"The symbols {\em a} and {\em b} are called _"tags_" and are used to identify the two _"branches_" of the union. " - -(SPADLET Y - "The symbols {\\em a} and {\\em b} are called \"tags\" and are used to identify the two \"branches\" of the union. ") - -;Z := '"The {\sf Union} constructor can take any number of arguments and has an alternate form without {\em tags} (see \downlink{Union(A,B)}{UntaggedUnion}). " - -(SPADLET Z - "The {\\sf Union} constructor can take any number of arguments and has an alternate form without {\\em tags} (see \\downlink{Union(A,B)}{UntaggedUnion}). ") - -;W := '"This tagged {\sf Union} type is necessary, for example, to disambiguate two branches of a union where {\em A} and {\em B} denote the same type. " - -(SPADLET W - "This tagged {\\sf Union} type is necessary, for example, to disambiguate two branches of a union where {\\em A} and {\\em B} denote the same type. ") - -;A := '"{\sf Union} is a primitive domain of \Language{} which cannot be defined in the \Language{} language." - -(SPADLET A - "{\\sf Union} is a primitive domain of \\Language{} which cannot be defined in the \\Language{} language.") - -;MESSAGE := STRCONC(X,Y,Z,W,A) - -(SPADLET MESSAGE (STRCONC X Y Z W A)) - -;PUT('Union,'documentation,SUBST(MESSAGE,'MESSAGE,'( -; (constructor (NIL MESSAGE)) -; (_= (((Boolean) $ $) -; "\spad{u = v} tests if two objects of the union are equal, that is, \spad{u} and \spad{v} are objects of same branch which are equal.")) -; (case (((Boolean) $ "A") -; "\spad{u case a} tests if \spad{u} is of branch \spad{a} of the union.") -; (((Boolean) $ "B") -; "\spad{u case b} tests if \spad{u} is of branch \spad{b} of the union.")) -; (coerce ((A $) -; "\spad{coerce(u)} returns \spad{x} of type \spad{A} if \spad{x} is of branch \spad{a} of the union. Error: if \spad{u} is of branch \spad{b} of the union.") -; ((B $) -; "\spad{coerce(u)} returns \spad{x} of type \spad{B} if \spad{x} is of branch \spad{b} branch of the union. Error: if \spad{u} is of the \spad{a} branch of the union.") -; (($ A) -; "\spad{coerce(x)}, where \spad{x} has type \spad{A}, returns \spad{x} as a union type.") -; (($ B) -; "\spad{coerce(y)}, where \spad{y} has type \spad{B}, returns \spad{y} as a union type.")) -; ))) - -(PUT '|Union| '|documentation| - (MSUBST MESSAGE 'MESSAGE - '((|constructor| (NIL MESSAGE)) - (= (((|Boolean|) $ $) - "\\spad{u = v} tests if two objects of the union are equal, that is, \\spad{u} and \\spad{v} are objects of same branch which are equal.")) - (|case| (((|Boolean|) $ "A") - "\\spad{u case a} tests if \\spad{u} is of branch \\spad{a} of the union.") - (((|Boolean|) $ "B") - "\\spad{u case b} tests if \\spad{u} is of branch \\spad{b} of the union.")) - (|coerce| - ((A $) - "\\spad{coerce(u)} returns \\spad{x} of type \\spad{A} if \\spad{x} is of branch \\spad{a} of the union. Error: if \\spad{u} is of branch \\spad{b} of the union.") - ((B $) - "\\spad{coerce(u)} returns \\spad{x} of type \\spad{B} if \\spad{x} is of branch \\spad{b} branch of the union. Error: if \\spad{u} is of the \\spad{a} branch of the union.") - (($ A) - "\\spad{coerce(x)}, where \\spad{x} has type \\spad{A}, returns \\spad{x} as a union type.") - (($ B) - "\\spad{coerce(y)}, where \\spad{y} has type \\spad{B}, returns \\spad{y} as a union type."))))) - -;X := '"{\sf Mapping(T,S,...)} denotes the class of objects which are mappings from a source domain ({\em S,...}) into a target domain {\em T}. The {\sf Mapping} constructor can take any number of arguments." - -(SPADLET X - "{\\sf Mapping(T,S,...)} denotes the class of objects which are mappings from a source domain ({\\em S,...}) into a target domain {\\em T}. The {\\sf Mapping} constructor can take any number of arguments.") - -;Y := '" All but the first argument is regarded as part of a source tuple for the mapping. For example, {\sf Mapping(T,A,B)} denotes the class of mappings from {\em (A,B)} into {\em T}. " - -(SPADLET Y - " All but the first argument is regarded as part of a source tuple for the mapping. For example, {\\sf Mapping(T,A,B)} denotes the class of mappings from {\\em (A,B)} into {\\em T}. ") - -;Z := '"{\sf Mapping} is a primitive domain of \Language{} which cannot be defined in the \Language{} language." - -(SPADLET Z - "{\\sf Mapping} is a primitive domain of \\Language{} which cannot be defined in the \\Language{} language.") - -;MESSAGE := STRCONC(X,Y,Z) - -(SPADLET MESSAGE (STRCONC X Y Z)) - -;PUT('Mapping,'documentation, SUBST(MESSAGE,'MESSAGE,'( -; (constructor (NIL MESSAGE)) -; (_= (((Boolean) $ $) -; "\spad{u = v} tests if mapping objects are equal.")) -; ))) - -(PUT '|Mapping| '|documentation| - (MSUBST MESSAGE 'MESSAGE - '((|constructor| (NIL MESSAGE)) - (= (((|Boolean|) $ $) - "\\spad{u = v} tests if mapping objects are equal."))))) - -;X := '"{\em Enumeration(a1, a2 ,..., aN)} creates an object which is exactly one of the N symbols {\em a1}, {\em a2}, ..., or {\em aN}, N > 0. " - -(SPADLET X - "{\\em Enumeration(a1, a2 ,..., aN)} creates an object which is exactly one of the N symbols {\\em a1}, {\\em a2}, ..., or {\\em aN}, N > 0. ") - -;Y := '" The {\em Enumeration} can constructor can take any number of symbols as arguments." - -(SPADLET Y - " The {\\em Enumeration} can constructor can take any number of symbols as arguments.") - -;MESSAGE := STRCONC(X, Y) - -(SPADLET MESSAGE (STRCONC X Y)) - -;PUT('Enumeration, 'documentation, SUBST(MESSAGE, 'MESSAGE, '( -; (constructor (NIL MESSAGE)) -; (_= (((Boolean) _$ _$) -; "\spad{e = f} tests for equality of two enumerations \spad{e} and \spad{f}")) -; (_^_= (((Boolean) _$ _$) -; "\spad{e ^= f} tests that two enumerations \spad{e} and \spad{f} are nont equal")) -; (coerce (((OutputForm) _$) -; "\spad{coerce(e)} returns a representation of enumeration \spad{r} as an output form") -; ((_$ (Symbol)) -; "\spad{coerce(s)} converts a symbol \spad{s} into an enumeration which has \spad{s} as a member symbol")) -; ))) - -(PUT '|Enumeration| '|documentation| - (MSUBST MESSAGE 'MESSAGE - '((|constructor| (NIL MESSAGE)) - (= (((|Boolean|) $ $) - "\\spad{e = f} tests for equality of two enumerations \\spad{e} and \\spad{f}")) - (^= (((|Boolean|) $ $) - "\\spad{e ^= f} tests that two enumerations \\spad{e} and \\spad{f} are nont equal")) - (|coerce| - (((|OutputForm|) $) - "\\spad{coerce(e)} returns a representation of enumeration \\spad{r} as an output form") - (($ (|Symbol|)) - "\\spad{coerce(s)} converts a symbol \\spad{s} into an enumeration which has \\spad{s} as a member symbol"))))) - ;mkConArgSublis args == ; [[arg,:INTERN digits2Names PNAME arg] for arg in args ; | (s := PNAME arg) and or/[DIGITP ELT(s,i) for i in 0..MAXINDEX s]]