\documentclass{article} \usepackage{axiom} \begin{document} \title{\$SPAD/src/algebra fspace.spad} \author{Manuel Bronstein} \maketitle \begin{abstract} \end{abstract} \eject \tableofcontents \eject \section{category ES ExpressionSpace} <>= )abbrev category ES ExpressionSpace ++ Category for domains on which operators can be applied ++ Author: Manuel Bronstein ++ Date Created: 22 March 1988 ++ Date Last Updated: 27 May 1994 ++ Description: ++ An expression space is a set which is closed under certain operators; ++ Keywords: operator, kernel, expression, space. ExpressionSpace(): Category == Defn where N ==> NonNegativeInteger K ==> Kernel % OP ==> BasicOperator SY ==> Symbol PAREN ==> "%paren"::SY BOX ==> "%box"::SY DUMMYVAR ==> "%dummyVar" Defn ==> Join(OrderedSet, RetractableTo K, InnerEvalable(K, %), Evalable %) with elt : (OP, %) -> % ++ elt(op,x) or op(x) applies the unary operator op to x. elt : (OP, %, %) -> % ++ elt(op,x,y) or op(x, y) applies the binary operator op to x and y. elt : (OP, %, %, %) -> % ++ elt(op,x,y,z) or op(x, y, z) applies the ternary operator op to x, y and z. elt : (OP, %, %, %, %) -> % ++ elt(op,x,y,z,t) or op(x, y, z, t) applies the 4-ary operator op to x, y, z and t. elt : (OP, List %) -> % ++ elt(op,[x1,...,xn]) or op([x1,...,xn]) applies the n-ary operator op to x1,...,xn. subst : (%, Equation %) -> % ++ subst(f, k = g) replaces the kernel k by g formally in f. subst : (%, List Equation %) -> % ++ subst(f, [k1 = g1,...,kn = gn]) replaces the kernels k1,...,kn ++ by g1,...,gn formally in f. subst : (%, List K, List %) -> % ++ subst(f, [k1...,kn], [g1,...,gn]) replaces the kernels k1,...,kn ++ by g1,...,gn formally in f. box : % -> % ++ box(f) returns f with a 'box' around it that prevents f from ++ being evaluated when operators are applied to it. For example, ++ \spad{log(1)} returns 0, but \spad{log(box 1)} ++ returns the formal kernel log(1). box : List % -> % ++ box([f1,...,fn]) returns \spad{(f1,...,fn)} with a 'box' ++ around them that ++ prevents the fi from being evaluated when operators are applied to ++ them, and makes them applicable to a unary operator. For example, ++ \spad{atan(box [x, 2])} returns the formal kernel \spad{atan(x, 2)}. paren : % -> % ++ paren(f) returns (f). This prevents f from ++ being evaluated when operators are applied to it. For example, ++ \spad{log(1)} returns 0, but \spad{log(paren 1)} returns the ++ formal kernel log((1)). paren : List % -> % ++ paren([f1,...,fn]) returns \spad{(f1,...,fn)}. This ++ prevents the fi from being evaluated when operators are applied to ++ them, and makes them applicable to a unary operator. For example, ++ \spad{atan(paren [x, 2])} returns the formal ++ kernel \spad{atan((x, 2))}. distribute : % -> % ++ distribute(f) expands all the kernels in f that are ++ formally enclosed by a \spadfunFrom{box}{ExpressionSpace} ++ or \spadfunFrom{paren}{ExpressionSpace} expression. distribute : (%, %) -> % ++ distribute(f, g) expands all the kernels in f that contain g in their ++ arguments and that are formally ++ enclosed by a \spadfunFrom{box}{ExpressionSpace} ++ or a \spadfunFrom{paren}{ExpressionSpace} expression. height : % -> N ++ height(f) returns the highest nesting level appearing in f. ++ Constants have height 0. Symbols have height 1. For any ++ operator op and expressions f1,...,fn, \spad{op(f1,...,fn)} has ++ height equal to \spad{1 + max(height(f1),...,height(fn))}. mainKernel : % -> Union(K, "failed") ++ mainKernel(f) returns a kernel of f with maximum nesting level, or ++ if f has no kernels (i.e. f is a constant). kernels : % -> List K ++ kernels(f) returns the list of all the top-level kernels ++ appearing in f, but not the ones appearing in the arguments ++ of the top-level kernels. tower : % -> List K ++ tower(f) returns all the kernels appearing in f, no matter ++ what their levels are. operators : % -> List OP ++ operators(f) returns all the basic operators appearing in f, ++ no matter what their levels are. operator : OP -> OP ++ operator(op) returns a copy of op with the domain-dependent ++ properties appropriate for %. belong? : OP -> Boolean ++ belong?(op) tests if % accepts op as applicable to its ++ elements. is? : (%, OP) -> Boolean ++ is?(x, op) tests if x is a kernel and is its operator is op. is? : (%, SY) -> Boolean ++ is?(x, s) tests if x is a kernel and is the name of its ++ operator is s. kernel : (OP, %) -> % ++ kernel(op, x) constructs op(x) without evaluating it. kernel : (OP, List %) -> % ++ kernel(op, [f1,...,fn]) constructs \spad{op(f1,...,fn)} without ++ evaluating it. map : (% -> %, K) -> % ++ map(f, k) returns \spad{op(f(x1),...,f(xn))} where ++ \spad{k = op(x1,...,xn)}. freeOf? : (%, %) -> Boolean ++ freeOf?(x, y) tests if x does not contain any occurrence of y, ++ where y is a single kernel. freeOf? : (%, SY) -> Boolean ++ freeOf?(x, s) tests if x does not contain any operator ++ whose name is s. eval : (%, List SY, List(% -> %)) -> % ++ eval(x, [s1,...,sm], [f1,...,fm]) replaces ++ every \spad{si(a)} in x by \spad{fi(a)} for any \spad{a}. eval : (%, List SY, List(List % -> %)) -> % ++ eval(x, [s1,...,sm], [f1,...,fm]) replaces ++ every \spad{si(a1,...,an)} in x by ++ \spad{fi(a1,...,an)} for any \spad{a1},...,\spad{an}. eval : (%, SY, List % -> %) -> % ++ eval(x, s, f) replaces every \spad{s(a1,..,am)} in x ++ by \spad{f(a1,..,am)} for any \spad{a1},...,\spad{am}. eval : (%, SY, % -> %) -> % ++ eval(x, s, f) replaces every \spad{s(a)} in x by \spad{f(a)} ++ for any \spad{a}. eval : (%, List OP, List(% -> %)) -> % ++ eval(x, [s1,...,sm], [f1,...,fm]) replaces ++ every \spad{si(a)} in x by \spad{fi(a)} for any \spad{a}. eval : (%, List OP, List(List % -> %)) -> % ++ eval(x, [s1,...,sm], [f1,...,fm]) replaces ++ every \spad{si(a1,...,an)} in x by ++ \spad{fi(a1,...,an)} for any \spad{a1},...,\spad{an}. eval : (%, OP, List % -> %) -> % ++ eval(x, s, f) replaces every \spad{s(a1,..,am)} in x ++ by \spad{f(a1,..,am)} for any \spad{a1},...,\spad{am}. eval : (%, OP, % -> %) -> % ++ eval(x, s, f) replaces every \spad{s(a)} in x by \spad{f(a)} ++ for any \spad{a}. if % has Ring then minPoly: K -> SparseUnivariatePolynomial % ++ minPoly(k) returns p such that \spad{p(k) = 0}. definingPolynomial: % -> % ++ definingPolynomial(x) returns an expression p such that ++ \spad{p(x) = 0}. if % has RetractableTo Integer then even?: % -> Boolean ++ even? x is true if x is an even integer. odd? : % -> Boolean ++ odd? x is true if x is an odd integer. add -- the 7 functions not provided are: -- kernels minPoly definingPolynomial -- coerce:K -> % eval:(%, List K, List %) -> % -- subst:(%, List K, List %) -> % -- eval:(%, List Symbol, List(List % -> %)) -> % allKernels: % -> Set K listk : % -> List K allk : List % -> Set K unwrap : (List K, %) -> % okkernel : (OP, List %) -> % mkKerLists: List Equation % -> Record(lstk: List K, lstv:List %) oppren := operator(PAREN)$CommonOperators() opbox := operator(BOX)$CommonOperators() box(x:%) == box [x] paren(x:%) == paren [x] belong? op == op = oppren or op = opbox listk f == parts allKernels f tower f == sort_! listk f allk l == reduce("union", [allKernels f for f in l], {}) operators f == [operator k for k in listk f] height f == reduce("max", [height k for k in kernels f], 0) freeOf?(x:%, s:SY) == not member?(s, [name k for k in listk x]) distribute x == unwrap([k for k in listk x | is?(k, oppren)], x) box(l:List %) == opbox l paren(l:List %) == oppren l freeOf?(x:%, k:%) == not member?(retract k, listk x) kernel(op:OP, arg:%) == kernel(op, [arg]) elt(op:OP, x:%) == op [x] elt(op:OP, x:%, y:%) == op [x, y] elt(op:OP, x:%, y:%, z:%) == op [x, y, z] elt(op:OP, x:%, y:%, z:%, t:%) == op [x, y, z, t] eval(x:%, s:SY, f:List % -> %) == eval(x, [s], [f]) eval(x:%, s:OP, f:List % -> %) == eval(x, [name s], [f]) eval(x:%, s:SY, f:% -> %) == eval(x, [s], [f first #1]) eval(x:%, s:OP, f:% -> %) == eval(x, [s], [f first #1]) subst(x:%, e:Equation %) == subst(x, [e]) eval(x:%, ls:List OP, lf:List(% -> %)) == eval(x, ls, [f first #1 for f in lf]$List(List % -> %)) eval(x:%, ls:List SY, lf:List(% -> %)) == eval(x, ls, [f first #1 for f in lf]$List(List % -> %)) eval(x:%, ls:List OP, lf:List(List % -> %)) == eval(x, [name s for s in ls]$List(SY), lf) map(fn, k) == (l := [fn x for x in argument k]$List(%)) = argument k => k::% (operator k) l operator op == is?(op, PAREN) => oppren is?(op, BOX) => opbox error "Unknown operator" mainKernel x == empty?(l := kernels x) => "failed" n := height(k := first l) for kk in rest l repeat if height(kk) > n then n := height kk k := kk k -- takes all the kernels except for the dummy variables, which are second -- arguments of rootOf's, integrals, sums and products which appear only in -- their first arguments allKernels f == s := brace(l := kernels f) for k in l repeat t := (u := property(operator k, DUMMYVAR)) case None => arg := argument k s0 := remove_!(retract(second arg)@K, allKernels first arg) arg := rest rest arg n := (u::None) pretend N if n > 1 then arg := rest arg union(s0, allk arg) allk argument k s := union(s, t) s kernel(op:OP, args:List %) == not belong? op => error "Unknown operator" okkernel(op, args) okkernel(op, l) == kernel(op, l, 1 + reduce("max", [height f for f in l], 0))$K :: % elt(op:OP, args:List %) == not belong? op => error "Unknown operator" ((u := arity op) case N) and (#args ~= u::N) => error "Wrong number of arguments" (v := evaluate(op,args)$BasicOperatorFunctions1(%)) case % => v::% okkernel(op, args) retract f == (k := mainKernel f) case "failed" => error "not a kernel" k::K::% ~= f => error "not a kernel" k::K retractIfCan f == (k := mainKernel f) case "failed" => "failed" k::K::% ~= f => "failed" k is?(f:%, s:SY) == (k := retractIfCan f) case "failed" => false is?(k::K, s) is?(f:%, op:OP) == (k := retractIfCan f) case "failed" => false is?(k::K, op) unwrap(l, x) == for k in reverse_! l repeat x := eval(x, k, first argument k) x distribute(x, y) == ky := retract y unwrap([k for k in listk x | is?(k, "%paren"::SY) and member?(ky, listk(k::%))], x) -- in case of conflicting substitutions e.g. [x = a, x = b], -- the first one prevails. -- this is not part of the semantics of the function, but just -- a feature of this implementation. eval(f:%, leq:List Equation %) == rec := mkKerLists leq eval(f, rec.lstk, rec.lstv) subst(f:%, leq:List Equation %) == rec := mkKerLists leq subst(f, rec.lstk, rec.lstv) mkKerLists leq == lk := empty()$List(K) lv := empty()$List(%) for eq in leq repeat (k := retractIfCan(lhs eq)@Union(K, "failed")) case "failed" => error "left hand side must be a single kernel" if not member?(k::K, lk) then lk := concat(k::K, lk) lv := concat(rhs eq, lv) [lk, lv] if % has RetractableTo Integer then intpred?: (%, Integer -> Boolean) -> Boolean even? x == intpred?(x, even?) odd? x == intpred?(x, odd?) intpred?(x, pred?) == (u := retractIfCan(x)@Union(Integer, "failed")) case Integer and pred?(u::Integer) @ \section{ES.lsp BOOTSTRAP} {\bf ES} depends on a chain of files. We need to break this cycle to build the algebra. So we keep a cached copy of the translated {\bf ES} category which we can write into the {\bf MID} directory. We compile the lisp code and copy the {\bf ES.o} file to the {\bf OUT} directory. This is eventually forcibly replaced by a recompiled version. Note that this code is not included in the generated catdef.spad file. <>= (/VERSIONCHECK 2) (DEFPARAMETER |ExpressionSpace;AL| 'NIL) (DEFUN |ExpressionSpace| () (LET (#:G1400) (COND (|ExpressionSpace;AL|) (T (SETQ |ExpressionSpace;AL| (|ExpressionSpace;|)))))) (DEFUN |ExpressionSpace;| () (PROG (#0=#:G1398) (RETURN (PROG1 (LETT #0# (|sublisV| (PAIR '(#1=#:G1396 #2=#:G1397) (LIST '(|Kernel| $) '(|Kernel| $))) (|Join| (|OrderedSet|) (|RetractableTo| '#1#) (|InnerEvalable| '#2# '$) (|Evalable| '$) (|mkCategory| '|domain| '(((|elt| ($ (|BasicOperator|) $)) T) ((|elt| ($ (|BasicOperator|) $ $)) T) ((|elt| ($ (|BasicOperator|) $ $ $)) T) ((|elt| ($ (|BasicOperator|) $ $ $ $)) T) ((|elt| ($ (|BasicOperator|) (|List| $))) T) ((|subst| ($ $ (|Equation| $))) T) ((|subst| ($ $ (|List| (|Equation| $)))) T) ((|subst| ($ $ (|List| (|Kernel| $)) (|List| $))) T) ((|box| ($ $)) T) ((|box| ($ (|List| $))) T) ((|paren| ($ $)) T) ((|paren| ($ (|List| $))) T) ((|distribute| ($ $)) T) ((|distribute| ($ $ $)) T) ((|height| ((|NonNegativeInteger|) $)) T) ((|mainKernel| ((|Union| (|Kernel| $) "failed") $)) T) ((|kernels| ((|List| (|Kernel| $)) $)) T) ((|tower| ((|List| (|Kernel| $)) $)) T) ((|operators| ((|List| (|BasicOperator|)) $)) T) ((|operator| ((|BasicOperator|) (|BasicOperator|))) T) ((|belong?| ((|Boolean|) (|BasicOperator|))) T) ((|is?| ((|Boolean|) $ (|BasicOperator|))) T) ((|is?| ((|Boolean|) $ (|Symbol|))) T) ((|kernel| ($ (|BasicOperator|) $)) T) ((|kernel| ($ (|BasicOperator|) (|List| $))) T) ((|map| ($ (|Mapping| $ $) (|Kernel| $))) T) ((|freeOf?| ((|Boolean|) $ $)) T) ((|freeOf?| ((|Boolean|) $ (|Symbol|))) T) ((|eval| ($ $ (|List| (|Symbol|)) (|List| (|Mapping| $ $)))) T) ((|eval| ($ $ (|List| (|Symbol|)) (|List| (|Mapping| $ (|List| $))))) T) ((|eval| ($ $ (|Symbol|) (|Mapping| $ (|List| $)))) T) ((|eval| ($ $ (|Symbol|) (|Mapping| $ $))) T) ((|eval| ($ $ (|List| (|BasicOperator|)) (|List| (|Mapping| $ $)))) T) ((|eval| ($ $ (|List| (|BasicOperator|)) (|List| (|Mapping| $ (|List| $))))) T) ((|eval| ($ $ (|BasicOperator|) (|Mapping| $ (|List| $)))) T) ((|eval| ($ $ (|BasicOperator|) (|Mapping| $ $))) T) ((|minPoly| ((|SparseUnivariatePolynomial| $) (|Kernel| $))) (|has| $ (|Ring|))) ((|definingPolynomial| ($ $)) (|has| $ (|Ring|))) ((|even?| ((|Boolean|) $)) (|has| $ (|RetractableTo| (|Integer|)))) ((|odd?| ((|Boolean|) $)) (|has| $ (|RetractableTo| (|Integer|))))) NIL '((|Boolean|) (|SparseUnivariatePolynomial| $) (|Kernel| $) (|BasicOperator|) (|List| (|BasicOperator|)) (|List| (|Mapping| $ (|List| $))) (|List| (|Mapping| $ $)) (|Symbol|) (|List| (|Symbol|)) (|List| $) (|List| (|Kernel| $)) (|NonNegativeInteger|) (|List| (|Equation| $)) (|Equation| $)) NIL))) |ExpressionSpace|) (SETELT #0# 0 '(|ExpressionSpace|)))))) (MAKEPROP '|ExpressionSpace| 'NILADIC T) @ \section{ES-.lsp BOOTSTRAP} {\bf ES-} depends on {\bf ES}. We need to break this cycle to build the algebra. So we keep a cached copy of the translated {\bf ES-} category which we can write into the {\bf MID} directory. We compile the lisp code and copy the {\bf ES-.o} file to the {\bf OUT} directory. This is eventually forcibly replaced by a recompiled version. Note that this code is not included in the generated catdef.spad file. <>= (/VERSIONCHECK 2) (DEFUN |ES-;box;2S;1| (|x| $) (SPADCALL (LIST |x|) (QREFELT $ 16))) (DEFUN |ES-;paren;2S;2| (|x| $) (SPADCALL (LIST |x|) (QREFELT $ 18))) (DEFUN |ES-;belong?;BoB;3| (|op| $) (COND ((SPADCALL |op| (QREFELT $ 13) (QREFELT $ 21)) 'T) ('T (SPADCALL |op| (QREFELT $ 14) (QREFELT $ 21))))) (DEFUN |ES-;listk| (|f| $) (SPADCALL (|ES-;allKernels| |f| $) (QREFELT $ 25))) (DEFUN |ES-;tower;SL;5| (|f| $) (SPADCALL (|ES-;listk| |f| $) (QREFELT $ 26))) (DEFUN |ES-;allk| (|l| $) (PROG (#0=#:G1410 |f| #1=#:G1411) (RETURN (SEQ (SPADCALL (ELT $ 30) (PROGN (LETT #0# NIL |ES-;allk|) (SEQ (LETT |f| NIL |ES-;allk|) (LETT #1# |l| |ES-;allk|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |f| (CAR #1#) |ES-;allk|) NIL)) (GO G191))) (SEQ (EXIT (LETT #0# (CONS (|ES-;allKernels| |f| $) #0#) |ES-;allk|))) (LETT #1# (CDR #1#) |ES-;allk|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) (SPADCALL NIL (QREFELT $ 29)) (QREFELT $ 33)))))) (DEFUN |ES-;operators;SL;7| (|f| $) (PROG (#0=#:G1414 |k| #1=#:G1415) (RETURN (SEQ (PROGN (LETT #0# NIL |ES-;operators;SL;7|) (SEQ (LETT |k| NIL |ES-;operators;SL;7|) (LETT #1# (|ES-;listk| |f| $) |ES-;operators;SL;7|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |k| (CAR #1#) |ES-;operators;SL;7|) NIL)) (GO G191))) (SEQ (EXIT (LETT #0# (CONS (SPADCALL |k| (QREFELT $ 35)) #0#) |ES-;operators;SL;7|))) (LETT #1# (CDR #1#) |ES-;operators;SL;7|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))))))) (DEFUN |ES-;height;SNni;8| (|f| $) (PROG (#0=#:G1420 |k| #1=#:G1421) (RETURN (SEQ (SPADCALL (ELT $ 41) (PROGN (LETT #0# NIL |ES-;height;SNni;8|) (SEQ (LETT |k| NIL |ES-;height;SNni;8|) (LETT #1# (SPADCALL |f| (QREFELT $ 38)) |ES-;height;SNni;8|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |k| (CAR #1#) |ES-;height;SNni;8|) NIL)) (GO G191))) (SEQ (EXIT (LETT #0# (CONS (SPADCALL |k| (QREFELT $ 40)) #0#) |ES-;height;SNni;8|))) (LETT #1# (CDR #1#) |ES-;height;SNni;8|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) 0 (QREFELT $ 44)))))) (DEFUN |ES-;freeOf?;SSB;9| (|x| |s| $) (PROG (#0=#:G1425 |k| #1=#:G1426) (RETURN (SEQ (SPADCALL (SPADCALL |s| (PROGN (LETT #0# NIL |ES-;freeOf?;SSB;9|) (SEQ (LETT |k| NIL |ES-;freeOf?;SSB;9|) (LETT #1# (|ES-;listk| |x| $) |ES-;freeOf?;SSB;9|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |k| (CAR #1#) |ES-;freeOf?;SSB;9|) NIL)) (GO G191))) (SEQ (EXIT (LETT #0# (CONS (SPADCALL |k| (QREFELT $ 46)) #0#) |ES-;freeOf?;SSB;9|))) (LETT #1# (CDR #1#) |ES-;freeOf?;SSB;9|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) (QREFELT $ 48)) (QREFELT $ 49)))))) (DEFUN |ES-;distribute;2S;10| (|x| $) (PROG (#0=#:G1429 |k| #1=#:G1430) (RETURN (SEQ (|ES-;unwrap| (PROGN (LETT #0# NIL |ES-;distribute;2S;10|) (SEQ (LETT |k| NIL |ES-;distribute;2S;10|) (LETT #1# (|ES-;listk| |x| $) |ES-;distribute;2S;10|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |k| (CAR #1#) |ES-;distribute;2S;10|) NIL)) (GO G191))) (SEQ (EXIT (COND ((SPADCALL |k| (QREFELT $ 13) (QREFELT $ 51)) (LETT #0# (CONS |k| #0#) |ES-;distribute;2S;10|))))) (LETT #1# (CDR #1#) |ES-;distribute;2S;10|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) |x| $))))) (DEFUN |ES-;box;LS;11| (|l| $) (SPADCALL (QREFELT $ 14) |l| (QREFELT $ 53))) (DEFUN |ES-;paren;LS;12| (|l| $) (SPADCALL (QREFELT $ 13) |l| (QREFELT $ 53))) (DEFUN |ES-;freeOf?;2SB;13| (|x| |k| $) (SPADCALL (SPADCALL (SPADCALL |k| (QREFELT $ 57)) (|ES-;listk| |x| $) (QREFELT $ 58)) (QREFELT $ 49))) (DEFUN |ES-;kernel;Bo2S;14| (|op| |arg| $) (SPADCALL |op| (LIST |arg|) (QREFELT $ 60))) (DEFUN |ES-;elt;Bo2S;15| (|op| |x| $) (SPADCALL |op| (LIST |x|) (QREFELT $ 53))) (DEFUN |ES-;elt;Bo3S;16| (|op| |x| |y| $) (SPADCALL |op| (LIST |x| |y|) (QREFELT $ 53))) (DEFUN |ES-;elt;Bo4S;17| (|op| |x| |y| |z| $) (SPADCALL |op| (LIST |x| |y| |z|) (QREFELT $ 53))) (DEFUN |ES-;elt;Bo5S;18| (|op| |x| |y| |z| |t| $) (SPADCALL |op| (LIST |x| |y| |z| |t|) (QREFELT $ 53))) (DEFUN |ES-;eval;SSMS;19| (|x| |s| |f| $) (SPADCALL |x| (LIST |s|) (LIST |f|) (QREFELT $ 68))) (DEFUN |ES-;eval;SBoMS;20| (|x| |s| |f| $) (SPADCALL |x| (LIST (SPADCALL |s| (QREFELT $ 70))) (LIST |f|) (QREFELT $ 68))) (DEFUN |ES-;eval;SSMS;21| (|x| |s| |f| $) (SPADCALL |x| (LIST |s|) (LIST (CONS #'|ES-;eval;SSMS;21!0| (VECTOR |f| $))) (QREFELT $ 68))) (DEFUN |ES-;eval;SSMS;21!0| (|#1| $$) (SPADCALL (SPADCALL |#1| (QREFELT (QREFELT $$ 1) 73)) (QREFELT $$ 0))) (DEFUN |ES-;eval;SBoMS;22| (|x| |s| |f| $) (SPADCALL |x| (LIST |s|) (LIST (CONS #'|ES-;eval;SBoMS;22!0| (VECTOR |f| $))) (QREFELT $ 76))) (DEFUN |ES-;eval;SBoMS;22!0| (|#1| $$) (SPADCALL (SPADCALL |#1| (QREFELT (QREFELT $$ 1) 73)) (QREFELT $$ 0))) (DEFUN |ES-;subst;SES;23| (|x| |e| $) (SPADCALL |x| (LIST |e|) (QREFELT $ 79))) (DEFUN |ES-;eval;SLLS;24| (|x| |ls| |lf| $) (PROG (#0=#:G1450 |f| #1=#:G1451) (RETURN (SEQ (SPADCALL |x| |ls| (PROGN (LETT #0# NIL |ES-;eval;SLLS;24|) (SEQ (LETT |f| NIL |ES-;eval;SLLS;24|) (LETT #1# |lf| |ES-;eval;SLLS;24|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |f| (CAR #1#) |ES-;eval;SLLS;24|) NIL)) (GO G191))) (SEQ (EXIT (LETT #0# (CONS (CONS #'|ES-;eval;SLLS;24!0| (VECTOR |f| $)) #0#) |ES-;eval;SLLS;24|))) (LETT #1# (CDR #1#) |ES-;eval;SLLS;24|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) (QREFELT $ 76)))))) (DEFUN |ES-;eval;SLLS;24!0| (|#1| $$) (SPADCALL (SPADCALL |#1| (QREFELT (QREFELT $$ 1) 73)) (QREFELT $$ 0))) (DEFUN |ES-;eval;SLLS;25| (|x| |ls| |lf| $) (PROG (#0=#:G1454 |f| #1=#:G1455) (RETURN (SEQ (SPADCALL |x| |ls| (PROGN (LETT #0# NIL |ES-;eval;SLLS;25|) (SEQ (LETT |f| NIL |ES-;eval;SLLS;25|) (LETT #1# |lf| |ES-;eval;SLLS;25|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |f| (CAR #1#) |ES-;eval;SLLS;25|) NIL)) (GO G191))) (SEQ (EXIT (LETT #0# (CONS (CONS #'|ES-;eval;SLLS;25!0| (VECTOR |f| $)) #0#) |ES-;eval;SLLS;25|))) (LETT #1# (CDR #1#) |ES-;eval;SLLS;25|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) (QREFELT $ 68)))))) (DEFUN |ES-;eval;SLLS;25!0| (|#1| $$) (SPADCALL (SPADCALL |#1| (QREFELT (QREFELT $$ 1) 73)) (QREFELT $$ 0))) (DEFUN |ES-;eval;SLLS;26| (|x| |ls| |lf| $) (PROG (#0=#:G1459 |s| #1=#:G1460) (RETURN (SEQ (SPADCALL |x| (PROGN (LETT #0# NIL |ES-;eval;SLLS;26|) (SEQ (LETT |s| NIL |ES-;eval;SLLS;26|) (LETT #1# |ls| |ES-;eval;SLLS;26|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |s| (CAR #1#) |ES-;eval;SLLS;26|) NIL)) (GO G191))) (SEQ (EXIT (LETT #0# (CONS (SPADCALL |s| (QREFELT $ 70)) #0#) |ES-;eval;SLLS;26|))) (LETT #1# (CDR #1#) |ES-;eval;SLLS;26|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) |lf| (QREFELT $ 68)))))) (DEFUN |ES-;map;MKS;27| (|fn| |k| $) (PROG (#0=#:G1475 |x| #1=#:G1476 |l|) (RETURN (SEQ (COND ((SPADCALL (LETT |l| (PROGN (LETT #0# NIL |ES-;map;MKS;27|) (SEQ (LETT |x| NIL |ES-;map;MKS;27|) (LETT #1# (SPADCALL |k| (QREFELT $ 86)) |ES-;map;MKS;27|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |ES-;map;MKS;27|) NIL)) (GO G191))) (SEQ (EXIT (LETT #0# (CONS (SPADCALL |x| |fn|) #0#) |ES-;map;MKS;27|))) (LETT #1# (CDR #1#) |ES-;map;MKS;27|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) |ES-;map;MKS;27|) (SPADCALL |k| (QREFELT $ 86)) (QREFELT $ 87)) (SPADCALL |k| (QREFELT $ 88))) ('T (SPADCALL (SPADCALL |k| (QREFELT $ 35)) |l| (QREFELT $ 53)))))))) (DEFUN |ES-;operator;2Bo;28| (|op| $) (COND ((SPADCALL |op| (SPADCALL "%paren" (QREFELT $ 9)) (QREFELT $ 90)) (QREFELT $ 13)) ((SPADCALL |op| (SPADCALL "%box" (QREFELT $ 9)) (QREFELT $ 90)) (QREFELT $ 14)) ('T (|error| "Unknown operator")))) (DEFUN |ES-;mainKernel;SU;29| (|x| $) (PROG (|l| |kk| #0=#:G1492 |n| |k|) (RETURN (SEQ (COND ((NULL (LETT |l| (SPADCALL |x| (QREFELT $ 38)) |ES-;mainKernel;SU;29|)) (CONS 1 "failed")) ('T (SEQ (LETT |n| (SPADCALL (LETT |k| (|SPADfirst| |l|) |ES-;mainKernel;SU;29|) (QREFELT $ 40)) |ES-;mainKernel;SU;29|) (SEQ (LETT |kk| NIL |ES-;mainKernel;SU;29|) (LETT #0# (CDR |l|) |ES-;mainKernel;SU;29|) G190 (COND ((OR (ATOM #0#) (PROGN (LETT |kk| (CAR #0#) |ES-;mainKernel;SU;29|) NIL)) (GO G191))) (SEQ (EXIT (COND ((< |n| (SPADCALL |kk| (QREFELT $ 40))) (SEQ (LETT |n| (SPADCALL |kk| (QREFELT $ 40)) |ES-;mainKernel;SU;29|) (EXIT (LETT |k| |kk| |ES-;mainKernel;SU;29|))))))) (LETT #0# (CDR #0#) |ES-;mainKernel;SU;29|) (GO G190) G191 (EXIT NIL)) (EXIT (CONS 0 |k|))))))))) (DEFUN |ES-;allKernels| (|f| $) (PROG (|l| |k| #0=#:G1505 |u| |s0| |n| |arg| |t| |s|) (RETURN (SEQ (LETT |s| (SPADCALL (LETT |l| (SPADCALL |f| (QREFELT $ 38)) |ES-;allKernels|) (QREFELT $ 29)) |ES-;allKernels|) (SEQ (LETT |k| NIL |ES-;allKernels|) (LETT #0# |l| |ES-;allKernels|) G190 (COND ((OR (ATOM #0#) (PROGN (LETT |k| (CAR #0#) |ES-;allKernels|) NIL)) (GO G191))) (SEQ (LETT |t| (SEQ (LETT |u| (SPADCALL (SPADCALL |k| (QREFELT $ 35)) "%dummyVar" (QREFELT $ 95)) |ES-;allKernels|) (EXIT (COND ((QEQCAR |u| 0) (SEQ (LETT |arg| (SPADCALL |k| (QREFELT $ 86)) |ES-;allKernels|) (LETT |s0| (SPADCALL (SPADCALL (SPADCALL |arg| (QREFELT $ 96)) (QREFELT $ 57)) (|ES-;allKernels| (|SPADfirst| |arg|) $) (QREFELT $ 97)) |ES-;allKernels|) (LETT |arg| (CDR (CDR |arg|)) |ES-;allKernels|) (LETT |n| (QCDR |u|) |ES-;allKernels|) (COND ((< 1 |n|) (LETT |arg| (CDR |arg|) |ES-;allKernels|))) (EXIT (SPADCALL |s0| (|ES-;allk| |arg| $) (QREFELT $ 30))))) ('T (|ES-;allk| (SPADCALL |k| (QREFELT $ 86)) $))))) |ES-;allKernels|) (EXIT (LETT |s| (SPADCALL |s| |t| (QREFELT $ 30)) |ES-;allKernels|))) (LETT #0# (CDR #0#) |ES-;allKernels|) (GO G190) G191 (EXIT NIL)) (EXIT |s|))))) (DEFUN |ES-;kernel;BoLS;31| (|op| |args| $) (COND ((NULL (SPADCALL |op| (QREFELT $ 98))) (|error| "Unknown operator")) ('T (|ES-;okkernel| |op| |args| $)))) (DEFUN |ES-;okkernel| (|op| |l| $) (PROG (#0=#:G1512 |f| #1=#:G1513) (RETURN (SEQ (SPADCALL (SPADCALL |op| |l| (+ 1 (SPADCALL (ELT $ 41) (PROGN (LETT #0# NIL |ES-;okkernel|) (SEQ (LETT |f| NIL |ES-;okkernel|) (LETT #1# |l| |ES-;okkernel|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |f| (CAR #1#) |ES-;okkernel|) NIL)) (GO G191))) (SEQ (EXIT (LETT #0# (CONS (SPADCALL |f| (QREFELT $ 100)) #0#) |ES-;okkernel|))) (LETT #1# (CDR #1#) |ES-;okkernel|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) 0 (QREFELT $ 44))) (QREFELT $ 101)) (QREFELT $ 88)))))) (DEFUN |ES-;elt;BoLS;33| (|op| |args| $) (PROG (|u| #0=#:G1529 |v|) (RETURN (SEQ (EXIT (COND ((NULL (SPADCALL |op| (QREFELT $ 98))) (|error| "Unknown operator")) ('T (SEQ (SEQ (LETT |u| (SPADCALL |op| (QREFELT $ 103)) |ES-;elt;BoLS;33|) (EXIT (COND ((QEQCAR |u| 0) (COND ((NULL (EQL (LENGTH |args|) (QCDR |u|))) (PROGN (LETT #0# (|error| "Wrong number of arguments") |ES-;elt;BoLS;33|) (GO #0#)))))))) (LETT |v| (SPADCALL |op| |args| (QREFELT $ 106)) |ES-;elt;BoLS;33|) (EXIT (COND ((QEQCAR |v| 0) (QCDR |v|)) ('T (|ES-;okkernel| |op| |args| $)))))))) #0# (EXIT #0#))))) (DEFUN |ES-;retract;SK;34| (|f| $) (PROG (|k|) (RETURN (SEQ (LETT |k| (SPADCALL |f| (QREFELT $ 108)) |ES-;retract;SK;34|) (EXIT (COND ((OR (QEQCAR |k| 1) (NULL (SPADCALL (SPADCALL (QCDR |k|) (QREFELT $ 88)) |f| (QREFELT $ 109)))) (|error| "not a kernel")) ('T (QCDR |k|)))))))) (DEFUN |ES-;retractIfCan;SU;35| (|f| $) (PROG (|k|) (RETURN (SEQ (LETT |k| (SPADCALL |f| (QREFELT $ 108)) |ES-;retractIfCan;SU;35|) (EXIT (COND ((OR (QEQCAR |k| 1) (NULL (SPADCALL (SPADCALL (QCDR |k|) (QREFELT $ 88)) |f| (QREFELT $ 109)))) (CONS 1 "failed")) ('T |k|))))))) (DEFUN |ES-;is?;SSB;36| (|f| |s| $) (PROG (|k|) (RETURN (SEQ (LETT |k| (SPADCALL |f| (QREFELT $ 112)) |ES-;is?;SSB;36|) (EXIT (COND ((QEQCAR |k| 1) 'NIL) ('T (SPADCALL (QCDR |k|) |s| (QREFELT $ 113))))))))) (DEFUN |ES-;is?;SBoB;37| (|f| |op| $) (PROG (|k|) (RETURN (SEQ (LETT |k| (SPADCALL |f| (QREFELT $ 112)) |ES-;is?;SBoB;37|) (EXIT (COND ((QEQCAR |k| 1) 'NIL) ('T (SPADCALL (QCDR |k|) |op| (QREFELT $ 51))))))))) (DEFUN |ES-;unwrap| (|l| |x| $) (PROG (|k| #0=#:G1554) (RETURN (SEQ (SEQ (LETT |k| NIL |ES-;unwrap|) (LETT #0# (NREVERSE |l|) |ES-;unwrap|) G190 (COND ((OR (ATOM #0#) (PROGN (LETT |k| (CAR #0#) |ES-;unwrap|) NIL)) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| |k| (|SPADfirst| (SPADCALL |k| (QREFELT $ 86))) (QREFELT $ 116)) |ES-;unwrap|))) (LETT #0# (CDR #0#) |ES-;unwrap|) (GO G190) G191 (EXIT NIL)) (EXIT |x|))))) (DEFUN |ES-;distribute;3S;39| (|x| |y| $) (PROG (|ky| #0=#:G1559 |k| #1=#:G1560) (RETURN (SEQ (LETT |ky| (SPADCALL |y| (QREFELT $ 57)) |ES-;distribute;3S;39|) (EXIT (|ES-;unwrap| (PROGN (LETT #0# NIL |ES-;distribute;3S;39|) (SEQ (LETT |k| NIL |ES-;distribute;3S;39|) (LETT #1# (|ES-;listk| |x| $) |ES-;distribute;3S;39|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |k| (CAR #1#) |ES-;distribute;3S;39|) NIL)) (GO G191))) (SEQ (EXIT (COND ((COND ((SPADCALL |k| (SPADCALL "%paren" (QREFELT $ 9)) (QREFELT $ 113)) (SPADCALL |ky| (|ES-;listk| (SPADCALL |k| (QREFELT $ 88)) $) (QREFELT $ 58))) ('T 'NIL)) (LETT #0# (CONS |k| #0#) |ES-;distribute;3S;39|))))) (LETT #1# (CDR #1#) |ES-;distribute;3S;39|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) |x| $)))))) (DEFUN |ES-;eval;SLS;40| (|f| |leq| $) (PROG (|rec|) (RETURN (SEQ (LETT |rec| (|ES-;mkKerLists| |leq| $) |ES-;eval;SLS;40|) (EXIT (SPADCALL |f| (QCAR |rec|) (QCDR |rec|) (QREFELT $ 118))))))) (DEFUN |ES-;subst;SLS;41| (|f| |leq| $) (PROG (|rec|) (RETURN (SEQ (LETT |rec| (|ES-;mkKerLists| |leq| $) |ES-;subst;SLS;41|) (EXIT (SPADCALL |f| (QCAR |rec|) (QCDR |rec|) (QREFELT $ 120))))))) (DEFUN |ES-;mkKerLists| (|leq| $) (PROG (|eq| #0=#:G1577 |k| |lk| |lv|) (RETURN (SEQ (LETT |lk| NIL |ES-;mkKerLists|) (LETT |lv| NIL |ES-;mkKerLists|) (SEQ (LETT |eq| NIL |ES-;mkKerLists|) (LETT #0# |leq| |ES-;mkKerLists|) G190 (COND ((OR (ATOM #0#) (PROGN (LETT |eq| (CAR #0#) |ES-;mkKerLists|) NIL)) (GO G191))) (SEQ (LETT |k| (SPADCALL (SPADCALL |eq| (QREFELT $ 123)) (QREFELT $ 112)) |ES-;mkKerLists|) (EXIT (COND ((QEQCAR |k| 1) (|error| "left hand side must be a single kernel")) ((NULL (SPADCALL (QCDR |k|) |lk| (QREFELT $ 58))) (SEQ (LETT |lk| (CONS (QCDR |k|) |lk|) |ES-;mkKerLists|) (EXIT (LETT |lv| (CONS (SPADCALL |eq| (QREFELT $ 124)) |lv|) |ES-;mkKerLists|))))))) (LETT #0# (CDR #0#) |ES-;mkKerLists|) (GO G190) G191 (EXIT NIL)) (EXIT (CONS |lk| |lv|)))))) (DEFUN |ES-;even?;SB;43| (|x| $) (|ES-;intpred?| |x| (ELT $ 126) $)) (DEFUN |ES-;odd?;SB;44| (|x| $) (|ES-;intpred?| |x| (ELT $ 128) $)) (DEFUN |ES-;intpred?| (|x| |pred?| $) (PROG (|u|) (RETURN (SEQ (LETT |u| (SPADCALL |x| (QREFELT $ 131)) |ES-;intpred?|) (EXIT (COND ((QEQCAR |u| 0) (SPADCALL (QCDR |u|) |pred?|)) ('T 'NIL))))))) (DEFUN |ExpressionSpace&| (|#1|) (PROG (|dv$1| |dv$| $ |pv$|) (RETURN (PROGN (LETT |dv$1| (|devaluate| |#1|) . #0=(|ExpressionSpace&|)) (LETT |dv$| (LIST '|ExpressionSpace&| |dv$1|) . #0#) (LETT $ (GETREFV 132) . #0#) (QSETREFV $ 0 |dv$|) (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasCategory| |#1| '(|RetractableTo| (|Integer|))) (|HasCategory| |#1| '(|Ring|)))) . #0#)) (|stuffDomainSlots| $) (QSETREFV $ 6 |#1|) (QSETREFV $ 13 (SPADCALL (SPADCALL "%paren" (QREFELT $ 9)) (QREFELT $ 12))) (QSETREFV $ 14 (SPADCALL (SPADCALL "%box" (QREFELT $ 9)) (QREFELT $ 12))) (COND ((|testBitVector| |pv$| 1) (PROGN (QSETREFV $ 127 (CONS (|dispatchFunction| |ES-;even?;SB;43|) $)) (QSETREFV $ 129 (CONS (|dispatchFunction| |ES-;odd?;SB;44|) $))))) $)))) (MAKEPROP '|ExpressionSpace&| '|infovec| (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|String|) (|Symbol|) (0 . |coerce|) (|BasicOperator|) (|CommonOperators|) (5 . |operator|) '|oppren| '|opbox| (|List| $) (10 . |box|) |ES-;box;2S;1| (15 . |paren|) |ES-;paren;2S;2| (|Boolean|) (20 . =) |ES-;belong?;BoB;3| (|List| 34) (|Set| 34) (26 . |parts|) (31 . |sort!|) (|List| 56) |ES-;tower;SL;5| (36 . |brace|) (41 . |union|) (|Mapping| 24 24 24) (|List| 24) (47 . |reduce|) (|Kernel| 6) (54 . |operator|) (|List| 10) |ES-;operators;SL;7| (59 . |kernels|) (|NonNegativeInteger|) (64 . |height|) (69 . |max|) (|Mapping| 39 39 39) (|List| 39) (75 . |reduce|) |ES-;height;SNni;8| (82 . |name|) (|List| 8) (87 . |member?|) (93 . |not|) |ES-;freeOf?;SSB;9| (98 . |is?|) |ES-;distribute;2S;10| (104 . |elt|) |ES-;box;LS;11| |ES-;paren;LS;12| (|Kernel| $) (110 . |retract|) (115 . |member?|) |ES-;freeOf?;2SB;13| (121 . |kernel|) |ES-;kernel;Bo2S;14| |ES-;elt;Bo2S;15| |ES-;elt;Bo3S;16| |ES-;elt;Bo4S;17| |ES-;elt;Bo5S;18| (|Mapping| $ 15) (|List| 66) (127 . |eval|) |ES-;eval;SSMS;19| (134 . |name|) |ES-;eval;SBoMS;20| (|List| 6) (139 . |first|) (|Mapping| $ $) |ES-;eval;SSMS;21| (144 . |eval|) |ES-;eval;SBoMS;22| (|List| 80) (151 . |subst|) (|Equation| $) |ES-;subst;SES;23| (|List| 74) |ES-;eval;SLLS;24| |ES-;eval;SLLS;25| |ES-;eval;SLLS;26| (157 . |argument|) (162 . =) (168 . |coerce|) |ES-;map;MKS;27| (173 . |is?|) |ES-;operator;2Bo;28| (|Union| 56 '"failed") |ES-;mainKernel;SU;29| (|Union| (|None|) '"failed") (179 . |property|) (185 . |second|) (190 . |remove!|) (196 . |belong?|) |ES-;kernel;BoLS;31| (201 . |height|) (206 . |kernel|) (|Union| 39 '"failed") (213 . |arity|) (|Union| 6 '"failed") (|BasicOperatorFunctions1| 6) (218 . |evaluate|) |ES-;elt;BoLS;33| (224 . |mainKernel|) (229 . =) |ES-;retract;SK;34| |ES-;retractIfCan;SU;35| (235 . |retractIfCan|) (240 . |is?|) |ES-;is?;SSB;36| |ES-;is?;SBoB;37| (246 . |eval|) |ES-;distribute;3S;39| (253 . |eval|) |ES-;eval;SLS;40| (260 . |subst|) |ES-;subst;SLS;41| (|Equation| 6) (267 . |lhs|) (272 . |rhs|) (|Integer|) (277 . |even?|) (282 . |even?|) (287 . |odd?|) (292 . |odd?|) (|Union| 125 '"failed") (297 . |retractIfCan|)) '#(|tower| 302 |subst| 307 |retractIfCan| 319 |retract| 324 |paren| 329 |operators| 339 |operator| 344 |odd?| 349 |map| 354 |mainKernel| 360 |kernel| 365 |is?| 377 |height| 389 |freeOf?| 394 |even?| 406 |eval| 411 |elt| 466 |distribute| 502 |box| 513 |belong?| 523) 'NIL (CONS (|makeByteWordVec2| 1 'NIL) (CONS '#() (CONS '#() (|makeByteWordVec2| 131 '(1 8 0 7 9 1 11 10 8 12 1 6 0 15 16 1 6 0 15 18 2 10 20 0 0 21 1 24 23 0 25 1 23 0 0 26 1 24 0 23 29 2 24 0 0 0 30 3 32 24 31 0 24 33 1 34 10 0 35 1 6 27 0 38 1 34 39 0 40 2 39 0 0 0 41 3 43 39 42 0 39 44 1 34 8 0 46 2 47 20 8 0 48 1 20 0 0 49 2 34 20 0 10 51 2 6 0 10 15 53 1 6 56 0 57 2 23 20 34 0 58 2 6 0 10 15 60 3 6 0 0 47 67 68 1 10 8 0 70 1 72 6 0 73 3 6 0 0 36 67 76 2 6 0 0 78 79 1 34 72 0 86 2 72 20 0 0 87 1 6 0 56 88 2 10 20 0 8 90 2 10 94 0 7 95 1 72 6 0 96 2 24 0 34 0 97 1 6 20 10 98 1 6 39 0 100 3 34 0 10 72 39 101 1 10 102 0 103 2 105 104 10 72 106 1 6 92 0 108 2 6 20 0 0 109 1 6 92 0 112 2 34 20 0 8 113 3 6 0 0 56 0 116 3 6 0 0 27 15 118 3 6 0 0 27 15 120 1 122 6 0 123 1 122 6 0 124 1 125 20 0 126 1 0 20 0 127 1 125 20 0 128 1 0 20 0 129 1 6 130 0 131 1 0 27 0 28 2 0 0 0 78 121 2 0 0 0 80 81 1 0 92 0 111 1 0 56 0 110 1 0 0 0 19 1 0 0 15 55 1 0 36 0 37 1 0 10 10 91 1 0 20 0 129 2 0 0 74 56 89 1 0 92 0 93 2 0 0 10 15 99 2 0 0 10 0 61 2 0 20 0 8 114 2 0 20 0 10 115 1 0 39 0 45 2 0 20 0 8 50 2 0 20 0 0 59 1 0 20 0 127 3 0 0 0 10 74 77 3 0 0 0 36 67 85 3 0 0 0 10 66 71 3 0 0 0 36 82 83 3 0 0 0 8 66 69 3 0 0 0 8 74 75 3 0 0 0 47 82 84 2 0 0 0 78 119 2 0 0 10 15 107 5 0 0 10 0 0 0 0 65 3 0 0 10 0 0 63 4 0 0 10 0 0 0 64 2 0 0 10 0 62 2 0 0 0 0 117 1 0 0 0 52 1 0 0 15 54 1 0 0 0 17 1 0 20 10 22))))) '|lookupComplete|)) @ \section{package ES1 ExpressionSpaceFunctions1} <>= )abbrev package ES1 ExpressionSpaceFunctions1 ++ Lifting of maps from expression spaces to kernels over them ++ Author: Manuel Bronstein ++ Date Created: 23 March 1988 ++ Date Last Updated: 19 April 1991 ++ Description: ++ This package allows a map from any expression space into any object ++ to be lifted to a kernel over the expression set, using a given ++ property of the operator of the kernel. -- should not be exposed ExpressionSpaceFunctions1(F:ExpressionSpace, S:Type): with map: (F -> S, String, Kernel F) -> S ++ map(f, p, k) uses the property p of the operator ++ of k, in order to lift f and apply it to k. == add -- prop contains an evaluation function List S -> S map(F2S, prop, k) == args := [F2S x for x in argument k]$List(S) (p := property(operator k, prop)) case None => ((p::None) pretend (List S -> S)) args error "Operator does not have required property" @ \section{package ES2 ExpressionSpaceFunctions2} <>= )abbrev package ES2 ExpressionSpaceFunctions2 ++ Lifting of maps from expression spaces to kernels over them ++ Author: Manuel Bronstein ++ Date Created: 23 March 1988 ++ Date Last Updated: 19 April 1991 ++ Description: ++ This package allows a mapping E -> F to be lifted to a kernel over E; ++ This lifting can fail if the operator of the kernel cannot be applied ++ in F; Do not use this package with E = F, since this may ++ drop some properties of the operators. ExpressionSpaceFunctions2(E:ExpressionSpace, F:ExpressionSpace): with map: (E -> F, Kernel E) -> F ++ map(f, k) returns \spad{g = op(f(a1),...,f(an))} where ++ \spad{k = op(a1,...,an)}. == add map(f, k) == (operator(operator k)$F) [f x for x in argument k]$List(F) @ \section{category FS FunctionSpace} <>= )abbrev category FS FunctionSpace ++ Category for formal functions ++ Author: Manuel Bronstein ++ Date Created: 22 March 1988 ++ Date Last Updated: 14 February 1994 ++ Description: ++ A space of formal functions with arguments in an arbitrary ++ ordered set. ++ Keywords: operator, kernel, function. FunctionSpace(R:OrderedSet): Category == Definition where OP ==> BasicOperator O ==> OutputForm SY ==> Symbol N ==> NonNegativeInteger Z ==> Integer K ==> Kernel % Q ==> Fraction R PR ==> Polynomial R MP ==> SparseMultivariatePolynomial(R, K) QF==> PolynomialCategoryQuotientFunctions(IndexedExponents K,K,R,MP,%) ODD ==> "odd" EVEN ==> "even" SPECIALDIFF ==> "%specialDiff" SPECIALDISP ==> "%specialDisp" SPECIALEQUAL ==> "%specialEqual" SPECIALINPUT ==> "%specialInput" Definition ==> Join(ExpressionSpace, RetractableTo SY, Patternable R, FullyPatternMatchable R, FullyRetractableTo R) with ground? : % -> Boolean ++ ground?(f) tests if f is an element of R. ground : % -> R ++ ground(f) returns f as an element of R. ++ An error occurs if f is not an element of R. variables : % -> List SY ++ variables(f) returns the list of all the variables of f. applyQuote: (SY, %) -> % ++ applyQuote(foo, x) returns \spad{'foo(x)}. applyQuote: (SY, %, %) -> % ++ applyQuote(foo, x, y) returns \spad{'foo(x,y)}. applyQuote: (SY, %, %, %) -> % ++ applyQuote(foo, x, y, z) returns \spad{'foo(x,y,z)}. applyQuote: (SY, %, %, %, %) -> % ++ applyQuote(foo, x, y, z, t) returns \spad{'foo(x,y,z,t)}. applyQuote: (SY, List %) -> % ++ applyQuote(foo, [x1,...,xn]) returns \spad{'foo(x1,...,xn)}. if R has ConvertibleTo InputForm then ConvertibleTo InputForm eval : (%, SY) -> % ++ eval(f, foo) unquotes all the foo's in f. eval : (%, List SY) -> % ++ eval(f, [foo1,...,foon]) unquotes all the \spad{fooi}'s in f. eval : % -> % ++ eval(f) unquotes all the quoted operators in f. eval : (%, OP, %, SY) -> % ++ eval(x, s, f, y) replaces every \spad{s(a)} in x by \spad{f(y)} ++ with \spad{y} replaced by \spad{a} for any \spad{a}. eval : (%, List OP, List %, SY) -> % ++ eval(x, [s1,...,sm], [f1,...,fm], y) replaces every ++ \spad{si(a)} in x by \spad{fi(y)} ++ with \spad{y} replaced by \spad{a} for any \spad{a}. if R has SemiGroup then Monoid -- the following line is necessary because of a compiler bug "**" : (%, N) -> % ++ x**n returns x * x * x * ... * x (n times). isTimes: % -> Union(List %, "failed") ++ isTimes(p) returns \spad{[a1,...,an]} ++ if \spad{p = a1*...*an} and \spad{n > 1}. isExpt : % -> Union(Record(var:K,exponent:Z),"failed") ++ isExpt(p) returns \spad{[x, n]} if \spad{p = x**n} ++ and \spad{n <> 0}. if R has Group then Group if R has AbelianSemiGroup then AbelianMonoid isPlus: % -> Union(List %, "failed") ++ isPlus(p) returns \spad{[m1,...,mn]} ++ if \spad{p = m1 +...+ mn} and \spad{n > 1}. isMult: % -> Union(Record(coef:Z, var:K),"failed") ++ isMult(p) returns \spad{[n, x]} if \spad{p = n * x} ++ and \spad{n <> 0}. if R has AbelianGroup then AbelianGroup if R has Ring then Ring RetractableTo PR PartialDifferentialRing SY FullyLinearlyExplicitRingOver R coerce : MP -> % ++ coerce(p) returns p as an element of %. numer : % -> MP ++ numer(f) returns the ++ numerator of f viewed as a polynomial in the kernels over R ++ if R is an integral domain. If not, then numer(f) = f viewed ++ as a polynomial in the kernels over R. -- DO NOT change this meaning of numer! MB 1/90 numerator : % -> % ++ numerator(f) returns the numerator of \spad{f} converted to %. isExpt:(%,OP) -> Union(Record(var:K,exponent:Z),"failed") ++ isExpt(p,op) returns \spad{[x, n]} if \spad{p = x**n} ++ and \spad{n <> 0} and \spad{x = op(a)}. isExpt:(%,SY) -> Union(Record(var:K,exponent:Z),"failed") ++ isExpt(p,f) returns \spad{[x, n]} if \spad{p = x**n} ++ and \spad{n <> 0} and \spad{x = f(a)}. isPower : % -> Union(Record(val:%,exponent:Z),"failed") ++ isPower(p) returns \spad{[x, n]} if \spad{p = x**n} ++ and \spad{n <> 0}. eval: (%, List SY, List N, List(% -> %)) -> % ++ eval(x, [s1,...,sm], [n1,...,nm], [f1,...,fm]) replaces ++ every \spad{si(a)**ni} in x by \spad{fi(a)} for any \spad{a}. eval: (%, List SY, List N, List(List % -> %)) -> % ++ eval(x, [s1,...,sm], [n1,...,nm], [f1,...,fm]) replaces ++ every \spad{si(a1,...,an)**ni} in x by \spad{fi(a1,...,an)} ++ for any a1,...,am. eval: (%, SY, N, List % -> %) -> % ++ eval(x, s, n, f) replaces every \spad{s(a1,...,am)**n} in x ++ by \spad{f(a1,...,am)} for any a1,...,am. eval: (%, SY, N, % -> %) -> % ++ eval(x, s, n, f) replaces every \spad{s(a)**n} in x ++ by \spad{f(a)} for any \spad{a}. if R has CharacteristicZero then CharacteristicZero if R has CharacteristicNonZero then CharacteristicNonZero if R has CommutativeRing then Algebra R if R has IntegralDomain then Field RetractableTo Fraction PR convert : Factored % -> % ++ convert(f1\^e1 ... fm\^em) returns \spad{(f1)\^e1 ... (fm)\^em} ++ as an element of %, using formal kernels ++ created using a \spadfunFrom{paren}{ExpressionSpace}. denom : % -> MP ++ denom(f) returns the denominator of f viewed as a ++ polynomial in the kernels over R. denominator : % -> % ++ denominator(f) returns the denominator of \spad{f} converted to %. "/" : (MP, MP) -> % ++ p1/p2 returns the quotient of p1 and p2 as an element of %. coerce : Q -> % ++ coerce(q) returns q as an element of %. coerce : Polynomial Q -> % ++ coerce(p) returns p as an element of %. coerce : Fraction Polynomial Q -> % ++ coerce(f) returns f as an element of %. univariate: (%, K) -> Fraction SparseUnivariatePolynomial % ++ univariate(f, k) returns f viewed as a univariate fraction in k. if R has RetractableTo Z then RetractableTo Fraction Z add import BasicOperatorFunctions1(%) -- these are needed in Ring only, but need to be declared here -- because of compiler bug: if they are declared inside the Ring -- case, then they are not visible inside the IntegralDomain case. smpIsMult : MP -> Union(Record(coef:Z, var:K),"failed") smpret : MP -> Union(PR, "failed") smpeval : (MP, List K, List %) -> % smpsubst : (MP, List K, List %) -> % smpderiv : (MP, SY) -> % smpunq : (MP, List SY, Boolean) -> % kerderiv : (K, SY) -> % kderiv : K -> List % opderiv : (OP, N) -> List(List % -> %) smp2O : MP -> O bestKernel: List K -> K worse? : (K, K) -> Boolean diffArg : (List %, OP, N) -> List % substArg : (OP, List %, Z, %) -> % dispdiff : List % -> Record(name:O, sub:O, arg:List O, level:N) ddiff : List % -> O diffEval : List % -> % dfeval : (List %, K) -> % smprep : (List SY, List N, List(List % -> %), MP) -> % diffdiff : (List %, SY) -> % diffdiff0 : (List %, SY, %, K, List %) -> % subs : (% -> %, K) -> % symsub : (SY, Z) -> SY kunq : (K, List SY, Boolean) -> % pushunq : (List SY, List %) -> List % notfound : (K -> %, List K, K) -> % equaldiff : (K,K)->Boolean debugA: (List % ,List %,Boolean) -> Boolean opdiff := operator("%diff"::SY)$CommonOperators() opquote := operator("applyQuote"::SY)$CommonOperators ground? x == retractIfCan(x)@Union(R,"failed") case R ground x == retract x coerce(x:SY):% == kernel(x)@K :: % retract(x:%):SY == symbolIfCan(retract(x)@K)::SY applyQuote(s:SY, x:%) == applyQuote(s, [x]) applyQuote(s, x, y) == applyQuote(s, [x, y]) applyQuote(s, x, y, z) == applyQuote(s, [x, y, z]) applyQuote(s, x, y, z, t) == applyQuote(s, [x, y, z, t]) applyQuote(s:SY, l:List %) == opquote concat(s::%, l) belong? op == op = opdiff or op = opquote subs(fn, k) == kernel(operator k,[fn x for x in argument k]$List(%)) operator op == is?(op, "%diff"::SY) => opdiff is?(op, "%quote"::SY) => opquote error "Unknown operator" if R has ConvertibleTo InputForm then INP==>InputForm import MakeUnaryCompiledFunction(%, %, %) indiff: List % -> INP pint : List INP-> INP differentiand: List % -> % differentiand l == eval(first l, retract(second l)@K, third l) pint l == convert concat(convert("D"::SY)@INP, l) indiff l == r2:= convert([convert("::"::SY)@INP,convert(third l)@INP,convert("Symbol"::SY)@INP]@List INP)@INP pint [convert(differentiand l)@INP, r2] eval(f:%, s:SY) == eval(f, [s]) eval(f:%, s:OP, g:%, x:SY) == eval(f, [s], [g], x) eval(f:%, ls:List OP, lg:List %, x:SY) == eval(f, ls, [compiledFunction(g, x) for g in lg]) setProperty(opdiff,SPECIALINPUT,indiff@(List % -> InputForm) pretend None) variables x == l := empty()$List(SY) for k in tower x repeat if ((s := symbolIfCan k) case SY) then l := concat(s::SY, l) reverse_! l retractIfCan(x:%):Union(SY, "failed") == (k := retractIfCan(x)@Union(K,"failed")) case "failed" => "failed" symbolIfCan(k::K) if R has Ring then import UserDefinedPartialOrdering(SY) -- cannot use new()$Symbol because of possible re-instantiation gendiff := "%%0"::SY characteristic() == characteristic()$R coerce(k:K):% == k::MP::% symsub(sy, i) == concat(string sy, convert(i)@String)::SY numerator x == numer(x)::% eval(x:%, s:SY, n:N, f:% -> %) == eval(x,[s],[n],[f first #1]) eval(x:%, s:SY, n:N, f:List % -> %) == eval(x, [s], [n], [f]) eval(x:%, l:List SY, f:List(List % -> %)) == eval(x, l, new(#l, 1), f) elt(op:OP, args:List %) == unary? op and ((od? := has?(op, ODD)) or has?(op, EVEN)) and leadingCoefficient(numer first args) < 0 => x := op(- first args) od? => -x x elt(op, args)$ExpressionSpace_&(%) eval(x:%, s:List SY, n:List N, l:List(% -> %)) == eval(x, s, n, [f first #1 for f in l]$List(List % -> %)) -- op(arg)**m ==> func(arg)**(m quo n) * op(arg)**(m rem n) smprep(lop, lexp, lfunc, p) == (v := mainVariable p) case "failed" => p::% symbolIfCan(k := v::K) case SY => p::% g := (op := operator k) (arg := [eval(a,lop,lexp,lfunc) for a in argument k]$List(%)) q := map(eval(#1::%, lop, lexp, lfunc), univariate(p, k))$SparseUnivariatePolynomialFunctions2(MP, %) (n := position(name op, lop)) < minIndex lop => q g a:% := 0 f := eval((lfunc.n) arg, lop, lexp, lfunc) e := lexp.n while q ~= 0 repeat m := degree q qr := divide(m, e) t1 := f ** (qr.quotient)::N t2 := g ** (qr.remainder)::N a := a + leadingCoefficient(q) * t1 * t2 q := reductum q a dispdiff l == s := second(l)::O t := third(l)::O a := argument(k := retract(first l)@K) is?(k, opdiff) => rec := dispdiff a i := position(s, rec.arg) rec.arg.i := t [rec.name, hconcat(rec.sub, hconcat(","::SY::O, (i+1-minIndex a)::O)), rec.arg, (zero?(rec.level) => 0; rec.level + 1)] i := position(second l, a) m := [x::O for x in a]$List(O) m.i := t [name(operator k)::O, hconcat(","::SY::O, (i+1-minIndex a)::O), m, (empty? rest a => 1; 0)] ddiff l == rec := dispdiff l opname := zero?(rec.level) => sub(rec.name, rec.sub) differentiate(rec.name, rec.level) prefix(opname, rec.arg) substArg(op, l, i, g) == z := copy l z.i := g kernel(op, z) diffdiff(l, x) == f := kernel(opdiff, l) diffdiff0(l, x, f, retract(f)@K, empty()) diffdiff0(l, x, expr, kd, done) == op := operator(k := retract(first l)@K) gg := second l u := third l arg := argument k ans:% := 0 if (not member?(u,done)) and (ans := differentiate(u,x))~=0 then ans := ans * kernel(opdiff, [subst(expr, [kd], [kernel(opdiff, [first l, gg, gg])]), gg, u]) done := concat(gg, done) is?(k, opdiff) => ans + diffdiff0(arg, x, expr, k, done) for i in minIndex arg .. maxIndex arg for b in arg repeat if (not member?(b,done)) and (bp:=differentiate(b,x))~=0 then g := symsub(gendiff, i)::% ans := ans + bp * kernel(opdiff, [subst(expr, [kd], [kernel(opdiff, [substArg(op, arg, i, g), gg, u])]), g, b]) ans dfeval(l, g) == eval(differentiate(first l, symbolIfCan(g)::SY), g, third l) diffEval l == k:K g := retract(second l)@K ((u := retractIfCan(first l)@Union(K, "failed")) case "failed") or (u case K and symbolIfCan(k := u::K) case SY) => dfeval(l, g) op := operator k (ud := derivative op) case "failed" => -- possible trouble -- make sure it is a dummy var dumm:%:=symsub(gendiff,1)::% ss:=subst(l.1,l.2=dumm) -- output(nl::OutputForm)$OutputPackage -- output("fixed"::OutputForm)$OutputPackage nl:=[ss,dumm,l.3] kernel(opdiff, nl) (n := position(second l,argument k)) < minIndex l => dfeval(l,g) d := ud::List(List % -> %) eval((d.n)(argument k), g, third l) diffArg(l, op, i) == n := i - 1 + minIndex l z := copy l z.n := g := symsub(gendiff, n)::% [kernel(op, z), g, l.n] opderiv(op, n) == -- one? n => (n = 1) => g := symsub(gendiff, n)::% [kernel(opdiff,[kernel(op, g), g, first #1])] [kernel(opdiff, diffArg(#1, op, i)) for i in 1..n] kderiv k == zero?(n := #(args := argument k)) => empty() op := operator k grad := (u := derivative op) case "failed" => opderiv(op, n) u::List(List % -> %) if #grad ~= n then grad := opderiv(op, n) [g args for g in grad] -- SPECIALDIFF contains a map (List %, Symbol) -> % -- it is used when the usual chain rule does not apply, -- for instance with implicit algebraics. kerderiv(k, x) == (v := symbolIfCan(k)) case SY => v::SY = x => 1 0 (fn := property(operator k, SPECIALDIFF)) case None => ((fn::None) pretend ((List %, SY) -> %)) (argument k, x) +/[g * differentiate(y,x) for g in kderiv k for y in argument k] smpderiv(p, x) == map(retract differentiate(#1::PR, x), p)::% + +/[differentiate(p,k)::% * kerderiv(k, x) for k in variables p] coerce(p:PR):% == map(#1::%, #1::%, p)$PolynomialCategoryLifting( IndexedExponents SY, SY, R, PR, %) worse?(k1, k2) == (u := less?(name operator k1,name operator k2)) case "failed" => k1 < k2 u::Boolean bestKernel l == empty? rest l => first l a := bestKernel rest l worse?(first l, a) => a first l smp2O p == (r:=retractIfCan(p)@Union(R,"failed")) case R =>r::R::OutputForm a := userOrdered?() => bestKernel variables p mainVariable(p)::K outputForm(map(#1::%, univariate(p, a))$SparseUnivariatePolynomialFunctions2(MP, %), a::OutputForm) smpsubst(p, lk, lv) == map(match(lk, lv, #1, notfound(subs(subst(#1, lk, lv), #1), lk, #1))$ListToMap(K,%), #1::%,p)$PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%) smpeval(p, lk, lv) == map(match(lk, lv, #1, notfound(map(eval(#1, lk, lv), #1), lk, #1))$ListToMap(K,%), #1::%,p)$PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%) -- this is called on k when k is not a member of lk notfound(fn, lk, k) == empty? setIntersection(tower(f := k::%), lk) => f fn k if R has ConvertibleTo InputForm then pushunq(l, arg) == empty? l => [eval a for a in arg] [eval(a, l) for a in arg] kunq(k, l, givenlist?) == givenlist? and empty? l => k::% is?(k, opquote) and (member?(s:=retract(first argument k)@SY, l) or empty? l) => interpret(convert(concat(convert(s)@InputForm, [convert a for a in pushunq(l, rest argument k) ]@List(InputForm)))@InputForm)$InputFormFunctions1(%) (operator k) pushunq(l, argument k) smpunq(p, l, givenlist?) == givenlist? and empty? l => p::% map(kunq(#1, l, givenlist?), #1::%, p)$PolynomialCategoryLifting(IndexedExponents K,K,R,MP,%) smpret p == "or"/[symbolIfCan(k) case "failed" for k in variables p] => "failed" map(symbolIfCan(#1)::SY::PR, #1::PR, p)$PolynomialCategoryLifting(IndexedExponents K, K, R, MP, PR) isExpt(x:%, op:OP) == (u := isExpt x) case "failed" => "failed" is?((u::Record(var:K, exponent:Z)).var, op) => u "failed" isExpt(x:%, sy:SY) == (u := isExpt x) case "failed" => "failed" is?((u::Record(var:K, exponent:Z)).var, sy) => u "failed" if R has RetractableTo Z then smpIsMult p == -- (u := mainVariable p) case K and one? degree(q:=univariate(p,u::K)) (u := mainVariable p) case K and (degree(q:=univariate(p,u::K))=1) and zero?(leadingCoefficient reductum q) and ((r:=retractIfCan(leadingCoefficient q)@Union(R,"failed")) case R) and (n := retractIfCan(r::R)@Union(Z, "failed")) case Z => [n::Z, u::K] "failed" evaluate(opdiff, diffEval) debugA(a1,a2,t) == -- uncomment for debugging -- output(hconcat [a1::OutputForm,a2::OutputForm,t::OutputForm])$OutputPackage t equaldiff(k1,k2) == a1:=argument k1 a2:=argument k2 -- check the operator res:=operator k1 = operator k2 not res => debugA(a1,a2,res) -- check the evaluation point res:= (a1.3 = a2.3) not res => debugA(a1,a2,res) -- check all the arguments res:= (a1.1 = a2.1) and (a1.2 = a2.2) res => debugA(a1,a2,res) -- check the substituted arguments (subst(a1.1,[retract(a1.2)@K],[a2.2]) = a2.1) => debugA(a1,a2,true) debugA(a1,a2,false) setProperty(opdiff,SPECIALEQUAL, equaldiff@((K,K) -> Boolean) pretend None) setProperty(opdiff, SPECIALDIFF, diffdiff@((List %, SY) -> %) pretend None) setProperty(opdiff, SPECIALDISP, ddiff@(List % -> OutputForm) pretend None) if not(R has IntegralDomain) then mainKernel x == mainVariable numer x kernels x == variables numer x retract(x:%):R == retract numer x retract(x:%):PR == smpret(numer x)::PR retractIfCan(x:%):Union(R, "failed") == retract numer x retractIfCan(x:%):Union(PR, "failed") == smpret numer x eval(x:%, lk:List K, lv:List %) == smpeval(numer x, lk, lv) subst(x:%, lk:List K, lv:List %) == smpsubst(numer x, lk, lv) differentiate(x:%, s:SY) == smpderiv(numer x, s) coerce(x:%):OutputForm == smp2O numer x if R has ConvertibleTo InputForm then eval(f:%, l:List SY) == smpunq(numer f, l, true) eval f == smpunq(numer f, empty(), false) eval(x:%, s:List SY, n:List N, f:List(List % -> %)) == smprep(s, n, f, numer x) isPlus x == (u := isPlus numer x) case "failed" => "failed" [p::% for p in u::List(MP)] isTimes x == (u := isTimes numer x) case "failed" => "failed" [p::% for p in u::List(MP)] isExpt x == (u := isExpt numer x) case "failed" => "failed" r := u::Record(var:K, exponent:NonNegativeInteger) [r.var, r.exponent::Z] isPower x == (u := isExpt numer x) case "failed" => "failed" r := u::Record(var:K, exponent:NonNegativeInteger) [r.var::%, r.exponent::Z] if R has ConvertibleTo Pattern Z then convert(x:%):Pattern(Z) == convert numer x if R has ConvertibleTo Pattern Float then convert(x:%):Pattern(Float) == convert numer x if R has RetractableTo Z then isMult x == smpIsMult numer x if R has CommutativeRing then r:R * x:% == r::MP::% * x if R has IntegralDomain then par : % -> % mainKernel x == mainVariable(x)$QF kernels x == variables(x)$QF univariate(x:%, k:K) == univariate(x, k)$QF isPlus x == isPlus(x)$QF isTimes x == isTimes(x)$QF isExpt x == isExpt(x)$QF isPower x == isPower(x)$QF denominator x == denom(x)::% coerce(q:Q):% == (numer q)::MP / (denom q)::MP coerce(q:Fraction PR):% == (numer q)::% / (denom q)::% coerce(q:Fraction Polynomial Q) == (numer q)::% / (denom q)::% retract(x:%):PR == retract(retract(x)@Fraction(PR)) retract(x:%):Fraction(PR) == smpret(numer x)::PR / smpret(denom x)::PR retract(x:%):R == (retract(numer x)@R exquo retract(denom x)@R)::R coerce(x:%):OutputForm == -- one?(denom x) => smp2O numer x ((denom x) = 1) => smp2O numer x smp2O(numer x) / smp2O(denom x) retractIfCan(x:%):Union(R, "failed") == (n := retractIfCan(numer x)@Union(R, "failed")) case "failed" or (d := retractIfCan(denom x)@Union(R, "failed")) case "failed" or (r := n::R exquo d::R) case "failed" => "failed" r::R eval(f:%, l:List SY) == smpunq(numer f, l, true) / smpunq(denom f, l, true) if R has ConvertibleTo InputForm then eval f == smpunq(numer f, empty(), false) / smpunq(denom f, empty(), false) eval(x:%, s:List SY, n:List N, f:List(List % -> %)) == smprep(s, n, f, numer x) / smprep(s, n, f, denom x) differentiate(f:%, x:SY) == (smpderiv(numer f, x) * denom(f)::% - numer(f)::% * smpderiv(denom f, x)) / (denom(f)::% ** 2) eval(x:%, lk:List K, lv:List %) == smpeval(numer x, lk, lv) / smpeval(denom x, lk, lv) subst(x:%, lk:List K, lv:List %) == smpsubst(numer x, lk, lv) / smpsubst(denom x, lk, lv) par x == (r := retractIfCan(x)@Union(R, "failed")) case R => x paren x convert(x:Factored %):% == par(unit x) * */[par(f.factor) ** f.exponent for f in factors x] retractIfCan(x:%):Union(PR, "failed") == (u := retractIfCan(x)@Union(Fraction PR,"failed")) case "failed" => "failed" retractIfCan(u::Fraction(PR)) retractIfCan(x:%):Union(Fraction PR, "failed") == (n := smpret numer x) case "failed" => "failed" (d := smpret denom x) case "failed" => "failed" n::PR / d::PR coerce(p:Polynomial Q):% == map(#1::%, #1::%, p)$PolynomialCategoryLifting(IndexedExponents SY, SY, Q, Polynomial Q, %) if R has RetractableTo Z then coerce(x:Fraction Z):% == numer(x)::MP / denom(x)::MP isMult x == (u := smpIsMult numer x) case "failed" or (v := retractIfCan(denom x)@Union(R, "failed")) case "failed" or (w := retractIfCan(v::R)@Union(Z, "failed")) case "failed" => "failed" r := u::Record(coef:Z, var:K) (q := r.coef exquo w::Z) case "failed" => "failed" [q::Z, r.var] if R has ConvertibleTo Pattern Z then convert(x:%):Pattern(Z) == convert(numer x) / convert(denom x) if R has ConvertibleTo Pattern Float then convert(x:%):Pattern(Float) == convert(numer x) / convert(denom x) @ \section{package FS2 FunctionSpaceFunctions2} <>= )abbrev package FS2 FunctionSpaceFunctions2 ++ Lifting of maps to function spaces ++ Author: Manuel Bronstein ++ Date Created: 22 March 1988 ++ Date Last Updated: 3 May 1994 ++ Description: ++ This package allows a mapping R -> S to be lifted to a mapping ++ from a function space over R to a function space over S; FunctionSpaceFunctions2(R, A, S, B): Exports == Implementation where R, S: Join(Ring, OrderedSet) A : FunctionSpace R B : FunctionSpace S K ==> Kernel A P ==> SparseMultivariatePolynomial(R, K) Exports ==> with map: (R -> S, A) -> B ++ map(f, a) applies f to all the constants in R appearing in \spad{a}. Implementation ==> add smpmap: (R -> S, P) -> B smpmap(fn, p) == map(map(map(fn, #1), #1)$ExpressionSpaceFunctions2(A,B),fn(#1)::B, p)$PolynomialCategoryLifting(IndexedExponents K, K, R, P, B) if R has IntegralDomain then if S has IntegralDomain then map(f, x) == smpmap(f, numer x) / smpmap(f, denom x) else map(f, x) == smpmap(f, numer x) * (recip(smpmap(f, denom x))::B) else map(f, x) == smpmap(f, numer x) @ \section{License} <>= --Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --All rights reserved. -- --Redistribution and use in source and binary forms, with or without --modification, are permitted provided that the following conditions are --met: -- -- - Redistributions of source code must retain the above copyright -- notice, this list of conditions and the following disclaimer. -- -- - Redistributions in binary form must reproduce the above copyright -- notice, this list of conditions and the following disclaimer in -- the documentation and/or other materials provided with the -- distribution. -- -- - Neither the name of The Numerical ALgorithms Group Ltd. nor the -- names of its contributors may be used to endorse or promote products -- derived from this software without specific prior written permission. -- --THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. @ <<*>>= <> -- SPAD files for the functional world should be compiled in the -- following order: -- -- op kl FSPACE expr funcpkgs <> <> <> <> <> @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}