\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}
<<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.
<<ES.lsp BOOTSTRAP>>=
(/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.
<<ES-.lsp BOOTSTRAP>>=
(/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}
<<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}
<<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}
<<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}
<<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}
<<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.
@
<<*>>=
<<license>>
-- SPAD files for the functional world should be compiled in the
-- following order:
--
-- op kl FSPACE expr funcpkgs
<<category ES ExpressionSpace>>
<<package ES1 ExpressionSpaceFunctions1>>
<<package ES2 ExpressionSpaceFunctions2>>
<<category FS FunctionSpace>>
<<package FS2 FunctionSpaceFunctions2>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}