diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index d330d97..abdca14 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -20994,7 +20994,7 @@ o )what @ -\defun{reportOpsFromLisplib0}{} +\defun{reportOpsFromLisplib0}{reportOpsFromLisplib0} \calls{reportOpsFromLisplib0}{reportOpsFromLisplib1} \calls{reportOpsFromLisplib0}{reportOpsFromLisplib} \usesdollar{reportOpsFromLisplib0}{useEditorForShowOutput} @@ -21033,6 +21033,97 @@ o )what @ +\defun{reportOpsFromLisplib}{reportOpsFromLisplib} +\calls{reportOpsFromLisplib}{constructor?} +\calls{reportOpsFromLisplib}{sayKeyedMsg} +\calls{reportOpsFromLisplib}{getConstructorSignature} +\calls{reportOpsFromLisplib}{kdr} +\calls{reportOpsFromLisplib}{getdatabase} +\calls{reportOpsFromLisplib}{\#} +\calls{reportOpsFromLisplib}{eqsubstlist} +\calls{reportOpsFromLisplib}{nreverse0} +\calls{reportOpsFromLisplib}{sayBrightly} +\calls{reportOpsFromLisplib}{concat} +\calls{reportOpsFromLisplib}{bright} +\calls{reportOpsFromLisplib}{form2StringWithWhere} +\calls{reportOpsFromLisplib}{isExposedConstructor} +\calls{reportOpsFromLisplib}{strconc} +\calls{reportOpsFromLisplib}{namestring} +\calls{reportOpsFromLisplib}{selectOptionLC} +\calls{reportOpsFromLisplib}{dc1} +\calls{reportOpsFromLisplib}{centerAndHighlight} +\calls{reportOpsFromLisplib}{specialChar} +\calls{reportOpsFromLisplib}{remdup} +\calls{reportOpsFromLisplib}{msort} +\calls{reportOpsFromLisplib}{form2String} +\calls{reportOpsFromLisplib}{say2PerLine} +\calls{reportOpsFromLisplib}{formatAttribute} +\calls{reportOpsFromLisplib}{displayOperationsFromLisplib} +\usesdollar{reportOpsFromLisplib}{linelength} +\usesdollar{reportOpsFromLisplib}{showOptions} +\usesdollar{reportOpsFromLisplib}{options} +\usesdollar{reportOpsFromLisplib}{FormalMapVariableList} +<>= +(defun |reportOpsFromLisplib| (op u) + (let (fn s typ nArgs argList functorForm argml tmp1 functorFormWithDecl + verb sourceFile opt x attList) + (declare (special $linelength |$showOptions| |$options| + |$FormalMapVariableList|)) + (if (null (setq fn (|constructor?| op))) + (|sayKeyedMsg| 'S2IZ0054 (list u)) + (progn + (setq argml (when (setq s (|getConstructorSignature| op)) (kdr s))) + (setq typ (getdatabase op 'constructorkind)) + (setq nArgs (|#| argml)) + (setq argList (kdr (getdatabase op 'constructorform))) + (setq functorForm (cons op argList)) + (setq argml (eqsubstlist argList |$FormalMapVariableList| argml)) + (mapcar #'(lambda (a m) (push (list '|:| a m) tmp1)) argList argml) + (setq functorFormWithDecl (cons op (nreverse0 tmp1))) + (|sayBrightly| + (|concat| (|bright| (|form2StringWithWhere| functorFormWithDecl)) + " is a" (|bright| typ) "constructor")) + (|sayBrightly| + (cons " Abbreviation for" + (append (|bright| op) (cons "is" (|bright| fn))))) + (if (|isExposedConstructor| op) + (setq verb "is") + (setq verb "is not")) + (|sayBrightly| + (cons " This constructor" + (append (|bright| verb) (list "exposed in this frame.")))) + (setq sourceFile (getdatabase op 'sourcefile)) + (|sayBrightly| + (cons " Issue" + (append (|bright| (strconc ")edit " (|namestring| sourceFile))) + (cons "to see algebra source code for" + (append (|bright| fn) (list '|%l|)))))) + (dolist (item |$options|) + (setq opt (|selectOptionLC| (car item) |$showOptions| '|optionError|)) + (cond + ((eq opt '|layout|) (|dc1| fn)) + ((eq opt '|views|) + (|sayBrightly| + (cons "To get" (append (|bright| "views") + (list "you must give parameters of constructor"))))) + ((eq opt '|attributes|) + (|centerAndHighlight| "Attributes" $linelength (|specialChar| '|hbar|)) + (|sayBrightly| "") + (setq attList + (remdup + (msort + (mapcar #'(lambda (x) (caar x)) + (reverse (getdatabase op 'attributes)))))) + (if (null attList) + (|sayBrightly| + (|concat| '|%b| (|form2String| functorForm) + '|%d| '|has no attributes.| '|%l|)) + (|say2PerLine| (mapcar #'|formatAttribute| attList)))) + ((eq opt '|operations|) + (|displayOperationsFromLisplib| functorForm)))))))) + +@ + \defun{reportOpsFromUnitDirectly0}{reportOpsFromUnitDirectly0} \calls{reportOpsFromUnitDirectly0}{reportOpsFromUnitDirectly1} \calls{reportOpsFromUnitDirectly0}{reportOpsFromUnitDirectly} @@ -21046,6 +21137,119 @@ o )what @ +\defun{reportOpsFromUnitDirectly}{reportOpsFromUnitDirectly} +\calls{reportOpsFromUnitDirectly}{member} +\calls{reportOpsFromUnitDirectly}{qcar} +\calls{reportOpsFromUnitDirectly}{evalDomain} +\calls{reportOpsFromUnitDirectly}{getdatabase} +\calls{reportOpsFromUnitDirectly}{sayBrightly} +\calls{reportOpsFromUnitDirectly}{concat} +\calls{reportOpsFromUnitDirectly}{formatOpType} +\calls{reportOpsFromUnitDirectly}{isExposedConstructor} +\calls{reportOpsFromUnitDirectly}{bright} +\calls{reportOpsFromUnitDirectly}{sayBrightly} +\calls{reportOpsFromUnitDirectly}{strconc} +\calls{reportOpsFromUnitDirectly}{namestring} +\calls{reportOpsFromUnitDirectly}{selectOptionLC} +\calls{reportOpsFromUnitDirectly}{centerAndHighlight} +\calls{reportOpsFromUnitDirectly}{specialChar} +\calls{reportOpsFromUnitDirectly}{remdup} +\calls{reportOpsFromUnitDirectly}{msort} +\calls{reportOpsFromUnitDirectly}{formatAttribute} +\calls{reportOpsFromUnitDirectly}{centerAndHighlight} +\calls{reportOpsFromUnitDirectly}{getl} +\calls{reportOpsFromUnitDirectly}{systemErrorHere} +\calls{reportOpsFromUnitDirectly}{nreverse0} +\calls{reportOpsFromUnitDirectly}{getOplistForConstructorForm} +\calls{reportOpsFromUnitDirectly}{say2PerLine} +\calls{reportOpsFromUnitDirectly}{formatOperation} +\usesdollar{reportOpsFromUnitDirectly}{commentedOps} +\usesdollar{reportOpsFromUnitDirectly}{CategoryFrame} +\usesdollar{reportOpsFromUnitDirectly}{linelength} +\usesdollar{reportOpsFromUnitDirectly}{options} +\usesdollar{reportOpsFromUnitDirectly}{showOptions} +<>= +(defun |reportOpsFromUnitDirectly| (unitForm) + (let (|$commentedOps| isRecordOrUnion unit top kind abb sourceFile verb opt + x attList constructorFunction tmp1 funlist a b c sigList tmp2) + (declare (special |$commentedOps| |$CategoryFrame| $linelength |$options| + |$showOptions|)) + (setq isRecordOrUnion + (and (pairp unitForm) + (progn (setq a (qcar unitForm)) t) + (|member| a '(|Record| |Union|)))) + (setq unit (|evalDomain| unitForm)) + (setq top (car unitForm)) + (setq kind (getdatabase top 'constructorkind)) + (|sayBrightly| + (|concat| '|%b| (|formatOpType| unitForm) '|%d| + "is a" '|%b| kind '|%d| "constructor.")) + (unless isRecordOrUnion + (setq abb (getdatabase top 'abbreviation)) + (setq sourceFile (getdatabase top 'sourcefile)) + (|sayBrightly| + (cons " Abbreviation for" + (append (|bright| top) (cons "is" (|bright| abb))))) + (if (|isExposedConstructor| top) + (setq verb "is") + (setq verb "is not")) + (|sayBrightly| + (cons " This constructor" + (append (|bright| verb) (list "exposed in this frame." )))) + (|sayBrightly| + (cons " Issue" + (append (|bright| (strconc ")edit " (|namestring| sourceFile))) + (cons "to see algebra source code for" + (append (|bright| abb) (list '|%l|))))))) + (dolist (item |$options|) + (setq opt (|selectOptionLC| (car item) |$showOptions| '|optionError|)) + (cond + ((eq opt '|attributes|) + (|centerAndHighlight| "Attributes" $linelength (|specialChar| '|hbar|)) + (if isRecordOrUnion + (|sayBrightly| " Records and Unions have no attributes.") + (progn + (|sayBrightly| "") + (setq attList + (remdup + (msort + (mapcar #'(lambda (unit2) (car unit2)) (reverse (elt unit 2)))))) + (|say2PerLine| + (mapcar #'|formatAttribute| attList)) + nil))) + ((eq opt '|operations|) + (setq |$commentedOps| 0) +; --new form is ( ) + (|centerAndHighlight| "Operations" $linelength (|specialChar| '|hbar|)) + (|sayBrightly| "") + (cond + (isRecordOrUnion + (setq constructorFunction (getl top '|makeFunctionList|)) + (unless constructorFunction + (|systemErrorHere| "reportOpsFromUnitDirectly")) + (setq tmp1 + (funcall constructorFunction '$ unitForm |$CategoryFrame|)) + (setq funlist (car tmp1)) + (setq sigList + (remdup + (msort + (dolist (fun funlist (nreverse0 tmp2)) + (push `(((,(caar fun) ,(cadar fun)) t (,(caddar fun) 0 1))) + tmp2)))))) + (t + (setq sigList + (remdup (msort (|getOplistForConstructorForm| unitForm)))))) + (|say2PerLine| + (mapcar #'(lambda (x) (|formatOperation| x unit)) sigList)) + (unless (= |$commentedOps| 0) + (|sayBrightly| + (list "Functions that are not yet implemented are preceded by" + (|bright| "--")))) + (|sayBrightly| "")))) + nil)) + +@ + \defun{reportOpsFromUnitDirectly1}{reportOpsFromUnitDirectly1} \calls{reportOpsFromUnitDirectly1}{pathname} \calls{reportOpsFromUnitDirectly1}{erase} @@ -29274,8 +29478,10 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> +<> <> <> <> diff --git a/changelog b/changelog index 874e108..0a53bbe 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20091229 tpd src/axiom-website/patches.html 20091229.01.tpd.patch +20091229 tpd src/interp/i-syscmd.lisp treeshake +20091229 tpd books/bookvol5 treeshake 20091228 tpd src/axiom-website/patches.html 20091228.01.tpd.patch 20091228 tpd src/interp/i-syscmd.lisp treeshake 20091228 tpd books/bookvol5 treeshake diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 5449649..8df5d0f 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2338,5 +2338,7 @@ books/bookvol5 treeshake
books/bookvol5 treeshake
20091228.01.tpd.patch books/bookvol5 treeshake i-syscmd
+20091229.01.tpd.patch +books/bookvol5 treeshake i-syscmd
diff --git a/src/interp/i-syscmd.lisp.pamphlet b/src/interp/i-syscmd.lisp.pamphlet index f133124..04223be 100644 --- a/src/interp/i-syscmd.lisp.pamphlet +++ b/src/interp/i-syscmd.lisp.pamphlet @@ -223,470 +223,6 @@ (CONS (|fillerSpaces| 29 (MAKESTRING ".")) (CONS '| | (CONS |$streamCount| NIL)))))))))) -;reportOperations(oldArg,u) == -; -- u might be an uppercased version of oldArg -; $env:local := [[NIL]] -; $eval:local := true --generate code-- don't just type analyze -; $genValue:local := true --evaluate all generated code -; null u => nil -; $doNotAddEmptyModeIfTrue: local:= true -; u = $quadSymbol => -; sayBrightly ['" mode denotes", :bright '"any", "type"] -; u = "%" => -; sayKeyedMsg("S2IZ0063",NIL) -; sayKeyedMsg("S2IZ0064",NIL) -; u isnt ['Record,:.] and u isnt ['Union,:.] and -; null(isNameOfType u) and u isnt ['typeOf,.] => -; if ATOM oldArg then oldArg := [oldArg] -; sayKeyedMsg("S2IZ0063",NIL) -; for op in oldArg repeat -; sayKeyedMsg("S2IZ0062",[opOf op]) -; (v := isDomainValuedVariable u) => reportOpsFromUnitDirectly0 v -; unitForm:= -; atom u => opOf unabbrev u -; unabbrev u -; atom unitForm => reportOpsFromLisplib0(unitForm,u) -; unitForm' := evaluateType unitForm -; tree := mkAtree removeZeroOneDestructively unitForm -; (unitForm' := isType tree) => reportOpsFromUnitDirectly0 unitForm' -; sayKeyedMsg("S2IZ0041",[unitForm]) - -;(DEFUN |reportOperations| (|oldArg| |u|) -; (PROG (|$env| |$eval| |$genValue| |$doNotAddEmptyModeIfTrue| -; |ISTMP#1| |v| |unitForm| |tree| |unitForm'|) -; (DECLARE (SPECIAL |$env| |$eval| |$genValue| |$quadSymbol| -; |$doNotAddEmptyModeIfTrue|)) -; (RETURN -; (SEQ (PROGN -; (SPADLET |$env| (CONS (CONS NIL NIL) NIL)) -; (SPADLET |$eval| 'T) -; (SPADLET |$genValue| 'T) -; (COND -; ((NULL |u|) NIL) -; ('T (SPADLET |$doNotAddEmptyModeIfTrue| 'T) -; (COND -; ((BOOT-EQUAL |u| |$quadSymbol|) -; (|sayBrightly| -; (CONS (MAKESTRING " mode denotes") -; (APPEND (|bright| (MAKESTRING "any")) -; (CONS '|type| NIL))))) -; ((BOOT-EQUAL |u| '%) (|sayKeyedMsg| 'S2IZ0063 NIL) -; (|sayKeyedMsg| 'S2IZ0064 NIL)) -; ((AND (NULL (AND (PAIRP |u|) -; (EQ (QCAR |u|) '|Record|))) -; (NULL (AND (PAIRP |u|) -; (EQ (QCAR |u|) '|Union|))) -; (NULL (|isNameOfType| |u|)) -; (NULL (AND (PAIRP |u|) -; (EQ (QCAR |u|) '|typeOf|) -; (PROGN -; (SPADLET |ISTMP#1| (QCDR |u|)) -; (AND (PAIRP |ISTMP#1|) -; (EQ (QCDR |ISTMP#1|) NIL)))))) -; (COND -; ((ATOM |oldArg|) -; (SPADLET |oldArg| (CONS |oldArg| NIL)))) -; (|sayKeyedMsg| 'S2IZ0063 NIL) -; (DO ((G166662 |oldArg| (CDR G166662)) -; (|op| NIL)) -; ((OR (ATOM G166662) -; (PROGN (SETQ |op| (CAR G166662)) NIL)) -; NIL) -; (SEQ (EXIT (|sayKeyedMsg| 'S2IZ0062 -; (CONS (|opOf| |op|) NIL)))))) -; ((SPADLET |v| (|isDomainValuedVariable| |u|)) -; (|reportOpsFromUnitDirectly0| |v|)) -; ('T -; (SPADLET |unitForm| -; (COND -; ((ATOM |u|) (|opOf| (|unabbrev| |u|))) -; ('T (|unabbrev| |u|)))) -; (COND -; ((ATOM |unitForm|) -; (|reportOpsFromLisplib0| |unitForm| |u|)) -; ('T -; (SPADLET |unitForm'| (|evaluateType| |unitForm|)) -; (SPADLET |tree| -; (|mkAtree| -; (|removeZeroOneDestructively| -; |unitForm|))) -; (COND -; ((SPADLET |unitForm'| (|isType| |tree|)) -; (|reportOpsFromUnitDirectly0| |unitForm'|)) -; ('T -; (|sayKeyedMsg| 'S2IZ0041 -; (CONS |unitForm| NIL))))))))))))))) - -;reportOpsFromUnitDirectly0 D == -; $useEditorForShowOutput => -; reportOpsFromUnitDirectly1 D -; reportOpsFromUnitDirectly D - -;reportOpsFromUnitDirectly1 D == -; showFile := pathname ['SHOW,'LISTING,$listingDirectory] -; _$ERASE showFile -; $sayBrightlyStream : fluid := -; DEFIOSTREAM([['FILE,:showFile], '(MODE . OUTPUT)],255,0) -; sayShowWarning() -; reportOpsFromUnitDirectly D -; SHUT $sayBrightlyStream -; editFile showFile - -;(DEFUN |reportOpsFromUnitDirectly1| (D) -; (PROG (|$sayBrightlyStream| |showFile|) -; (DECLARE (SPECIAL |$sayBrightlyStream| $ERASE |$listingDirectory|)) -; (RETURN -; (PROGN -; (SPADLET |showFile| -; (|pathname| -; (CONS 'SHOW -; (CONS 'LISTING -; (CONS |$listingDirectory| NIL))))) -; ($ERASE |showFile|) -; (SPADLET |$sayBrightlyStream| -; (DEFIOSTREAM -; (CONS (CONS 'FILE |showFile|) -; (CONS '(MODE . OUTPUT) NIL)) -; 255 0)) -; (|sayShowWarning|) -; (|reportOpsFromUnitDirectly| D) -; (SHUT |$sayBrightlyStream|) -; (|editFile| |showFile|))))) - -;sayShowWarning() == -; sayBrightly -; '"Warning: this is a temporary file and will be deleted the next" -; sayBrightly -; '" time you use )show. Rename it and FILE if you wish to" -; sayBrightly -; '" save the contents." -; sayBrightly '"" - -;(DEFUN |sayShowWarning| () -; (PROGN -; (|sayBrightly| -; (MAKESTRING -; "Warning: this is a temporary file and will be deleted the next")) -; (|sayBrightly| -; (MAKESTRING -; " time you use )show. Rename it and FILE if you wish to")) -; (|sayBrightly| (MAKESTRING " save the contents.")) -; (|sayBrightly| (MAKESTRING "")))) - -;reportOpsFromLisplib0(unitForm,u) == -; $useEditorForShowOutput => reportOpsFromLisplib1(unitForm,u) -; reportOpsFromLisplib(unitForm,u) - -;(DEFUN |reportOpsFromLisplib0| (|unitForm| |u|) -; (declare (special |$useEditorForShowOutput|)) -; (COND -; (|$useEditorForShowOutput| -; (|reportOpsFromLisplib1| |unitForm| |u|)) -; ('T (|reportOpsFromLisplib| |unitForm| |u|)))) - -;reportOpsFromLisplib1(unitForm,u) == -; showFile := pathname ['SHOW,'LISTING,$listingDirectory] -; _$ERASE showFile -; $sayBrightlyStream : fluid := -; DEFIOSTREAM([['FILE,:showFile], '(MODE . OUTPUT)],255,0) -; sayShowWarning() -; reportOpsFromLisplib(unitForm,u) -; SHUT $sayBrightlyStream -; editFile showFile - -;(DEFUN |reportOpsFromLisplib1| (|unitForm| |u|) -; (PROG (|$sayBrightlyStream| |showFile|) -; (DECLARE (SPECIAL |$sayBrightlyStream| $ERASE |$listingDirectory|)) -; (RETURN -; (PROGN -; (SPADLET |showFile| -; (|pathname| -; (CONS 'SHOW -; (CONS 'LISTING -; (CONS |$listingDirectory| NIL))))) -; ($ERASE |showFile|) -; (SPADLET |$sayBrightlyStream| -; (DEFIOSTREAM -; (CONS (CONS 'FILE |showFile|) -; (CONS '(MODE . OUTPUT) NIL)) -; 255 0)) -; (|sayShowWarning|) -; (|reportOpsFromLisplib| |unitForm| |u|) -; (SHUT |$sayBrightlyStream|) -; (|editFile| |showFile|))))) - -;reportOpsFromUnitDirectly unitForm == -; isRecordOrUnion := unitForm is [a,:.] and a in '(Record Union) -; unit:= evalDomain unitForm -; top:= CAR unitForm -; kind:= GETDATABASE(top,'CONSTRUCTORKIND) -; sayBrightly concat('%b,formatOpType unitForm, -; '%d,'"is a",'%b,kind,'%d, '"constructor.") -; if not isRecordOrUnion then -; abb := GETDATABASE(top,'ABBREVIATION) -; sourceFile := GETDATABASE(top,'SOURCEFILE) -; sayBrightly ['" Abbreviation for",:bright top,'"is",:bright abb] -; verb := -; isExposedConstructor top => '"is" -; '"is not" -; sayBrightly ['" This constructor",:bright verb, -; '"exposed in this frame."] -; sayBrightly ['" Issue",:bright STRCONC('")edit ", -; namestring sourceFile),'"to see algebra source code for", -; :bright abb,'%l] -; for [opt] in $options repeat -; opt := selectOptionLC(opt,$showOptions,'optionError) -; opt = 'attributes => -; centerAndHighlight('"Attributes",$LINELENGTH,specialChar 'hbar) -; isRecordOrUnion => -; sayBrightly '" Records and Unions have no attributes." -; sayBrightly '"" -; attList:= REMDUP MSORT [x for [x,:.] in unit.2] -; say2PerLine [formatAttribute x for x in attList] -; NIL -; opt = 'operations => -; $commentedOps: local := 0 -; --new form is ( ) -; centerAndHighlight('"Operations",$LINELENGTH,specialChar 'hbar) -; sayBrightly '"" -; if isRecordOrUnion -; then -; constructorFunction:= GET(top,"makeFunctionList") or -; systemErrorHere '"reportOpsFromUnitDirectly" -; [funlist,.]:= FUNCALL(constructorFunction,"$",unitForm, -; $CategoryFrame) -; sigList := REMDUP MSORT [[[a,b],true,[c,0,1]] for -; [a,b,c] in funlist] -; else -; sigList:= REMDUP MSORT getOplistForConstructorForm unitForm -; say2PerLine [formatOperation(x,unit) for x in sigList] -; if $commentedOps ^= 0 then -; sayBrightly -; ['"Functions that are not yet implemented are preceded by", -; :bright '"--"] -; sayBrightly '"" -; NIL - -(DEFUN |reportOpsFromUnitDirectly| (|unitForm|) - (PROG (|$commentedOps| |isRecordOrUnion| |unit| |top| |kind| |abb| - |sourceFile| |verb| |opt| |x| |attList| - |constructorFunction| |LETTMP#1| |funlist| |a| |b| |c| - |sigList|) - (DECLARE (SPECIAL |$commentedOps| |$CategoryFrame| $LINELENGTH |$options| - |$showOptions|)) - (RETURN - (SEQ (PROGN - (SPADLET |isRecordOrUnion| - (AND (PAIRP |unitForm|) - (PROGN (SPADLET |a| (QCAR |unitForm|)) 'T) - (|member| |a| '(|Record| |Union|)))) - (SPADLET |unit| (|evalDomain| |unitForm|)) - (SPADLET |top| (CAR |unitForm|)) - (SPADLET |kind| (GETDATABASE |top| 'CONSTRUCTORKIND)) - (|sayBrightly| - (|concat| '|%b| (|formatOpType| |unitForm|) '|%d| - (MAKESTRING "is a") '|%b| |kind| '|%d| - (MAKESTRING "constructor."))) - (COND - ((NULL |isRecordOrUnion|) - (SPADLET |abb| (GETDATABASE |top| 'ABBREVIATION)) - (SPADLET |sourceFile| (GETDATABASE |top| 'SOURCEFILE)) - (|sayBrightly| - (CONS (MAKESTRING " Abbreviation for") - (APPEND (|bright| |top|) - (CONS (MAKESTRING "is") - (|bright| |abb|))))) - (SPADLET |verb| - (COND - ((|isExposedConstructor| |top|) - (MAKESTRING "is")) - ('T (MAKESTRING "is not")))) - (|sayBrightly| - (CONS (MAKESTRING " This constructor") - (APPEND (|bright| |verb|) - (CONS (MAKESTRING - "exposed in this frame.") - NIL)))) - (|sayBrightly| - (CONS (MAKESTRING " Issue") - (APPEND (|bright| - (STRCONC (MAKESTRING ")edit ") - (|namestring| |sourceFile|))) - (CONS (MAKESTRING - "to see algebra source code for") - (APPEND (|bright| |abb|) - (CONS '|%l| NIL)))))))) - (DO ((G166753 |$options| (CDR G166753)) - (G166737 NIL)) - ((OR (ATOM G166753) - (PROGN (SETQ G166737 (CAR G166753)) NIL) - (PROGN - (PROGN - (SPADLET |opt| (CAR G166737)) - G166737) - NIL)) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |opt| - (|selectOptionLC| |opt| - |$showOptions| '|optionError|)) - (COND - ((BOOT-EQUAL |opt| '|attributes|) - (|centerAndHighlight| - (MAKESTRING "Attributes") - $LINELENGTH (|specialChar| '|hbar|)) - (COND - (|isRecordOrUnion| - (|sayBrightly| - (MAKESTRING - " Records and Unions have no attributes."))) - ('T (|sayBrightly| (MAKESTRING "")) - (SPADLET |attList| - (REMDUP - (MSORT - (PROG (G166765) - (SPADLET G166765 NIL) - (RETURN - (DO - ((G166771 - (ELT |unit| 2) - (CDR G166771)) - (G166720 NIL)) - ((OR (ATOM G166771) - (PROGN - (SETQ G166720 - (CAR G166771)) - NIL) - (PROGN - (PROGN - (SPADLET |x| - (CAR - G166720)) - G166720) - NIL)) - (NREVERSE0 - G166765)) - (SEQ - (EXIT - (SETQ G166765 - (CONS |x| - G166765)))))))))) - (|say2PerLine| - (PROG (G166782) - (SPADLET G166782 NIL) - (RETURN - (DO - ((G166787 |attList| - (CDR G166787)) - (|x| NIL)) - ((OR (ATOM G166787) - (PROGN - (SETQ |x| - (CAR G166787)) - NIL)) - (NREVERSE0 G166782)) - (SEQ - (EXIT - (SETQ G166782 - (CONS - (|formatAttribute| |x|) - G166782)))))))) - NIL))) - ((BOOT-EQUAL |opt| '|operations|) - (SPADLET |$commentedOps| 0) - (|centerAndHighlight| - (MAKESTRING "Operations") - $LINELENGTH (|specialChar| '|hbar|)) - (|sayBrightly| (MAKESTRING "")) - (COND - (|isRecordOrUnion| - (SPADLET |constructorFunction| - (OR - (GETL |top| '|makeFunctionList|) - (|systemErrorHere| - (MAKESTRING - "reportOpsFromUnitDirectly")))) - (SPADLET |LETTMP#1| - (FUNCALL |constructorFunction| '$ - |unitForm| |$CategoryFrame|)) - (SPADLET |funlist| - (CAR |LETTMP#1|)) - (SPADLET |sigList| - (REMDUP - (MSORT - (PROG (G166798) - (SPADLET G166798 NIL) - (RETURN - (DO - ((G166804 |funlist| - (CDR G166804)) - (G166729 NIL)) - ((OR (ATOM G166804) - (PROGN - (SETQ G166729 - (CAR G166804)) - NIL) - (PROGN - (PROGN - (SPADLET |a| - (CAR G166729)) - (SPADLET |b| - (CADR G166729)) - (SPADLET |c| - (CADDR G166729)) - G166729) - NIL)) - (NREVERSE0 G166798)) - (SEQ - (EXIT - (SETQ G166798 - (CONS - (CONS - (CONS |a| - (CONS |b| NIL)) - (CONS 'T - (CONS - (CONS |c| - (CONS 0 - (CONS 1 NIL))) - NIL))) - G166798))))))))))) - ('T - (SPADLET |sigList| - (REMDUP - (MSORT - (|getOplistForConstructorForm| - |unitForm|)))))) - (|say2PerLine| - (PROG (G166815) - (SPADLET G166815 NIL) - (RETURN - (DO - ((G166820 |sigList| - (CDR G166820)) - (|x| NIL)) - ((OR (ATOM G166820) - (PROGN - (SETQ |x| (CAR G166820)) - NIL)) - (NREVERSE0 G166815)) - (SEQ - (EXIT - (SETQ G166815 - (CONS - (|formatOperation| |x| - |unit|) - G166815)))))))) - (COND - ((NEQUAL |$commentedOps| 0) - (|sayBrightly| - (CONS - (MAKESTRING - "Functions that are not yet implemented are preceded by") - (|bright| (MAKESTRING "--")))))) - (|sayBrightly| (MAKESTRING "")))))))) - NIL))))) - ;reportOpsFromLisplib(op,u) == ; null(fn:= constructor? op) => sayKeyedMsg("S2IZ0054",[u]) ; argml := @@ -728,182 +264,182 @@ ; opt = 'operations => displayOperationsFromLisplib functorForm ; nil -(DEFUN |reportOpsFromLisplib| (|op| |u|) - (PROG (|fn| |s| |typ| |nArgs| |argList| |functorForm| |argml| - |functorFormWithDecl| |verb| |sourceFile| |opt| |x| |attList|) - (declare (special $LINELENGTH |$showOptions| |$options| - |$FormalMapVariableList|)) - (RETURN - (SEQ (COND - ((NULL (SPADLET |fn| (|constructor?| |op|))) - (|sayKeyedMsg| 'S2IZ0054 (CONS |u| NIL))) - ('T - (SPADLET |argml| - (COND - ((SPADLET |s| - (|getConstructorSignature| |op|)) - (KDR |s|)) - ('T NIL))) - (SPADLET |typ| (GETDATABASE |op| 'CONSTRUCTORKIND)) - (SPADLET |nArgs| (|#| |argml|)) - (SPADLET |argList| - (KDR (GETDATABASE |op| 'CONSTRUCTORFORM))) - (SPADLET |functorForm| (CONS |op| |argList|)) - (SPADLET |argml| - (EQSUBSTLIST |argList| |$FormalMapVariableList| - |argml|)) - (SPADLET |functorFormWithDecl| - (CONS |op| - (PROG (G166872) - (SPADLET G166872 NIL) - (RETURN - (DO ((G166878 |argList| - (CDR G166878)) - (|a| NIL) - (G166879 |argml| - (CDR G166879)) - (|m| NIL)) - ((OR (ATOM G166878) - (PROGN - (SETQ |a| (CAR G166878)) - NIL) - (ATOM G166879) - (PROGN - (SETQ |m| (CAR G166879)) - NIL)) - (NREVERSE0 G166872)) - (SEQ - (EXIT - (SETQ G166872 - (CONS - (CONS '|:| - (CONS |a| (CONS |m| NIL))) - G166872))))))))) - (|sayBrightly| - (|concat| - (|bright| - (|form2StringWithWhere| - |functorFormWithDecl|)) - (MAKESTRING " is a") (|bright| |typ|) - (MAKESTRING "constructor"))) - (|sayBrightly| - (CONS (MAKESTRING " Abbreviation for") - (APPEND (|bright| |op|) - (CONS (MAKESTRING "is") - (|bright| |fn|))))) - (SPADLET |verb| - (COND - ((|isExposedConstructor| |op|) - (MAKESTRING "is")) - ('T (MAKESTRING "is not")))) - (|sayBrightly| - (CONS (MAKESTRING " This constructor") - (APPEND (|bright| |verb|) - (CONS (MAKESTRING - "exposed in this frame.") - NIL)))) - (SPADLET |sourceFile| (GETDATABASE |op| 'SOURCEFILE)) - (|sayBrightly| - (CONS (MAKESTRING " Issue") - (APPEND (|bright| - (STRCONC (MAKESTRING ")edit ") - (|namestring| |sourceFile|))) - (CONS (MAKESTRING - "to see algebra source code for") - (APPEND (|bright| |fn|) - (CONS '|%l| NIL)))))) - (DO ((G166896 |$options| (CDR G166896)) - (G166863 NIL)) - ((OR (ATOM G166896) - (PROGN (SETQ G166863 (CAR G166896)) NIL) - (PROGN - (PROGN - (SPADLET |opt| (CAR G166863)) - G166863) - NIL)) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |opt| - (|selectOptionLC| |opt| - |$showOptions| '|optionError|)) - (COND - ((BOOT-EQUAL |opt| '|layout|) - (|dc1| |fn|)) - ((BOOT-EQUAL |opt| '|views|) - (|sayBrightly| - (CONS (MAKESTRING "To get") - (APPEND - (|bright| (MAKESTRING "views")) - (CONS - (MAKESTRING - "you must give parameters of constructor") - NIL))))) - ((BOOT-EQUAL |opt| '|attributes|) - (|centerAndHighlight| - (MAKESTRING "Attributes") - $LINELENGTH - (|specialChar| '|hbar|)) - (|sayBrightly| (MAKESTRING "")) - (SPADLET |attList| - (REMDUP - (MSORT - (PROG (G166908) - (SPADLET G166908 NIL) - (RETURN - (DO - ((G166914 - (GETDATABASE |op| - 'ATTRIBUTES) - (CDR G166914)) - (G166858 NIL)) - ((OR (ATOM G166914) - (PROGN - (SETQ G166858 - (CAR G166914)) - NIL) - (PROGN - (PROGN - (SPADLET |x| - (CAR G166858)) - G166858) - NIL)) - (NREVERSE0 G166908)) - (SEQ - (EXIT - (SETQ G166908 - (CONS |x| - G166908)))))))))) - (COND - ((NULL |attList|) - (|sayBrightly| - (|concat| '|%b| - (|form2String| |functorForm|) - '|%d| '|has no attributes.| '|%l|))) - ('T - (|say2PerLine| - (PROG (G166925) - (SPADLET G166925 NIL) - (RETURN - (DO - ((G166930 |attList| - (CDR G166930)) - (|x| NIL)) - ((OR (ATOM G166930) - (PROGN - (SETQ |x| (CAR G166930)) - NIL)) - (NREVERSE0 G166925)) - (SEQ - (EXIT - (SETQ G166925 - (CONS - (|formatAttribute| |x|) - G166925)))))))) - NIL))) - ((BOOT-EQUAL |opt| '|operations|) - (|displayOperationsFromLisplib| - |functorForm|)) - ('T NIL)))))))))))) +;(DEFUN |reportOpsFromLisplib| (|op| |u|) +; (PROG (|fn| |s| |typ| |nArgs| |argList| |functorForm| |argml| +; |functorFormWithDecl| |verb| |sourceFile| |opt| |x| |attList|) +; (declare (special $LINELENGTH |$showOptions| |$options| +; |$FormalMapVariableList|)) +; (RETURN +; (SEQ (COND +; ((NULL (SPADLET |fn| (|constructor?| |op|))) +; (|sayKeyedMsg| 'S2IZ0054 (CONS |u| NIL))) +; ('T +; (SPADLET |argml| +; (COND +; ((SPADLET |s| +; (|getConstructorSignature| |op|)) +; (KDR |s|)) +; ('T NIL))) +; (SPADLET |typ| (GETDATABASE |op| 'CONSTRUCTORKIND)) +; (SPADLET |nArgs| (|#| |argml|)) +; (SPADLET |argList| +; (KDR (GETDATABASE |op| 'CONSTRUCTORFORM))) +; (SPADLET |functorForm| (CONS |op| |argList|)) +; (SPADLET |argml| +; (EQSUBSTLIST |argList| |$FormalMapVariableList| +; |argml|)) +; (SPADLET |functorFormWithDecl| +; (CONS |op| +; (PROG (G166872) +; (SPADLET G166872 NIL) +; (RETURN +; (DO ((G166878 |argList| +; (CDR G166878)) +; (|a| NIL) +; (G166879 |argml| +; (CDR G166879)) +; (|m| NIL)) +; ((OR (ATOM G166878) +; (PROGN +; (SETQ |a| (CAR G166878)) +; NIL) +; (ATOM G166879) +; (PROGN +; (SETQ |m| (CAR G166879)) +; NIL)) +; (NREVERSE0 G166872)) +; (SEQ +; (EXIT +; (SETQ G166872 +; (CONS +; (CONS '|:| +; (CONS |a| (CONS |m| NIL))) +; G166872))))))))) +; (|sayBrightly| +; (|concat| +; (|bright| +; (|form2StringWithWhere| +; |functorFormWithDecl|)) +; (MAKESTRING " is a") (|bright| |typ|) +; (MAKESTRING "constructor"))) +; (|sayBrightly| +; (CONS (MAKESTRING " Abbreviation for") +; (APPEND (|bright| |op|) +; (CONS (MAKESTRING "is") +; (|bright| |fn|))))) +; (SPADLET |verb| +; (COND +; ((|isExposedConstructor| |op|) +; (MAKESTRING "is")) +; ('T (MAKESTRING "is not")))) +; (|sayBrightly| +; (CONS (MAKESTRING " This constructor") +; (APPEND (|bright| |verb|) +; (CONS (MAKESTRING +; "exposed in this frame.") +; NIL)))) +; (SPADLET |sourceFile| (GETDATABASE |op| 'SOURCEFILE)) +; (|sayBrightly| +; (CONS (MAKESTRING " Issue") +; (APPEND (|bright| +; (STRCONC (MAKESTRING ")edit ") +; (|namestring| |sourceFile|))) +; (CONS (MAKESTRING +; "to see algebra source code for") +; (APPEND (|bright| |fn|) +; (CONS '|%l| NIL)))))) +; (DO ((G166896 |$options| (CDR G166896)) +; (G166863 NIL)) +; ((OR (ATOM G166896) +; (PROGN (SETQ G166863 (CAR G166896)) NIL) +; (PROGN +; (PROGN +; (SPADLET |opt| (CAR G166863)) +; G166863) +; NIL)) +; NIL) +; (SEQ (EXIT (PROGN +; (SPADLET |opt| +; (|selectOptionLC| |opt| +; |$showOptions| '|optionError|)) +; (COND +; ((BOOT-EQUAL |opt| '|layout|) +; (|dc1| |fn|)) +; ((BOOT-EQUAL |opt| '|views|) +; (|sayBrightly| +; (CONS (MAKESTRING "To get") +; (APPEND +; (|bright| (MAKESTRING "views")) +; (CONS +; (MAKESTRING +; "you must give parameters of constructor") +; NIL))))) +; ((BOOT-EQUAL |opt| '|attributes|) +; (|centerAndHighlight| +; (MAKESTRING "Attributes") +; $LINELENGTH +; (|specialChar| '|hbar|)) +; (|sayBrightly| (MAKESTRING "")) +; (SPADLET |attList| +; (REMDUP +; (MSORT +; (PROG (G166908) +; (SPADLET G166908 NIL) +; (RETURN +; (DO +; ((G166914 +; (GETDATABASE |op| +; 'ATTRIBUTES) +; (CDR G166914)) +; (G166858 NIL)) +; ((OR (ATOM G166914) +; (PROGN +; (SETQ G166858 +; (CAR G166914)) +; NIL) +; (PROGN +; (PROGN +; (SPADLET |x| +; (CAR G166858)) +; G166858) +; NIL)) +; (NREVERSE0 G166908)) +; (SEQ +; (EXIT +; (SETQ G166908 +; (CONS |x| +; G166908)))))))))) +; (COND +; ((NULL |attList|) +; (|sayBrightly| +; (|concat| '|%b| +; (|form2String| |functorForm|) +; '|%d| '|has no attributes.| '|%l|))) +; ('T +; (|say2PerLine| +; (PROG (G166925) +; (SPADLET G166925 NIL) +; (RETURN +; (DO +; ((G166930 |attList| +; (CDR G166930)) +; (|x| NIL)) +; ((OR (ATOM G166930) +; (PROGN +; (SETQ |x| (CAR G166930)) +; NIL)) +; (NREVERSE0 G166925)) +; (SEQ +; (EXIT +; (SETQ G166925 +; (CONS +; (|formatAttribute| |x|) +; G166925)))))))) +; NIL))) +; ((BOOT-EQUAL |opt| '|operations|) +; (|displayOperationsFromLisplib| +; |functorForm|)) +; ('T NIL)))))))))))) ;displayOperationsFromLisplib form == ; [name,:argl] := form