diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index c26e582..d330d97 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -8372,7 +8372,7 @@ new system commands provided you handle the argument parsing. \calls{splitIntoOptionBlocks}{stripSpaces} <>= (defun |splitIntoOptionBlocks| (str) - (let (optionBlocks inString block (blockStart 0) (parenCount 0) blockList) + (let (inString block (blockStart 0) (parenCount 0) blockList) (dotimes (i (1- (|#| str))) (cond ((char= (elt str i) #\" ) (setq inString (null inString))) @@ -8852,6 +8852,97 @@ The \verb|$msgdbPrims| variable is set to: @ +\defun{displayValue}{} +\calls{displayValue}{sayMSG} +\calls{displayValue}{fixObjectForPrinting} +\calls{displayValue}{pname} +\calls{displayValue}{objValUnwrap} +\calls{displayValue}{objMode} +\calls{displayValue}{displayRule} +\calls{displayValue}{strconc} +\calls{displayValue}{prefix2String} +\calls{displayValue}{objMode} +\calls{displayValue}{getdatabase} +\calls{displayValue}{concat} +\calls{displayValue}{form2String} +\calls{displayValue}{mathprint} +\calls{displayValue}{outputFormat} +\calls{displayValue}{objMode} +\usesdollar{displayValue}{op} +\usesdollar{displayValue}{EmptyMode} +<>= +(defun |displayValue| (|$op| u omitVariableNameIfTrue) + (declare (special |$op|)) + (let (expr op rhs label labmode) + (declare (special |$EmptyMode|)) + (if (null u) + (|sayMSG| + (list '| Value of | (|fixObjectForPrinting| (pname |$op|)) ": (none)")) + (progn + (setq expr (|objValUnwrap| u)) + (if (or (and (pairp expr) (progn (setq op (qcar expr)) t) (eq op 'map)) + (equal (|objMode| u) |$EmptyMode|)) + (|displayRule| |$op| expr) + (progn + (setq |label| + (cond + (|omitVariableNameIfTrue| + (setq |rhs| "): ") + "Value (has type ") + ('T + (setq |rhs| ": ") + (strconc "Value of " (pname |$op|) ": ")))) + (setq labmode (|prefix2String| (|objMode| u))) + (when (atom labmode) (setq labmode (list labmode))) + (if (eq (getdatabase expr 'constructorkind) '|domain|) + (|sayMSG| (|concat| " " label labmode rhs (|form2String| expr))) + (|mathprint| + (list 'concat label + (append labmode (list rhs (|outputFormat| expr (|objMode| u))))))) + nil)))))) + +@ + +\defun{displayType}{displayType} +\calls{displayType}{sayMSG} +\calls{displayType}{fixObjectForPrinting} +\calls{displayType}{pname} +\calls{displayType}{prefix2String} +\calls{displayType}{objMode} +\calls{displayType}{concat} +\usesdollar{displayType}{op} +<>= +(defun |displayType| (|$op| u omitVariableNameIfTrue) + (declare (special |$op|) (ignore omitVariableNameIfTrue)) + (let (type) + (if (null u) + (|sayMSG| + (list " Type of value of " (|fixObjectForPrinting| (pname |$op|)) + ": (none)")) + (progn + (setq type (|prefix2String| (|objMode| u))) + (when (atom type) (setq type (list type))) + (|sayMSG| + (|concat| + (cons " Type of value of " + (cons (|fixObjectForPrinting| (pname |$op|)) + (cons ": " type))))) + nil)))) + +@ + +\defun{getAndSay}{getAndSay} +\calls{getAndSay}{getI} +\calls{getAndSay}{sayMSG} +<>= +(defun |getAndSay| (v prop) + (let (val) + (if (setq val (|getI| v prop)) + (|sayMSG| (cons '| | (cons val (cons '|%l| nil)))) + (|sayMSG| (cons '| none| (cons '|%l| nil)))))) + +@ + \defun{displayProperties}{displayProperties} \calls{displayProperties}{getInterpMacroNames} \calls{displayProperties}{getParserMacroNames} @@ -9006,6 +9097,21 @@ The \verb|$msgdbPrims| variable is set to: @ +\defun{displayCondition}{displayCondition} +\calls{displayCondition}{bright} +\calls{displayCondition}{sayBrightly} +\calls{displayCondition}{concat} +\calls{displayCondition}{pred2English} +<>= +(defun |displayCondition| (v condition giveVariableIfNil) + (let (varPart condPart) + (when giveVariableIfNil (setq varPart (cons '| of| (|bright| v)))) + (setq condPart (or condition '|true|)) + (|sayBrightly| + (|concat| '| condition| varPart '|: | (|pred2English| condPart))))) + +@ + \defun{interpFunctionDepAlists}{interpFunctionDepAlists} \calls{interpFunctionDepAlists}{putalist} \calls{interpFunctionDepAlists}{getalist} @@ -9130,7 +9236,7 @@ The \verb|$msgdbPrims| variable is set to: \calls{handleParsedSystemCommands}{systemCommand} <>= (defun |handleParsedSystemCommands| (unabr optionList) - (declare (ingore unabr)) + (declare (ignore unabr)) (let (restOptionList parcmd trail) (setq restOptionList (mapcar #'|dumbTokenize| (cdr optionList))) (setq parcmd (|parseSystemCmd| (car optionList))) @@ -15199,6 +15305,78 @@ o )history \fnref{edit} \fnref{history}} +\defun{read}{The )read command} +\calls{}{readSpad2Cmd} +<>= +(defun |read| (arg) (|readSpad2Cmd| arg)) + +@ + +\defun{readSpad2Cmd}{} +\calls{readSpad2Cmd}{selectOptionLC} +\calls{readSpad2Cmd}{optionError} +\calls{readSpad2Cmd}{pathname} +\calls{readSpad2Cmd}{pathnameTypeId} +\calls{readSpad2Cmd}{makePathname} +\calls{readSpad2Cmd}{pathnameName} +\calls{readSpad2Cmd}{mergePathnames} +\calls{readSpad2Cmd}{findfile} +\calls{readSpad2Cmd}{throwKeyedMsg} +\calls{readSpad2Cmd}{namestring} +\calls{readSpad2Cmd}{upcase} +\calls{readSpad2Cmd}{member} +\calls{readSpad2Cmd}{/read} +\usesdollar{readSpad2Cmd}{InteractiveMode} +\usesdollar{readSpad2Cmd}{findfile} +\usesdollar{readSpad2Cmd}{UserLevel} +\usesdollar{readSpad2Cmd}{options} +\uses{readSpad2Cmd}{/editfile} +<>= +(defun |readSpad2Cmd| (arg) + (prog (|$InteractiveMode| fullopt ifthere quiet ef devFTs fileTypes + ll ft upft fs) + (declare (special |$InteractiveMode| $findfile |$UserLevel| |$options| + /editfile)) + (setq |$InteractiveMode| t) + (dolist (opt |$options|) + (setq fullopt + (|selectOptionLC| (caar opt) '(|quiet| |test| |ifthere|) '|optionError|)) + (cond + ((eq fullopt '|ifthere|) (setq ifthere t)) + ((eq fullopt '|quiet|) (setq quiet t)))) + (setq ef (|pathname| /editfile)) + (when (eq (|pathnameTypeId| ef) 'spad) + (setq ef (|makePathname| (|pathnameName| ef) "*" "*"))) + (if arg + (setq arg (|mergePathnames| (|pathname| arg) ef)) + (setq arg ef)) + (setq devFTs '("input" "INPUT" "boot" "BOOT" "lisp" "LISP")) + (setq fileTypes + (cond + ((eq |$UserLevel| '|interpreter|) '("input" "INPUT")) + ((eq |$UserLevel| '|compiler|) '("input" "INPUT")) + (t devFTs))) + (setq ll ($findfile arg fileTypes)) + (unless ll + (if ifthere + (return nil) + (|throwKeyedMsg| 'S2IL0003 (list (|namestring| arg))))) + (setq ll (|pathname| ll)) + (setq ft (|pathnameType| ll)) + (setq upft (upcase ft)) + (cond + ((null (|member| upft fileTypes)) + (setq fs (|namestring| arg)) + (if (|member| upft devFTs) + (|throwKeyedMsg| 'S2IZ0033 (list fs)) + (|throwKeyedMsg| 'S2IZ0034 (list fs)))) + (t + (setq /editfile ll) + (when (string= upft "BOOT") (setq |$InteractiveMode| nil)) + (/read ll quiet))))) + +@ + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{savesystem help page} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -15235,6 +15413,18 @@ command "AXIOMsys" may be saved. @ +\defun{savesystem}{The )savesystem command} +\calls{savesystem}{nequal} +\calls{savesystem}{helpSpad2Cmd} +\calls{savesystem}{spad-save} +<>= +(defun |savesystem| (arg) + (if (or (nequal (|#| arg) 1) (null (symbolp (car arg)))) + (|helpSpad2Cmd| '(|savesystem|)) + (spad-save (symbol-name (car arg))))) + +@ + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{set help page} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -20688,6 +20878,213 @@ o )what \fnref{set} \fnref{what}} +\defun{show}{The )show command} +\calls{show}{showSpad2Cmd} +<>= +(defun |show| (arg) (|showSpad2Cmd| arg)) + +@ + +\defun{showSpad2Cmd}{The internal )show command} +\calls{showSpad2Cmd}{member} +\calls{showSpad2Cmd}{helpSpad2Cmd} +\calls{showSpad2Cmd}{sayKeyedMsg} +\calls{showSpad2Cmd}{qcar} +\calls{showSpad2Cmd}{reportOperations} +\usesdollar{showSpad2Cmd}{showOptions} +\usesdollar{showSpad2Cmd}{e} +\usesdollar{showSpad2Cmd}{env} +\usesdollar{showSpad2Cmd}{InteractiveFrame} +\usesdollar{showSpad2Cmd}{options} +<>= +(defun |showSpad2Cmd| (arg) + (let (|$showOptions| |$e| |$env| constr) + (declare (special |$showOptions| |$e| |$env| |$InteractiveFrame| |$options|)) + (if (equal arg (list nil)) + (|helpSpad2Cmd| '(|show|)) + (progn + (setq |$showOptions| '(|attributes| |operations|)) + (unless |$options| (setq |$options| '((|operations|)))) + (setq |$e| |$InteractiveFrame|) + (setq |$env| |$InteractiveFrame|) + (cond + ((and (pairp arg) (eq (qcdr arg) nil) (progn (setq constr (qcar arg)) t)) + (cond + ((|member| constr '(|Union| |Record| |Mapping|)) + (cond + ((eq constr '|Record|) + (|sayKeyedMsg| 'S2IZ0044R + (list constr ")show Record(a: Integer, b: String)" ))) + ((eq constr '|Mapping|) (|sayKeyedMsg| 'S2IZ0044M nil)) + (t + (|sayKeyedMsg| 'S2IZ0045T + (list constr ")show Union(a: Integer, b: String)" ))) + (|sayKeyedMsg| 'S2IZ0045U + (list constr ")show Union(Integer, String)" )))) + ((and (pairp constr) (eq (qcar constr) '|Mapping|)) + (|sayKeyedMsg| 'S2IZ0044M nil)) + (t (|reportOperations| constr constr)))) + (t (|reportOperations| arg arg))))))) + +@ + +\defun{reportOperations}{reportOperations} +\calls{reportOperations}{sayBrightly} +\calls{reportOperations}{bright} +\calls{reportOperations}{sayKeyedMsg} +\calls{reportOperations}{qcar} +\calls{reportOperations}{isNameOfType} +\calls{reportOperations}{isDomainValuedVariable} +\calls{reportOperations}{reportOpsFromUnitDirectly0} +\calls{reportOperations}{opOf} +\calls{reportOperations}{unabbrev} +\calls{reportOperations}{reportOpsFromLisplib0} +\calls{reportOperations}{evaluateType} +\calls{reportOperations}{mkAtree} +\calls{reportOperations}{removeZeroOneDestructively} +\calls{reportOperations}{isType} +\usesdollar{reportOperations}{env} +\usesdollar{reportOperations}{eval} +\usesdollar{reportOperations}{genValue} +\usesdollar{reportOperations}{quadSymbol} +\usesdollar{reportOperations}{doNotAddEmptyModeIfTrue} +<>= +(defun |reportOperations| (oldArg u) + (let (|$env| |$eval| |$genValue| |$doNotAddEmptyModeIfTrue| + tmp1 v unitForm tree unitFormp) + (declare (special |$env| |$eval| |$genValue| |$quadSymbol| + |$doNotAddEmptyModeIfTrue|)) + (setq |$env| (list (list nil))) + (setq |$eval| t) + (setq |$genValue| t) + (when u + (setq |$doNotAddEmptyModeIfTrue| t) + (cond + ((equal u |$quadSymbol|) + (|sayBrightly| + (cons " mode denotes" (append (|bright| "any") (list '|type|))))) + ((eq 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 + (setq tmp1 (qcdr u)) + (and (pairp tmp1) (eq (qcdr tmp1) nil)))))) + (when (atom oldArg) (setq oldArg (list oldArg))) + (|sayKeyedMsg| 'S2IZ0063 nil) + (dolist (op oldArg) + (|sayKeyedMsg| 'S2IZ0062 (list (|opOf| op))))) + ((setq v (|isDomainValuedVariable| u)) (|reportOpsFromUnitDirectly0| v)) + (t + (if (atom u) + (setq unitForm (|opOf| (|unabbrev| u))) + (setq unitForm (|unabbrev| u))) + (if (atom unitForm) + (|reportOpsFromLisplib0| unitForm u) + (progn + (setq unitFormp (|evaluateType| unitForm)) + (setq tree (|mkAtree| (|removeZeroOneDestructively| unitForm))) + (if (setq unitFormp (|isType| tree)) + (|reportOpsFromUnitDirectly0| unitFormp) + (|sayKeyedMsg| 'S2IZ0041 (list unitForm)))))))))) + +@ + +\defun{reportOpsFromLisplib0}{} +\calls{reportOpsFromLisplib0}{reportOpsFromLisplib1} +\calls{reportOpsFromLisplib0}{reportOpsFromLisplib} +\usesdollar{reportOpsFromLisplib0}{useEditorForShowOutput} +<>= +(defun |reportOpsFromLisplib0| (unitForm u) + (declare (special |$useEditorForShowOutput|)) + (if |$useEditorForShowOutput| + (|reportOpsFromLisplib1| unitForm u) + (|reportOpsFromLisplib| unitForm u))) + +@ + +\defun{reportOpsFromLisplib1}{reportOpsFromLisplib1} +\calls{reportOpsFromLisplib1}{pathname} +\calls{reportOpsFromLisplib1}{erase} +\calls{reportOpsFromLisplib1}{defiostream} +\calls{reportOpsFromLisplib1}{sayShowWarning} +\calls{reportOpsFromLisplib1}{reportOpsFromLisplib} +\calls{reportOpsFromLisplib1}{shut} +\calls{reportOpsFromLisplib1}{editFile} +\usesdollar{reportOpsFromLisplib1}{sayBrightlyStream} +\usesdollar{reportOpsFromLisplib1}{erase} +\usesdollar{reportOpsFromLisplib1}{listingDirectory} +<>= +(defun |reportOpsFromLisplib1| (unitForm u) + (let (|$sayBrightlyStream| showFile) + (declare (special |$sayBrightlyStream| $erase |$listingDirectory|)) + (setq showFile (|pathname| (list 'show 'listing |$listingDirectory|))) + ($erase showFile) + (setq |$sayBrightlyStream| + (defiostream `((file ,showFile) (mode . output)) 255 0)) + (|sayShowWarning|) + (|reportOpsFromLisplib| unitForm u) + (shut |$sayBrightlyStream|) + (|editFile| showFile))) + +@ + +\defun{reportOpsFromUnitDirectly0}{reportOpsFromUnitDirectly0} +\calls{reportOpsFromUnitDirectly0}{reportOpsFromUnitDirectly1} +\calls{reportOpsFromUnitDirectly0}{reportOpsFromUnitDirectly} +\usesdollar{reportOpsFromUnitDirectly0}{useEditorForShowOutput} +<>= +(defun |reportOpsFromUnitDirectly0| (D) + (declare (special |$useEditorForShowOutput|)) + (if |$useEditorForShowOutput| + (|reportOpsFromUnitDirectly1| D) + (|reportOpsFromUnitDirectly| D))) + +@ + +\defun{reportOpsFromUnitDirectly1}{reportOpsFromUnitDirectly1} +\calls{reportOpsFromUnitDirectly1}{pathname} +\calls{reportOpsFromUnitDirectly1}{erase} +\calls{reportOpsFromUnitDirectly1}{defiostream} +\calls{reportOpsFromUnitDirectly1}{sayShowWarning} +\calls{reportOpsFromUnitDirectly1}{reportOpsFromUnitDirectly} +\calls{reportOpsFromUnitDirectly1}{shut} +\calls{reportOpsFromUnitDirectly1}{editFile} +\usesdollar{reportOpsFromUnitDirectly1}{sayBrightlyStream} +\usesdollar{reportOpsFromUnitDirectly1}{erase} +\usesdollar{reportOpsFromUnitDirectly1}{listingDirectory} +<>= +(defun |reportOpsFromUnitDirectly1| (D) + (let (|$sayBrightlyStream| showFile) + (declare (special |$sayBrightlyStream| $erase |$listingDirectory|)) + (setq showFile (|pathname| (list 'show 'listing |$listingDirectory|))) + ($erase showFile) + (setq |$sayBrightlyStream| + (defiostream `((file ,showFile) (mode . output)) 255 0)) + (|sayShowWarning|) + (|reportOpsFromUnitDirectly| D) + (shut |$sayBrightlyStream|) + (|editFile| showFile))) + +@ + +\defun{sayShowWarning}{sayShowWarning} +\calls{sayShowWarning}{sayBrightly} +<>= +(defun |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| "")) + +@ + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \cmdhead{spool help page} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -28466,6 +28863,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -28480,6 +28878,8 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> +<> <> <> <> @@ -28534,6 +28934,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -28855,8 +29256,10 @@ See Steele Common Lisp 1990 pp305-307 <> <> +<> <> <> +<> <> <> <> @@ -28870,6 +29273,11 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> +<> +<> +<> +<> <> <> <> @@ -28892,6 +29300,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -28900,6 +29309,7 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> @@ -28976,10 +29386,12 @@ See Steele Common Lisp 1990 pp305-307 <> <> <> +<> <> <> <> <> +<> <> <> <> diff --git a/changelog b/changelog index e8c8fdc..874e108 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20091228 tpd src/axiom-website/patches.html 20091228.01.tpd.patch +20091228 tpd src/interp/i-syscmd.lisp treeshake +20091228 tpd books/bookvol5 treeshake 20091227 tpd src/axiom-website/patches.html 20091227.01.tpd.patch 20091227 tpd src/interp/i-syscmd.lisp treeshake 20091227 tpd src/interp/ht-util.lisp treeshake diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index ec62d59..5449649 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2336,5 +2336,7 @@ books/bookvol5 treeshake
books/bookvol5 treeshake
20091227.01.tpd.patch books/bookvol5 treeshake
+20091228.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 034729a..f133124 100644 --- a/src/interp/i-syscmd.lisp.pamphlet +++ b/src/interp/i-syscmd.lisp.pamphlet @@ -120,132 +120,6 @@ (SUBSTRING |line| (PLUS |index| 2) NIL)))) |line|))))) -;displayCondition(v,condition,giveVariableIfNil) == -; varPart:= (giveVariableIfNil => nil; [" of",:bright v]) -; condPart:= condition or 'true -; sayBrightly concat(" condition",varPart,": ",pred2English condPart) - -(DEFUN |displayCondition| (|v| |condition| |giveVariableIfNil|) - (PROG (|varPart| |condPart|) - (RETURN - (PROGN - (SPADLET |varPart| - (COND - (|giveVariableIfNil| NIL) - ('T (CONS '| of| (|bright| |v|))))) - (SPADLET |condPart| (OR |condition| '|true|)) - (|sayBrightly| - (|concat| '| condition| |varPart| '|: | - (|pred2English| |condPart|))))))) - -;getAndSay(v,prop) == -; val:= getI(v,prop) => sayMSG [" ",val,'%l] -; sayMSG [" none",'%l] - -(DEFUN |getAndSay| (|v| |prop|) - (PROG (|val|) - (RETURN - (COND - ((SPADLET |val| (|getI| |v| |prop|)) - (|sayMSG| (CONS '| | (CONS |val| (CONS '|%l| NIL))))) - ('T (|sayMSG| (CONS '| none| (CONS '|%l| NIL)))))))) - -;displayType($op,u,omitVariableNameIfTrue) == -; null u => -; sayMSG ['" Type of value of ", -; fixObjectForPrinting PNAME $op,'": (none)"] -; type := prefix2String objMode(u) -; if ATOM type then type := [type] -; sayMSG concat ['" Type of value of ",fixObjectForPrinting PNAME $op,'": ",:type] -; NIL - -(DEFUN |displayType| (|$op| |u| |omitVariableNameIfTrue|) - (DECLARE (SPECIAL |$op|) (ignore |omitVariableNameIfTrue|)) - (PROG (|type|) - (RETURN - (COND - ((NULL |u|) - (|sayMSG| - (CONS (MAKESTRING " Type of value of ") - (CONS (|fixObjectForPrinting| (PNAME |$op|)) - (CONS (MAKESTRING ": (none)") NIL))))) - ('T (SPADLET |type| (|prefix2String| (|objMode| |u|))) - (COND ((ATOM |type|) (SPADLET |type| (CONS |type| NIL)))) - (|sayMSG| - (|concat| - (CONS (MAKESTRING " Type of value of ") - (CONS (|fixObjectForPrinting| (PNAME |$op|)) - (CONS (MAKESTRING ": ") |type|))))) - NIL))))) - -;displayValue($op,u,omitVariableNameIfTrue) == -; null u => sayMSG [" Value of ",fixObjectForPrinting PNAME $op,'": (none)"] -; expr := objValUnwrap(u) -; expr is [op,:.] and (op = 'MAP) or objMode(u) = $EmptyMode => -; displayRule($op,expr) -; label:= -; omitVariableNameIfTrue => -; rhs := '"): " -; '"Value (has type " -; rhs := '": " -; STRCONC('"Value of ", PNAME $op,'": ") -; labmode := prefix2String objMode(u) -; if ATOM labmode then labmode := [labmode] -; GETDATABASE(expr,'CONSTRUCTORKIND) = 'domain => -; sayMSG concat('" ",label,labmode,rhs,form2String expr) -; mathprint ['CONCAT,label,:labmode,rhs, -; outputFormat(expr,objMode(u))] -; NIL - -(DEFUN |displayValue| (|$op| |u| |omitVariableNameIfTrue|) - (DECLARE (SPECIAL |$op|)) - (PROG (|expr| |op| |rhs| |label| |labmode|) - (declare (special |$EmptyMode|)) - (RETURN - (COND - ((NULL |u|) - (|sayMSG| - (CONS '| Value of | - (CONS (|fixObjectForPrinting| (PNAME |$op|)) - (CONS (MAKESTRING ": (none)") NIL))))) - ('T (SPADLET |expr| (|objValUnwrap| |u|)) - (COND - ((OR (AND (PAIRP |expr|) - (PROGN (SPADLET |op| (QCAR |expr|)) 'T) - (BOOT-EQUAL |op| 'MAP)) - (BOOT-EQUAL (|objMode| |u|) |$EmptyMode|)) - (|displayRule| |$op| |expr|)) - ('T - (SPADLET |label| - (COND - (|omitVariableNameIfTrue| - (SPADLET |rhs| (MAKESTRING "): ")) - (MAKESTRING "Value (has type ")) - ('T (SPADLET |rhs| (MAKESTRING ": ")) - (STRCONC (MAKESTRING "Value of ") (PNAME |$op|) - (MAKESTRING ": "))))) - (SPADLET |labmode| (|prefix2String| (|objMode| |u|))) - (COND - ((ATOM |labmode|) - (SPADLET |labmode| (CONS |labmode| NIL)))) - (COND - ((BOOT-EQUAL (GETDATABASE |expr| 'CONSTRUCTORKIND) - '|domain|) - (|sayMSG| - (|concat| (MAKESTRING " ") |label| |labmode| |rhs| - (|form2String| |expr|)))) - ('T - (|mathprint| - (CONS 'CONCAT - (CONS |label| - (APPEND |labmode| - (CONS |rhs| - (CONS - (|outputFormat| |expr| - (|objMode| |u|)) - NIL)))))) - NIL))))))))) - ;--% )load ;load args == loadSpad2Cmd args @@ -349,200 +223,6 @@ (CONS (|fillerSpaces| 29 (MAKESTRING ".")) (CONS '| | (CONS |$streamCount| NIL)))))))))) -;--% )read -;read l == readSpad2Cmd l - -(DEFUN |read| (|l|) (|readSpad2Cmd| |l|)) - -;readSpad2Cmd l == -; ---$saturn => -; --- sayErrorly('"Obsolete system command", _ -; --- ['" The )read system command is obsolete in this version of AXIOM.", -; --- '" Please use Open from the File menu instead."]) -; $InteractiveMode : local := true -; quiet := nil -; ifthere := nil -; for [opt,:.] in $options repeat -; fullopt := selectOptionLC(opt,'(quiet test ifthere),'optionError) -; fullopt = 'ifthere => ifthere := true -; fullopt = 'quiet => quiet := true -; ef := pathname _/EDITFILE -; if pathnameTypeId(ef) = 'SPAD then -; ef := makePathname(pathnameName ef,'"*",'"*") -; if l then -; l := mergePathnames(pathname l,ef) -; else -; l := ef -; devFTs := '("input" "INPUT" "boot" "BOOT" "lisp" "LISP") -; fileTypes := -; $UserLevel = 'interpreter => '("input" "INPUT") -; $UserLevel = 'compiler => '("input" "INPUT") -; devFTs -; ll := $FINDFILE (l, fileTypes) -; if null ll then -; ifthere => return nil -- be quiet about it -; throwKeyedMsg("S2IL0003",[namestring l]) -; ll := pathname ll -; ft := pathnameType ll -; upft := UPCASE ft -; null MEMBER(upft,fileTypes) => -; fs := namestring l -; MEMBER(upft,devFTs) => throwKeyedMsg("S2IZ0033",[fs]) -; throwKeyedMsg("S2IZ0034",[fs]) -; SETQ(_/EDITFILE,ll) -; if upft = '"BOOT" then $InteractiveMode := nil -; _/READ(ll,quiet) - -(DEFUN |readSpad2Cmd| (|l|) - (PROG (|$InteractiveMode| |opt| |fullopt| |ifthere| |quiet| |ef| - |devFTs| |fileTypes| |ll| |ft| |upft| |fs|) - (DECLARE (SPECIAL |$InteractiveMode| $FINDFILE |$UserLevel| |$options| - /EDITFILE)) - (RETURN - (SEQ (PROGN - (SPADLET |$InteractiveMode| 'T) - (SPADLET |quiet| NIL) - (SPADLET |ifthere| NIL) - (DO ((G166598 |$options| (CDR G166598)) - (G166585 NIL)) - ((OR (ATOM G166598) - (PROGN (SETQ G166585 (CAR G166598)) NIL) - (PROGN - (PROGN - (SPADLET |opt| (CAR G166585)) - G166585) - NIL)) - NIL) - (SEQ (EXIT (PROGN - (SPADLET |fullopt| - (|selectOptionLC| |opt| - '(|quiet| |test| |ifthere|) - '|optionError|)) - (COND - ((BOOT-EQUAL |fullopt| '|ifthere|) - (SPADLET |ifthere| 'T)) - ((BOOT-EQUAL |fullopt| '|quiet|) - (SPADLET |quiet| 'T))))))) - (SPADLET |ef| (|pathname| /EDITFILE)) - (COND - ((BOOT-EQUAL (|pathnameTypeId| |ef|) 'SPAD) - (SPADLET |ef| - (|makePathname| (|pathnameName| |ef|) - (MAKESTRING "*") (MAKESTRING "*"))))) - (COND - (|l| (SPADLET |l| - (|mergePathnames| (|pathname| |l|) |ef|))) - ('T (SPADLET |l| |ef|))) - (SPADLET |devFTs| - '("input" "INPUT" "boot" "BOOT" "lisp" "LISP")) - (SPADLET |fileTypes| - (COND - ((BOOT-EQUAL |$UserLevel| '|interpreter|) - '("input" "INPUT")) - ((BOOT-EQUAL |$UserLevel| '|compiler|) - '("input" "INPUT")) - ('T |devFTs|))) - (SPADLET |ll| ($FINDFILE |l| |fileTypes|)) - (COND - ((NULL |ll|) - (COND - (|ifthere| (RETURN NIL)) - ('T - (|throwKeyedMsg| 'S2IL0003 - (CONS (|namestring| |l|) NIL)))))) - (SPADLET |ll| (|pathname| |ll|)) - (SPADLET |ft| (|pathnameType| |ll|)) - (SPADLET |upft| (UPCASE |ft|)) - (COND - ((NULL (|member| |upft| |fileTypes|)) - (SPADLET |fs| (|namestring| |l|)) - (COND - ((|member| |upft| |devFTs|) - (|throwKeyedMsg| 'S2IZ0033 (CONS |fs| NIL))) - ('T (|throwKeyedMsg| 'S2IZ0034 (CONS |fs| NIL))))) - ('T (SETQ /EDITFILE |ll|) - (COND - ((BOOT-EQUAL |upft| (MAKESTRING "BOOT")) - (SPADLET |$InteractiveMode| NIL))) - (/READ |ll| |quiet|)))))))) - -;--% )savesystem -;savesystem l == -; #l ^= 1 or not(SYMBOLP CAR l) => helpSpad2Cmd '(savesystem) -; SPAD_-SAVE SYMBOL_-NAME CAR l - -(DEFUN |savesystem| (|l|) - (COND - ((OR (NEQUAL (|#| |l|) 1) (NULL (SYMBOLP (CAR |l|)))) - (|helpSpad2Cmd| '(|savesystem|))) - ('T (SPAD-SAVE (SYMBOL-NAME (CAR |l|)))))) - -;--% )show -;show l == showSpad2Cmd l - -(DEFUN |show| (|l|) (|showSpad2Cmd| |l|)) - -;showSpad2Cmd l == -; l = [NIL] => helpSpad2Cmd '(show) -; $showOptions : local := '(attributes operations) -; if null $options then $options := '((operations)) -; $e : local := $InteractiveFrame -; $env : local := $InteractiveFrame -; l is [constr] => -; constr in '(Union Record Mapping) => -; constr = 'Record => -; sayKeyedMsg("S2IZ0044R",[constr, '")show Record(a: Integer, b: String)"]) -; constr = 'Mapping => -; sayKeyedMsg("S2IZ0044M",NIL) -; sayKeyedMsg("S2IZ0045T",[constr, '")show Union(a: Integer, b: String)"]) -; sayKeyedMsg("S2IZ0045U",[constr, '")show Union(Integer, String)"]) -; constr is ['Mapping, :.] => -; sayKeyedMsg("S2IZ0044M",NIL) -; reportOperations(constr,constr) -; reportOperations(l,l) - -(DEFUN |showSpad2Cmd| (|l|) - (PROG (|$showOptions| |$e| |$env| |constr|) - (DECLARE (SPECIAL |$showOptions| |$e| |$env| |$InteractiveFrame| - |$options|)) - (RETURN - (COND - ((BOOT-EQUAL |l| (CONS NIL NIL)) (|helpSpad2Cmd| '(|show|))) - ('T (SPADLET |$showOptions| '(|attributes| |operations|)) - (COND - ((NULL |$options|) (SPADLET |$options| '((|operations|))))) - (SPADLET |$e| |$InteractiveFrame|) - (SPADLET |$env| |$InteractiveFrame|) - (COND - ((AND (PAIRP |l|) (EQ (QCDR |l|) NIL) - (PROGN (SPADLET |constr| (QCAR |l|)) 'T)) - (COND - ((|member| |constr| '(|Union| |Record| |Mapping|)) - (COND - ((BOOT-EQUAL |constr| '|Record|) - (|sayKeyedMsg| 'S2IZ0044R - (CONS |constr| - (CONS (MAKESTRING - ")show Record(a: Integer, b: String)") - NIL)))) - ((BOOT-EQUAL |constr| '|Mapping|) - (|sayKeyedMsg| 'S2IZ0044M NIL)) - ('T - (|sayKeyedMsg| 'S2IZ0045T - (CONS |constr| - (CONS (MAKESTRING - ")show Union(a: Integer, b: String)") - NIL))) - (|sayKeyedMsg| 'S2IZ0045U - (CONS |constr| - (CONS (MAKESTRING - ")show Union(Integer, String)") - NIL)))))) - ((AND (PAIRP |constr|) (EQ (QCAR |constr|) '|Mapping|)) - (|sayKeyedMsg| 'S2IZ0044M NIL)) - ('T (|reportOperations| |constr| |constr|)))) - ('T (|reportOperations| |l| |l|)))))))) - ;reportOperations(oldArg,u) == ; -- u might be an uppercased version of oldArg ; $env:local := [[NIL]] @@ -571,83 +251,77 @@ ; (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))))))))))))))) +;(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 -(DEFUN |reportOpsFromUnitDirectly0| (D) - (declare (special |$useEditorForShowOutput|)) - (COND - (|$useEditorForShowOutput| (|reportOpsFromUnitDirectly1| D)) - ('T (|reportOpsFromUnitDirectly| D)))) - ;reportOpsFromUnitDirectly1 D == ; showFile := pathname ['SHOW,'LISTING,$listingDirectory] ; _$ERASE showFile @@ -658,26 +332,26 @@ ; 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|))))) +;(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 @@ -688,27 +362,27 @@ ; '" 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 "")))) +;(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|)))) +;(DEFUN |reportOpsFromLisplib0| (|unitForm| |u|) +; (declare (special |$useEditorForShowOutput|)) +; (COND +; (|$useEditorForShowOutput| +; (|reportOpsFromLisplib1| |unitForm| |u|)) +; ('T (|reportOpsFromLisplib| |unitForm| |u|)))) ;reportOpsFromLisplib1(unitForm,u) == ; showFile := pathname ['SHOW,'LISTING,$listingDirectory] @@ -720,26 +394,26 @@ ; 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|))))) +;(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)