diff --git a/books/bookvol5.pamphlet b/books/bookvol5.pamphlet index fe6b33c..be8a6ac 100644 --- a/books/bookvol5.pamphlet +++ b/books/bookvol5.pamphlet @@ -636,12 +636,11 @@ information is initialized. \calls{fillerSpaces}{ifcar} \begin{chunk}{defun fillerSpaces} (defun |fillerSpaces| (&rest arglist &aux charPart n) - (let (n charPart) (setq n (car arglist)) (setq charPart (cdr arglist)) (if (<= n 0) "" - (make-string n :initial-element (character (or (ifcar charPart) " ")))))) + (make-string n :initial-element (character (or (ifcar charPart) " "))))) \end{chunk} @@ -1893,7 +1892,7 @@ are compiling. This variable is only defined and used locally. \usesdollar{interpret}{genValue} \begin{chunk}{defun interpret} (defun |interpret| (&rest arg &aux restargs x) - (let (|$env| |$eval| |$genValue| posnForm x restargs) + (let (|$env| |$eval| |$genValue| posnForm) (declare (special |$env| |$eval| |$genValue|)) (setq x (car arg)) (setq restargs (cdr arg)) @@ -6182,7 +6181,7 @@ fn must transform the head of the stack (|npEqKey| 'let) (or (|npDefinition|) (|npTrap|)) (|npCompMissing| 'in) - (or #'f (|npTrap|)) + (or (funcall f) (|npTrap|)) (|npPush| (|pfWhere| (|npPop2|) (|npPop1|))))) \end{chunk} @@ -15467,7 +15466,7 @@ needs s0 similar to hasSig. \calls{hasSigAnd}{keyedSystemError} \begin{chunk}{defun hasSigAnd} (defun |hasSigAnd| (andCls s0 sl) - (let (tmp1 a tmp2 b sa dead) + (let (sa dead) (setq sa '|failed|) (loop for cls in andCls do @@ -15488,6 +15487,144 @@ needs s0 similar to hasSig. \end{chunk} +\defun{hasSigOr}{hasSigOr} +\calls{hasSigOr}{hasCate} +\calls{hasSigOr}{hasSigAnd} +\calls{hasSigOr}{keyedSystemError} +\begin{chunk}{defun hasSigOr} +(defun |hasSigOr| (orCls s0 sl) + (let (sa found) + (setq sa '|failed|) + (loop for cls in orCls + until found + do + (setq sa + (cond + ((atom cls) (copy sl)) + ((and (consp cls) (eq (qcar cls) '|has|) (consp (qcdr cls)) + (consp (qcddr cls)) (eq (qcdddr cls) nil)) + (|hasCate| (|subCopy| (qcadr cls) s0) + (|subCopy| (qcaddr cls) s0) + (copy sl))) + ((and (consp cls) + (or (eq (qcar cls) 'and) (eq (qcar cls) '|and|))) + (|hasSigAnd| (qcdr cls) s0 sl)) + (t + (|keyedSystemError| 'S2GE0016 + (list "hasSigOr" "unexpected condition for signature"))))) + (unless (eq sa '|failed|) (setq found t))) + sa)) + +\end{chunk} + +\defun{hasAttSig}{hasAttSig} +The argument d is domain, x is a list of attributes and signatures. +The result is an augmented SL, if d has x, 'failed otherwise. +\calls{hasAttSig}{hasAtt} +\calls{hasAttSig}{hasSig} +\calls{hasAttSig}{keyedSystemError} +\begin{chunk}{defun hasAttSig} +(defun |hasAttSig| (d x sl) + (loop for y in x + until (eq sl '|failed|) + do + (setq sl + (cond + ((and (consp y) (eq (qcar y) 'attribute) + (consp (qcdr y)) (eq (qcddr y) nil)) + (|hasAtt| d (qcadr y) sl)) + ((and (consp y) (eq (qcar y) 'signature) + (consp (qcdr y)) (consp (qcddr y)) (eq (qcdddr y) nil)) + (|hasSig| d (qcadr y) (qcaddr y) sl)) + (t + (|keyedSystemError| 'S2GE0016 + (list "hasAttSig" "unexpected form of unnamed category")))))) + sl) + +\end{chunk} + +\defun{hasCate1}{hasCate1} +\calls{hasCate1}{hasCate} +\defsdollar{hasCate1}{domPvar} +\begin{chunk}{defun hasCate1} +(defun |hasCate1| (dom cat sl domPvar) + (let (|$domPvar|) + (declare (special |$domPvar|)) + (setq |$domPvar| domPvar) + (|hasCate| dom cat sl))) + +\end{chunk} + +\defun{hasCatExpression}{hasCatExpression} +\calls{hasCatExpression}{hasCatExpression} +\calls{hasCatExpression}{nequal} +\calls{hasCatExpression}{hasCate} +\calls{hasCatExpression}{keyedSystemError} +\begin{chunk}{defun hasCatExpression} +(defun |hasCatExpression| (cond sl) + (let (y) + (cond + ((and (consp cond) (eq (qcar cond) 'or)) + (when + (let (result) + (loop for x in (qcdr cond) + do (setq result + (or result + (nequal (setq y (|hasCatExpression| x sl)) '|failed|)))) + result) + y)) + ((and (consp cond) (eq (qcar cond) 'and)) + (when + (let ((result t)) + (loop for x in (qcdr cond) + do (setq result + (and result + (nequal (setq sl (|hasCatExpression| x sl)) '|failed|)))) + result) + sl)) + ((and (consp cond) (eq (qcar cond) '|has|) + (consp (qcdr cond)) (consp (qcddr cond)) (eq (qcdddr cond) nil)) + (|hasCate| (qcadr cond) (qcaddr cond) sl)) + (t + (|keyedSystemError| 'S2GE0016 + (list "hasSig" "unexpected condition for attribute")))))) + +\end{chunk} + +\defun{unifyStruct}{unifyStruct} +\calls{unifyStruct}{isPatternVar} +\calls{unifyStruct}{unifyStructVar} +\calls{unifyStruct}{unifyStruct} +\begin{chunk}{defun unifyStruct} +(defun |unifyStruct| (s1 s2 sl) + (declare (special |$domPvar| |$hope| |$Coerce| |$Subst|)) + (cond + ((equal s1 s2) sl) + (t + (when (and (consp s1) (eq (qcar s1) '|:|) + (consp (qcdr s1)) (consp (qcddr s1)) (eq (qcdddr s1) nil)) + (setq s1 (qcadr s1))) + (when (and (consp s2) (eq (qcar s2) '|:|) + (consp (qcdr s2)) (consp (qcddr s2)) (eq (qcdddr s2) nil)) + (setq s2 (qcadr s2))) + (when (and (null (atom s1)) (eq (car s1) '|#|)) + (setq s1 (length (cadr s1)))) + (when (and (null (atom s2)) (eq (car s2) '|#|)) + (setq s2 (length (cadr s2)))) + (cond + ((equal s1 s2) sl) + ((|isPatternVar| s1) (|unifyStructVar| s1 s2 sl)) + ((|isPatternVar| s2) (|unifyStructVar| s2 s1 sl)) + ((or (atom s1) (atom s2)) '|failed|) + (t + (loop until (or (null s1) (null s2) (eq sl '|failed|)) + do + (setq sl (|unifyStruct| (car s1) (car s2) sl)) + (setq s1 (cdr s1)) + (setq s2 (cdr s2))) + (if (or s1 s2) '|failed| sl)))))) + +\end{chunk} \chapter{System Command Handling} The system commands are the top-level commands available in Axiom @@ -41455,7 +41592,8 @@ This is used in OpenMathPackage in Volume 10.4. \defun{om-Read}{om-Read} Read an OpenMath object from dev. \begin{chunk}{defun om-Read} -(defun om-Read (dev)) +(defun om-Read (dev) + (declare (ignore dev))) \end{chunk} @@ -41476,13 +41614,15 @@ Lists all the symbols in CD \defun{om-supportsCD}{om-supportsCD} Return true if Axiom supports this CD. \begin{chunk}{defun om-supportsCD} -(defun om-supportsCD (cd)) +(defun om-supportsCD (cd) + (declare (ignore cd))) \end{chunk} \defun{om-supportsSymbol}{om-supportsSymbol} \begin{chunk}{defun om-supportsSymbol} -(defun om-supportsSymbol (cd name)) +(defun om-supportsSymbol (cd name) + (declare (ignore cd name))) \end{chunk} @@ -41509,7 +41649,8 @@ The lisp conversion functions are: This sets the encoding used for reading or writeing OpenMath objects to or from dev to enc. \begin{chunk}{defun om-setDevEncoding} -(defun om-setDevEncoding (dev enc)) +(defun om-setDevEncoding (dev enc) + (declare (ignore dev enc))) \end{chunk} @@ -41524,14 +41665,17 @@ or from dev to enc. This opens file fname for reading or writing OpenMath objects. The mode can be ``r'' for read, ``w'' for write, or ''a'' for append. \begin{chunk}{defun om-openFileDev} -(defun om-openFileDev (fname fmode enc)) +(defun om-openFileDev (fname fmode enc) + (declare (ignore fname fmode enc))) + \end{chunk} \defun{om-openStringDev}{om-openStringDev} This opens the string str for reading and writing OpenMath objects in encoding enc. \begin{chunk}{defun om-openStringDev} -(defun om-openStringDev (str enc)) +(defun om-openStringDev (str enc) + (declare (ignore str enc))) \end{chunk} @@ -41554,7 +41698,8 @@ These are covered in the OpenMathConnection domain in Volume 10.3. \defun{om-makeConn}{om-makeConn} \begin{chunk}{defun om-makeConn} -(defun om-makeConn (conn)) +(defun om-makeConn (conn) + (declare (ignore conn))) \end{chunk} @@ -43568,12 +43713,16 @@ This needs to work off the internal exposure list, not the file. \getchunk{defun handleParsedSystemCommands} \getchunk{defun handleTokensizeSystemCommands} \getchunk{defun hasAtt} +\getchunk{defun hasAttSig} +\getchunk{defun hasCatExpression} +\getchunk{defun hasCate1} \getchunk{defun hasCaty} \getchunk{defun hashable} \getchunk{defun hasOption} \getchunk{defun hasPair} \getchunk{defun hasSig} \getchunk{defun hasSigAnd} +\getchunk{defun hasSigOr} \getchunk{defun help} \getchunk{defun helpSpad2Cmd} \getchunk{defun histFileErase} @@ -44499,6 +44648,7 @@ This needs to work off the internal exposure list, not the file. \getchunk{defun undoSingleStep} \getchunk{defun undoSteps} \getchunk{defun unescapeStringsInForm} +\getchunk{defun unifyStruct} \getchunk{defun unsqueeze} \getchunk{defun untrace} \getchunk{defun untraceDomainConstructor} diff --git a/changelog b/changelog index fc41121..547db29 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,6 @@ +20111203 tpd src/axiom-website/patches.html 20111203.03.tpd.patch +20111203 tpd src/interp/i-funsel.lisp treeshake compiler +20111203 tpd books/bookvol5 treeshake interpreter 20111203 tpd src/axiom-website/patches.html 20111203.02.tpd.patch 20111203 tpd src/axiom-website/videos.html GLOBAL recolor website ECEA81 20111203 tpd books/bookvol10.2 diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index f3f814d..5684f85 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -3719,5 +3719,7 @@ In process, not yet released

books/bookvol5 treeshake interpreter
20111203.02.tpd.patch src/axiom-website/videos.html GLOBAL recolor website ECEA81
+20111203.03.tpd.patch +books/bookvol5 treeshake interpreter
diff --git a/src/interp/i-funsel.lisp.pamphlet b/src/interp/i-funsel.lisp.pamphlet index 8a43bf2..519b74b 100644 --- a/src/interp/i-funsel.lisp.pamphlet +++ b/src/interp/i-funsel.lisp.pamphlet @@ -5206,16 +5206,6 @@ the types A and B themselves are not sorted by preference. (COND (SL1 (setq |cat| (|subCopy| |cat| SL1)))) (|hasCaty| |dom| |cat| SL))))))) -;hasCate1(dom, cat, SL, domPvar) == -; $domPvar:local := domPvar -; hasCate(dom, cat, SL) - -(defun |hasCate1| (dom cat sl domPvar) - (let (|$domPvar|) - (declare (special |$domPvar|)) - (setq |$domPvar| domPvar) - (|hasCate| dom cat sl))) - ;hasCateSpecial(v,dom,cat,SL) == ; -- v is a pattern variable, dom it's binding under $Subst ; -- tries to change dom, so that it has category cat under SL @@ -5582,280 +5572,6 @@ the types A and B themselves are not sorted by preference. (CONS "unexpected condition from category table" NIL)))))))))) -;hasAttSig(d,x,SL) == -; -- d is domain, x a list of attributes and signatures -; -- the result is an augmented SL, if d has x, 'failed otherwise -; for y in x until SL='failed repeat SL:= -; y is ['ATTRIBUTE,a] => hasAtt(d,a,SL) -; y is ['SIGNATURE,foo,s] => hasSig(d,foo,s,SL) -; keyedSystemError("S2GE0016", -; ['"hasAttSig",'"unexpected form of unnamed category"]) -; SL - -(DEFUN |hasAttSig| (|d| |x| SL) - (PROG (|a| |ISTMP#1| |foo| |ISTMP#2| |s|) - (RETURN - (SEQ (PROGN - (DO ((G169295 |x| (CDR G169295)) (|y| NIL) - (G169296 NIL (BOOT-EQUAL SL '|failed|))) - ((OR (ATOM G169295) - (PROGN (SETQ |y| (CAR G169295)) NIL) G169296) - NIL) - (SEQ (EXIT (setq SL - (COND - ((AND (CONSP |y|) - (EQ (QCAR |y|) 'ATTRIBUTE) - (PROGN - (setq |ISTMP#1| (QCDR |y|)) - (AND (CONSP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (setq |a| - (QCAR |ISTMP#1|)) - t)))) - (|hasAtt| |d| |a| SL)) - ((AND (CONSP |y|) - (EQ (QCAR |y|) 'SIGNATURE) - (PROGN - (setq |ISTMP#1| (QCDR |y|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (setq |foo| - (QCAR |ISTMP#1|)) - (setq |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (setq |s| - (QCAR |ISTMP#2|)) - t)))))) - (|hasSig| |d| |foo| |s| SL)) - (t - (|keyedSystemError| 'S2GE0016 - (CONS "hasAttSig" - (CONS - "unexpected form of unnamed category" - NIL))))))))) - SL))))) - -;hasSigOr(orCls, S0, SL) == -; found := NIL -; SA := 'failed -; for cls in orCls until found repeat -; SA := -; atom cls => copy SL -; cls is ['has,a,b] => -; hasCate(subCopy(a,S0),subCopy(b,S0),copy SL) -; cls is ['AND,:andCls] or cls is ['and,:andCls] => -; hasSigAnd(andCls, S0, SL) -; keyedSystemError("S2GE0016", -; ['"hasSigOr",'"unexpected condition for signature"]) -; if SA ^= 'failed then found := true -; SA - -(DEFUN |hasSigOr| (|orCls| S0 SL) - (PROG (|ISTMP#1| |a| |ISTMP#2| |b| |andCls| SA |found|) - (RETURN - (SEQ (PROGN - (setq |found| NIL) - (setq SA '|failed|) - (DO ((G169399 |orCls| (CDR G169399)) (|cls| NIL) - (G169400 NIL |found|)) - ((OR (ATOM G169399) - (PROGN (SETQ |cls| (CAR G169399)) NIL) - G169400) - NIL) - (SEQ (EXIT (PROGN - (setq SA - (COND - ((ATOM |cls|) (COPY SL)) - ((AND (CONSP |cls|) - (EQ (QCAR |cls|) '|has|) - (PROGN - (setq |ISTMP#1| - (QCDR |cls|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (setq |a| - (QCAR |ISTMP#1|)) - (setq |ISTMP#2| - (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) - NIL) - (PROGN - (setq |b| - (QCAR |ISTMP#2|)) - t)))))) - (|hasCate| (|subCopy| |a| S0) - (|subCopy| |b| S0) (COPY SL))) - ((OR - (AND (CONSP |cls|) - (EQ (QCAR |cls|) 'AND) - (PROGN - (setq |andCls| - (QCDR |cls|)) - t)) - (AND (CONSP |cls|) - (EQ (QCAR |cls|) '|and|) - (PROGN - (setq |andCls| - (QCDR |cls|)) - t))) - (|hasSigAnd| |andCls| S0 SL)) - (t - (|keyedSystemError| 'S2GE0016 - (CONS "hasSigOr" - (CONS - "unexpected condition for signature" - NIL)))))) - (COND - ((NEQUAL SA '|failed|) - (setq |found| t)) - (t NIL)))))) - SA))))) - -;hasCatExpression(cond,SL) == -; cond is ['OR,:l] => -; or/[(y:=hasCatExpression(x,SL)) ^= 'failed for x in l] => y -; cond is ['AND,:l] => -; and/[(SL:= hasCatExpression(x,SL)) ^= 'failed for x in l] => SL -; cond is ['has,a,b] => hasCate(a,b,SL) -; keyedSystemError("S2GE0016", -; ['"hasSig",'"unexpected condition for attribute"]) - -(DEFUN |hasCatExpression| (|cond| SL) - (PROG (|y| |l| |ISTMP#1| |a| |ISTMP#2| |b|) - (RETURN - (SEQ (COND - ((AND (CONSP |cond|) (EQ (QCAR |cond|) 'OR) - (PROGN (setq |l| (QCDR |cond|)) t)) - (COND - ((PROG (G169577) - (setq G169577 NIL) - (RETURN - (DO ((G169583 NIL G169577) - (G169584 |l| (CDR G169584)) (|x| NIL)) - ((OR G169583 (ATOM G169584) - (PROGN (SETQ |x| (CAR G169584)) NIL)) - G169577) - (SEQ (EXIT (SETQ G169577 - (OR G169577 - (NEQUAL - (setq |y| - (|hasCatExpression| |x| SL)) - '|failed|)))))))) - (EXIT |y|)))) - ((AND (CONSP |cond|) (EQ (QCAR |cond|) 'AND) - (PROGN (setq |l| (QCDR |cond|)) t)) - (COND - ((PROG (G169591) - (setq G169591 t) - (RETURN - (DO ((G169597 NIL (NULL G169591)) - (G169598 |l| (CDR G169598)) (|x| NIL)) - ((OR G169597 (ATOM G169598) - (PROGN (SETQ |x| (CAR G169598)) NIL)) - G169591) - (SEQ (EXIT (SETQ G169591 - (AND G169591 - (NEQUAL - (setq SL - (|hasCatExpression| |x| SL)) - '|failed|)))))))) - (EXIT SL)))) - ((AND (CONSP |cond|) (EQ (QCAR |cond|) '|has|) - (PROGN - (setq |ISTMP#1| (QCDR |cond|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (setq |a| (QCAR |ISTMP#1|)) - (setq |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (setq |b| (QCAR |ISTMP#2|)) - t)))))) - (|hasCate| |a| |b| SL)) - (t - (|keyedSystemError| 'S2GE0016 - (CONS "hasSig" - (CONS "unexpected condition for attribute" - NIL))))))))) - -;unifyStruct(s1,s2,SL) == -; -- tests for equality of s1 and s2 under substitutions SL and $Subst -; -- the result is a substitution list or 'failed -; s1=s2 => SL -; if s1 is ['_:,x,.] then s1:= x -; if s2 is ['_:,x,.] then s2:= x -; if ^atom s1 and CAR s1 = '_# then s1:= LENGTH CADR s1 -; if ^atom s2 and CAR s2 = '_# then s2:= LENGTH CADR s2 -; s1=s2 => SL -; isPatternVar s1 => unifyStructVar(s1,s2,SL) -; isPatternVar s2 => unifyStructVar(s2,s1,SL) -; atom s1 or atom s2 => 'failed -; until null s1 or null s2 or SL='failed repeat -; SL:= unifyStruct(CAR s1,CAR s2,SL) -; s1:= CDR s1 -; s2:= CDR s2 -; s1 or s2 => 'failed -; SL - -(DEFUN |unifyStruct| (|s1| |s2| SL) - (PROG (|ISTMP#1| |x| |ISTMP#2|) - (declare (special |$domPvar| |$hope| |$Coerce| |$Subst|)) - (RETURN - (SEQ (COND - ((BOOT-EQUAL |s1| |s2|) SL) - (t - (COND - ((AND (CONSP |s1|) (EQ (QCAR |s1|) '|:|) - (PROGN - (setq |ISTMP#1| (QCDR |s1|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (setq |x| (QCAR |ISTMP#1|)) - (setq |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL)))))) - (setq |s1| |x|))) - (COND - ((AND (CONSP |s2|) (EQ (QCAR |s2|) '|:|) - (PROGN - (setq |ISTMP#1| (QCDR |s2|)) - (AND (CONSP |ISTMP#1|) - (PROGN - (setq |x| (QCAR |ISTMP#1|)) - (setq |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (CONSP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL)))))) - (setq |s2| |x|))) - (COND - ((AND (NULL (ATOM |s1|)) (BOOT-EQUAL (CAR |s1|) '|#|)) - (setq |s1| (LENGTH (CADR |s1|))))) - (COND - ((AND (NULL (ATOM |s2|)) (BOOT-EQUAL (CAR |s2|) '|#|)) - (setq |s2| (LENGTH (CADR |s2|))))) - (COND - ((BOOT-EQUAL |s1| |s2|) SL) - ((|isPatternVar| |s1|) (|unifyStructVar| |s1| |s2| SL)) - ((|isPatternVar| |s2|) (|unifyStructVar| |s2| |s1| SL)) - ((OR (ATOM |s1|) (ATOM |s2|)) '|failed|) - (t - (DO ((G169646 NIL - (OR (NULL |s1|) (NULL |s2|) - (BOOT-EQUAL SL '|failed|)))) - (G169646 NIL) - (SEQ (EXIT (PROGN - (setq SL - (|unifyStruct| (CAR |s1|) - (CAR |s2|) SL)) - (setq |s1| (CDR |s1|)) - (setq |s2| (CDR |s2|)))))) - (COND ((OR |s1| |s2|) '|failed|) (t SL)))))))))) - ;unifyStructVar(v,s,SL) == ; -- the first argument is a pattern variable, which is not substituted ; -- by SL