--* From C1GOMEZ%WATSON.vnet.ibm.com@yktvmv.watson.ibm.com Wed Sep 7 14:08:12 1994 --* Received: from yktvmv-ob.watson.ibm.com by asharp.watson.ibm.com (AIX 3.2/UCB 5.64/930311) --* id AA30310; Wed, 7 Sep 1994 14:08:12 -0400 --* Received: from watson.vnet.ibm.com by yktvmv.watson.ibm.com (IBM VM SMTP V2R3) --* with BSMTP id 3951; Wed, 07 Sep 94 14:08:16 EDT --* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0" --* id --* for asbugs@watson; Wed, 07 Sep 94 14:08:16 -0400 --* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0" --* id 4479; Wed, 7 Sep 1994 14:08:15 EDT --* Received: from spadserv.watson.ibm.com by yktvmv.watson.ibm.com --* (IBM VM SMTP V2R3) with TCP; Wed, 07 Sep 94 14:08:14 EDT --* Received: by spadserv.watson.ibm.com (AIX 3.2/UCB 5.64/900524) --* id AA30281; Wed, 7 Sep 1994 14:08:45 -0400 --* Date: Wed, 7 Sep 1994 14:08:45 -0400 --* From: teresa@spadserv.watson.ibm.com --* X-External-Networks: yes --* Message-Id: <9409071808.AA30281@spadserv.watson.ibm.com> --* To: asbugs@watson.ibm.com --* Subject: [3] Macro expander goes segfault --@ Fixed by: SSD Mon Sep 19 11:32:11 EDT 1994 --@ Tested by: none --@ Summary: Macro expander creating then freeing shared abstract syntax structure. #if BugHeaders LastSeenBy: PAB LastUpdate: 7/Sep/94 BugKeywords: macex, possibly abnorm Priority: Comments:declaration next() List ?? == screws up Comments: macroexpander SeenBy: pab Updates: #endif #assert modified #if modified -- Command line: asharp cclo.as -- Version: 0.36.0 -- Original bug file name: cclo.as -- Dynamic constructible closure categories +++ DynamicConstructibleClosedFieldCategory +++ DynamicConstructibleClosureCategory(K0:FIELD) -- Internal dynamic constructible closure domain +++ InternalDynamicConstructibleClosure(K0:FIELD) -- Dynamic constructible closure and control +++ DynamicConstructibleClosure(K0:FIELD) +++ ConstructibleClause (K0:FIELD, D:KOERCE OUTFORM) +++ ConstructibleControlPackage (K0:FIELD, D:KOERCE OUTFORM) #include "aslib" #pile #library listolib "listo.aso" #library dynlib "dyn.aso" #library dpolib "dpol.aso" #library dgpolib "dgpol.aso" #library clawlib "claw.aso" #library cdenlib "cden.aso" #library cfralib "cfra.aso" import from listolib import from dynlib import from dpolib import from dgpolib import from clawlib import from cdenlib import from cfralib +++ Comments. DynamicConstructibleClosedFieldCategory: Category == DynamicFieldCategory with Poly ==> DynamicUnivariatePolynomial(%) -- operations -- no splitting newElement: String -> % ++ newElement(sy) -- splitting areEqual: (%,%) -> Boolean ++ areEqual(x,y) areDifferent: (%,%) -> Boolean ++ areDifferent(x,y) -- later -- isTranscendent: % -> Boolean -- isAlgebraic: (%,Poly) -> Boolean +++ Comments. DynamicConstructibleClosureCategory(K:Field): Category == DynamicConstructibleClosedFieldCategory with SI ==> SingleInteger -- operations -- no reduction, no splitting ctbleKernel: SI -> % ++ ctbleKernel(i) returns the constructible kernel of level i in % level: % -> SI ++ level(x) returns the level of x +++ Comments. InternalDynamicConstructibleClosure(K): Exports == Implementation where K: DynamicFieldCategory Law ==> ConstructibleLaw(%) Cas ==> Tower(Law) SI ==> SingleInteger Poly ==> DynamicUnivariatePolynomial(%) Gpol ==> DynamicConstructibleGeneralizedPolynomial(%,Poly) Deno ==> ConstructibleDenominator(%) Frac ==> DynamicConstructibleFraction(%) CK ==> Record(lev:SI,frac:Frac) Uef ==> Union(element:%,failed:Enumeration(failed)) Exports ==> Join(DynamicConstructibleClosureCategory(K), InternalDynamicSetCategory(Cas)) with -- reduction, no splitting refineAndReduceLaws: (SI,Law) -> () ++ refineAndReduceLaws(ns,la) refines law of level ns to la ++ and reduces every law from level ns+1 to level(current) Implementation ==> add -- representation Rep == Union(rat:K,ctble:CK) import from Rep -- about reduction -- x:% is reduced if: -- * either x has level 0 ("x case rat") and is reduced in K -- * or x has level > 0 ("x case ctble") and its representing -- fraction is reduced in Frac -- mutable variables mutcas: Cas := basic -- the value of mutcas is the current case -- its laws are reduced up to level(mutcas) mutnext: List Cas := [] -- the value of mutnext is the list of the next cases to -- be considered by the control package -- the towers in mutnext have level 0, and their laws -- are generally not reduced -- declarations default tow: Cas default ltow: List Cas default ns: SI default la: Law -- operations dealing with mutable variables basic():Cas == empty()$Cas current():Cas == mutcas --- THIS ONE!!!! ARRGGHHH, etc next()List Cas == mutnext setCurrent(tow):() == free mutcas mutcas:= tow setNext(ltow):() == free mutnext mutnext:= ltow refreshCurrent():() == free mutcas mutcas:= basic refreshNext():() == free mutnext mutnext:= [] refresh():() == free mutcas free mutnext mutcas:= basic mutnext:= [] addNext(tow):() == free mutnext mutnext:= concat(refreshLevel(tow),mutnext) refineAndReduceLaws(ns,la):() == free mutcas mutcas:= refineLaw(mutcas,ns,la)$Cas for i in (ns+1)..level(mutcas)$Cas repeat tow:= reduceLaw(mutcas,i pretend SI)$Cas mutcas:= tow -- local operations -- no reduction, no splitting makeConstructible: K -> % ++ *** product: (K,%) -> % ++ *** -- declarations default x,x1,x2: % default xr,xr1,xr2: Rep default r: K default p: Poly default gpol: Gpol default lpol: List Poly default fr: Frac default sym: String default uef: Uef -- define -- no reduction, no splitting makeConstructible(r):% == per [r] product(r,x):% == xr:= rep x xr case rat => per [r *$K xr.rat] per [[xr.ctble.lev, r::% *$Frac (xr.ctble.frac)]::CK] power(x,ns):% == -- to improve when K has FiniteFieldCategory ? ns < 0 => error "negative argument in power from cclo" ns = 0 => 1 ns = 1 => x xr:= rep x xr case rat => [(xr.rat) ^$K ns] per [[xr.ctble.lev, xr.ctble.frac ^$Frac ns]::CK] roughZero?(x):Boolean == xr:= rep x xr case rat => roughZero?(xr.rat)$K roughZero?(xr.ctble.frac)$Frac level(x):SI == xr:= rep x xr case rat => 0 xr.ctble.lev ctbleKernel(ns):% == ns < 0 => error "negative argument in power from cclo" per [[ns, (monomial(1@%,1@SI)$Poly)::Frac]::CK] roughExquo(x1,x2):% == roughZero? x1 => 0 xr1:= rep x1 xr2:= rep x2 xr1 case rat => xr2 case rat => per [roughExquo(xr1.rat,xr2.rat)$K] error "ERROR IN roughExquo$DCCL (x1 case rat, x2 case ctble)" (xr2 case rat) or (xr1.ctble.lev > xr2.ctble.lev) => fr:= roughExquo(xr1.ctble.frac,xr2)$Frac per [[xr1.ctble.lev, fr]::CK] xr1.ctble.lev < xr2.ctble.lev => error "ERROR IN roughExquo$DCCL (level(x1) pri <<$K xr.rat la:= law(mutcas,xr.ctble.lev)$Cas <<(pri,xr.ctble.frac,la)$Frac 0 :% == per [0@K] 1 :% == per [1@K] x1 + x2 :% == xr1:= rep x1 xr2:= rep x2 if xr1 case rat then if xr2 case rat then return per [xr1.rat +$K xr2.rat] else la:= law(mutcas,xr2.ctble.lev)$Cas return per [[xr2.ctble.lev, addition(xr1::Frac,xr2.ctble.frac,la)]::CK] if xr2 case rat then la:= law(mutcas,xr1.ctble.lev)$Cas return per [[xr1.ctble.lev, addition(xr1.ctble.frac,xr2::Frac,la)]::CK] if xr1.ctble.lev < xr2.ctble.lev then la:= law(mutcas,xr2.ctble.lev)$Cas return per [[xr2.ctble.lev, addition(xr1::Frac,xr2.ctble.frac,la)]::CK] if xr2.ctble.lev < xr1.ctble.lev then la:= law(mutcas,xr1.ctble.lev)$Cas return per [[xr1.ctble.lev, addition(xr1.ctble.frac,xr2::Frac,la)]::CK] la:= law(mutcas,xr1.ctble.lev)$Cas per [[xr1.ctble.lev, addition(xr1.ctble.frac,xr2.ctble.frac,la)]::CK] - x :% == xr:= rep x xr case rat => per [-$K (xr.rat)] per [[xr.ctble.lev, -$Frac xr.ctble.frac]::CK] ns * x :% == xr:= rep x xr case rat => [ns *$K (xr.rat)] per [[xr.ctble.lev, ns *$Frac xr.ctble.frac]::CK] (n:Integer) * x :% == xr:= rep x xr case rat => [n *$K (xr.rat)] per [[xr.ctble.lev, n *$Frac xr.ctble.frac]::CK] r * x :% == product(r::K,x) x1 * x2 :% == xr1:= rep x1 xr2:= rep x2 xr1 case rat => if xr2 case rat then per [(xr1.rat) *$K (xr2.rat)] else product(xr1.rat,x2) xr2 case rat => product(xr2.rat,x1) (xr1.ctble.lev < xr2.ctble.lev) => per [[xr2.ctble.lev, xr1 *$Frac xr2.ctble.frac]::CK] (xr2.ctble.lev < xr1.ctble.lev) => per [[xr1.ctble.lev, xr2 *$Frac xr1.ctble.frac]::CK] per [[xr1.ctble.lev, xr1.ctble.frac *$Frac xr2.ctble.frac]::CK] -- no reduction, no splitting newElement(sym):% == if maxLevel?(mutcas)$Cas then la:= build(any,sym,[])$Law tow:= addLaw(current()$%,la)$Cas le:SI:= level(tow)$% else tow:= addLevel(current()$%)$Cas le:SI:= level(tow)$% tow:= reduceLaw(tow,le)$Cas setCurrent(tow)$% ctbleKernel(le)$% -- reduction, no splitting reduce(x):% == xr:= rep x xr case rat => makeConstructible(reduce(xr.rat)$K) fr:= xr.ctble.frac ns:= xr.ctble.lev la:= law(mutcas,ns)$Cas fr:= reduce(fr,la)$Frac (denominator(fr) = 1) and (roughDegree(numerator fr) = 0) => roughLeadingCoefficient(numerator fr) per [[ns,fr]::CK] -- splitting x ^ (n:Integer) :% == n >= 0 => reduce(power(x,n)) reduce(power(inv(x),-n)) recip(x):Uef == xr:= rep x xr case rat => if (r0:= recip(xr.rat)$K) case failed then [failed] else [per [r0.element]] x =$% 0 => [failed] x1:= reduce x xr:= rep x1 xr case rat => if (r0:= recip(xr.rat)$K) case failed then [failed] else [per [r0.element]] la:= law(mutcas,xr.ctble.lev)$Cas uff:Union(element:Frac,failed:Enumeration(failed)):= recip(xr.ctble.frac,la)$Frac uff case failed => [failed] [per [[xr.ctble.lev, uff.element]::CK]] inv(x):% == (ix:= recip(x)) case failed => error "DIVISION BY 0 IN inv$DCCL" ix.element x1 / x2 :% == reduce(x1 *$% inv(x2)) zero? x :Boolean == x1:= reduce(x) xr:= rep x1 xr case rat => (xr.rat =$K 0) ns:= xr.ctble.lev fr:= xr.ctble.frac p:= numerator(fr)$Frac roughDegree(p)$Poly = 0 => (roughLeadingCoefficient(p)$Poly = 0) la:= law(mutcas,ns)$Cas rbdp:Record(bol:Boolean,den:Deno,pol:Poly):= makeDenominator(p,la)$Deno rbdp.bol => false rgl:Record(gpo:Gpol,lpo:List Poly):= arrange(rbdp.pol)$Gpol la:= law(mutcas,ns)$Cas sp:Record(notEq:Law,Eq:Law):= split(la,rgl.gpo) failed?(sp.notEq)$Law => if not(la = sp.Eq) then refineAndReduceLaws(ns,sp.Eq) true lane:Law:= sp.notEq failed?(sp.Eq)$Law => if not(la = lane) then if not empty? rgl.lpo then lane:= refineLaw(lane,rgl.lpo)$Law refineAndReduceLaws(ns,lane) false tow:= refineLaw(current(),ns,sp.Eq) addNext(tow) if not empty? rgl.lpo then lane:= refineLaw(lane,rgl.lpo)$Law refineAndReduceLaws(ns,lane) false areEqual(x1,x2) == x:= reduce(x1-x2) xr:= rep x xr case rat => (xr.rat =$K 0) ns:= xr.ctble.lev fr:= xr.ctble.frac p:= numerator(fr)$Frac roughDegree(p)$Poly = 0 => areEqual(roughLeadingCoefficient(p)$Poly,0) la:= law(mutcas,ns)$Cas rbdp:Record(bol:Boolean,den:Deno,pol:Poly):= makeDenominator(p,la)$Deno rbdp.bol => false rgl:Record(gpo:Gpol,lpo:List Poly):= arrange(rbdp.pol) la:= law(mutcas,ns)$Cas sp:Record(notEq:Law,Eq:Law):= split(la,rgl.gpo) failed?(sp.Eq)$Law => false failed?(sp.notEq)$Law => if not(la = sp.Eq) then refineAndReduceLaws(ns,sp.Eq) true refineAndReduceLaws(ns,sp.Eq) true areDifferent(x1,x2) == x:= reduce(x1-x2) xr:= rep x xr case rat => not(xr.rat =$K 0) ns:= xr.ctble.lev fr:= xr.ctble.frac p:= numerator(fr)$Frac roughDegree(p)$Poly = 0 => areDifferent(roughLeadingCoefficient(p)$Poly,0) la:= law(mutcas,ns)$Cas rbdp:Record(bol:Boolean,den:Deno,pol:Poly):= makeDenominator(p,la)$Deno rbdp.bol => true rgl:Record(gpo:Gpol,lpo:List Poly):= arrange(rbdp.pol) la:= law(mutcas,ns)$Cas sp:Record(notEq:Law,Eq:Law):= split(la,rgl.gpo) failed?(sp.notEq)$Law => false lane:Law:= sp.notEq failed?(sp.Eq)$Law => if not(la = lane) then if not empty? rgl.lpo then lane:= refineLaw(lane,rgl.lpo)$Law refineAndReduceLaws(ns,lane) true if not empty? rgl.lpo then lane:= refineLaw(lane,rgl.lpo)$Law refineAndReduceLaws(ns,lane) true +++ EXTERNAL dynamic set DynamicConstructibleClosure(K:Field): Exports == Implementation where DK ==> DynamicBuildField(K) ICK ==> InternalDynamicConstructibleClosure(DK) Law ==> ConstructibleLaw(ICK) Cas ==> Tower(Law) Exports ==> Join(DynamicConstructibleClosureCategory(K),_ InternalDynamicSetCategory(Cas)) Implementation ==> ICK add -- representation Rep == ICK import from Rep -- declarations x,x1,x2: % r: K ns: SingleInteger n: Integer -- define -- internal reduction, no splitting x1 + x2 :% == per reduce(rep(x1) +$Rep rep(x2)) - x :% == per reduce(-$Rep rep(x)) ns * x :% == per reduce(ns *$Rep rep(x)) n * x :% == per reduce(n *$Rep rep(x)) r * x :% == per reduce(r::DK *$Rep rep(x)) x1 * x2 :% == per reduce(rep(x1) *$Rep rep(x2)) (pri:TextWriter) << x :TextWriter == pri <<$Rep reduce(rep(x)) +++ Comments. ConstructibleClause(K:Field,D:BasicType): Exports == Implementation where DK ==> DynamicBuildField(K) ICK ==> InternalDynamicConstructibleClosure(DK) Law ==> ConstructibleLaw(ICK) Cas ==> Tower(Law) Exports ==> with -- operations valueIs: % -> D inCase: % -> Cas build: (D,Cas) -> % coerce: InternalClause(Cas,ICK,D) -> % Implementation ==> InternalClause(Cas,ICK,D) add Rep == InternalClause(Cas,ICK,D) import from Rep coerce(cl0:InternalClause(Cas,ICK,D)):% == per cl0 +++ Comments. ConstructibleControlPackage (K:Field,D:BasicType): with DK ==> DynamicBuildField(K) ICK ==> InternalDynamicConstructibleClosure(DK) Law ==> ConstructibleLaw(ICK) Cas ==> Tower(Law) CCl ==> ConstructibleClause(K,D) -- operation allCases: (()->D) -> List CCl ++ allCases(f) returns the value of f() in every case ++ together with a description of the corresponding case == add import from InternalControlPackage(Cas,ICK,D) allCases(f:()->D):List CCl == all0:= allCases(f)$InternalControlPackage(Cas,ICK,D) [oneca0::CCl for oneca0 in all0] #else -- original begin -- Command line: asharp cclo.as -- Version: 0.36.0 -- Original bug file name: cclo.as -- Dynamic constructible closure categories +++ DynamicConstructibleClosedFieldCategory +++ DynamicConstructibleClosureCategory(K0:FIELD) -- Internal dynamic constructible closure domain +++ InternalDynamicConstructibleClosure(K0:FIELD) -- Dynamic constructible closure and control +++ DynamicConstructibleClosure(K0:FIELD) +++ ConstructibleClause (K0:FIELD, D:KOERCE OUTFORM) +++ ConstructibleControlPackage (K0:FIELD, D:KOERCE OUTFORM) #include "aslib" #pile #library listolib "listo.aso" #library dynlib "dyn.aso" #library dpolib "dpol.aso" #library dgpolib "dgpol.aso" #library clawlib "claw.aso" #library cdenlib "cden.aso" #library cfralib "cfra.aso" import from listolib import from dynlib import from dpolib import from dgpolib import from clawlib import from cdenlib import from cfralib +++ Comments. DynamicConstructibleClosedFieldCategory: Category == DynamicFieldCategory with Poly ==> DynamicUnivariatePolynomial(%) -- operations -- no splitting newElement: String -> % ++ newElement(sy) -- splitting areEqual: (%,%) -> Boolean ++ areEqual(x,y) areDifferent: (%,%) -> Boolean ++ areDifferent(x,y) -- later -- isTranscendent: % -> Boolean -- isAlgebraic: (%,Poly) -> Boolean +++ Comments. DynamicConstructibleClosureCategory(K:Field): Category == DynamicConstructibleClosedFieldCategory with SI ==> SingleInteger -- operations -- no reduction, no splitting ctbleKernel: SI -> % ++ ctbleKernel(i) returns the constructible kernel of level i in % level: % -> SI ++ level(x) returns the level of x +++ Comments. InternalDynamicConstructibleClosure(K): Exports == Implementation where K: DynamicFieldCategory Law ==> ConstructibleLaw(%) Cas ==> Tower(Law) SI ==> SingleInteger Poly ==> DynamicUnivariatePolynomial(%) Gpol ==> DynamicConstructibleGeneralizedPolynomial(%,Poly) Deno ==> ConstructibleDenominator(%) Frac ==> DynamicConstructibleFraction(%) CK ==> Record(lev:SI,frac:Frac) Uef ==> Union(element:%,failed:Enumeration(failed)) Exports ==> Join(DynamicConstructibleClosureCategory(K), InternalDynamicSetCategory(Cas)) with -- reduction, no splitting refineAndReduceLaws: (SI,Law) -> () ++ refineAndReduceLaws(ns,la) refines law of level ns to la ++ and reduces every law from level ns+1 to level(current) Implementation ==> add -- representation Rep == Union(rat:K,ctble:CK) import from Rep -- about reduction -- x:% is reduced if: -- * either x has level 0 ("x case rat") and is reduced in K -- * or x has level > 0 ("x case ctble") and its representing -- fraction is reduced in Frac -- mutable variables mutcas: Cas := basic -- the value of mutcas is the current case -- its laws are reduced up to level(mutcas) mutnext: List Cas := [] -- the value of mutnext is the list of the next cases to -- be considered by the control package -- the towers in mutnext have level 0, and their laws -- are generally not reduced -- declarations default tow: Cas default ltow: List Cas default ns: SI default la: Law -- operations dealing with mutable variables basic():Cas == empty()$Cas current():Cas == mutcas next()List Cas == mutnext setCurrent(tow):() == free mutcas mutcas:= tow setNext(ltow):() == free mutnext mutnext:= ltow refreshCurrent():() == free mutcas mutcas:= basic refreshNext():() == free mutnext mutnext:= [] refresh():() == free mutcas free mutnext mutcas:= basic mutnext:= [] addNext(tow):() == free mutnext mutnext:= concat(refreshLevel(tow),mutnext) refineAndReduceLaws(ns,la):() == free mutcas mutcas:= refineLaw(mutcas,ns,la)$Cas for i in (ns+1)..level(mutcas)$Cas repeat tow:= reduceLaw(mutcas,i pretend SI)$Cas mutcas:= tow -- local operations -- no reduction, no splitting makeConstructible: K -> % ++ *** product: (K,%) -> % ++ *** -- declarations default x,x1,x2: % default xr,xr1,xr2: Rep default r: K default p: Poly default gpol: Gpol default lpol: List Poly default fr: Frac default sym: String default uef: Uef -- define -- no reduction, no splitting makeConstructible(r):% == per [r] product(r,x):% == xr:= rep x xr case rat => per [r *$K xr.rat] per [[xr.ctble.lev, r::% *$Frac (xr.ctble.frac)]::CK] power(x,ns):% == -- to improve when K has FiniteFieldCategory ? ns < 0 => error "negative argument in power from cclo" ns = 0 => 1 ns = 1 => x xr:= rep x xr case rat => [(xr.rat) ^$K ns] per [[xr.ctble.lev, xr.ctble.frac ^$Frac ns]::CK] roughZero?(x):Boolean == xr:= rep x xr case rat => roughZero?(xr.rat)$K roughZero?(xr.ctble.frac)$Frac level(x):SI == xr:= rep x xr case rat => 0 xr.ctble.lev ctbleKernel(ns):% == ns < 0 => error "negative argument in power from cclo" per [[ns, (monomial(1@%,1@SI)$Poly)::Frac]::CK] roughExquo(x1,x2):% == roughZero? x1 => 0 xr1:= rep x1 xr2:= rep x2 xr1 case rat => xr2 case rat => per [roughExquo(xr1.rat,xr2.rat)$K] error "ERROR IN roughExquo$DCCL (x1 case rat, x2 case ctble)" (xr2 case rat) or (xr1.ctble.lev > xr2.ctble.lev) => fr:= roughExquo(xr1.ctble.frac,xr2)$Frac per [[xr1.ctble.lev, fr]::CK] xr1.ctble.lev < xr2.ctble.lev => error "ERROR IN roughExquo$DCCL (level(x1) pri <<$K xr.rat la:= law(mutcas,xr.ctble.lev)$Cas <<(pri,xr.ctble.frac,la)$Frac 0 :% == per [0@K] 1 :% == per [1@K] x1 + x2 :% == xr1:= rep x1 xr2:= rep x2 if xr1 case rat then if xr2 case rat then return per [xr1.rat +$K xr2.rat] else la:= law(mutcas,xr2.ctble.lev)$Cas return per [[xr2.ctble.lev, addition(xr1::Frac,xr2.ctble.frac,la)]::CK] if xr2 case rat then la:= law(mutcas,xr1.ctble.lev)$Cas return per [[xr1.ctble.lev, addition(xr1.ctble.frac,xr2::Frac,la)]::CK] if xr1.ctble.lev < xr2.ctble.lev then la:= law(mutcas,xr2.ctble.lev)$Cas return per [[xr2.ctble.lev, addition(xr1::Frac,xr2.ctble.frac,la)]::CK] if xr2.ctble.lev < xr1.ctble.lev then la:= law(mutcas,xr1.ctble.lev)$Cas return per [[xr1.ctble.lev, addition(xr1.ctble.frac,xr2::Frac,la)]::CK] la:= law(mutcas,xr1.ctble.lev)$Cas per [[xr1.ctble.lev, addition(xr1.ctble.frac,xr2.ctble.frac,la)]::CK] - x :% == xr:= rep x xr case rat => per [-$K (xr.rat)] per [[xr.ctble.lev, -$Frac xr.ctble.frac]::CK] ns * x :% == xr:= rep x xr case rat => [ns *$K (xr.rat)] per [[xr.ctble.lev, ns *$Frac xr.ctble.frac]::CK] (n:Integer) * x :% == xr:= rep x xr case rat => [n *$K (xr.rat)] per [[xr.ctble.lev, n *$Frac xr.ctble.frac]::CK] r * x :% == product(r::K,x) x1 * x2 :% == xr1:= rep x1 xr2:= rep x2 xr1 case rat => if xr2 case rat then per [(xr1.rat) *$K (xr2.rat)] else product(xr1.rat,x2) xr2 case rat => product(xr2.rat,x1) (xr1.ctble.lev < xr2.ctble.lev) => per [[xr2.ctble.lev, xr1 *$Frac xr2.ctble.frac]::CK] (xr2.ctble.lev < xr1.ctble.lev) => per [[xr1.ctble.lev, xr2 *$Frac xr1.ctble.frac]::CK] per [[xr1.ctble.lev, xr1.ctble.frac *$Frac xr2.ctble.frac]::CK] -- no reduction, no splitting newElement(sym):% == if maxLevel?(mutcas)$Cas then la:= build(any,sym,[])$Law tow:= addLaw(current()$%,la)$Cas le:SI:= level(tow)$% else tow:= addLevel(current()$%)$Cas le:SI:= level(tow)$% tow:= reduceLaw(tow,le)$Cas setCurrent(tow)$% ctbleKernel(le)$% -- reduction, no splitting reduce(x):% == xr:= rep x xr case rat => makeConstructible(reduce(xr.rat)$K) fr:= xr.ctble.frac ns:= xr.ctble.lev la:= law(mutcas,ns)$Cas fr:= reduce(fr,la)$Frac (denominator(fr) = 1) and (roughDegree(numerator fr) = 0) => roughLeadingCoefficient(numerator fr) per [[ns,fr]::CK] -- splitting x ^ (n:Integer) :% == n >= 0 => reduce(power(x,n)) reduce(power(inv(x),-n)) recip(x):Uef == xr:= rep x xr case rat => if (r0:= recip(xr.rat)$K) case failed then [failed] else [per [r0.element]] x =$% 0 => [failed] x1:= reduce x xr:= rep x1 xr case rat => if (r0:= recip(xr.rat)$K) case failed then [failed] else [per [r0.element]] la:= law(mutcas,xr.ctble.lev)$Cas uff:Union(element:Frac,failed:Enumeration(failed)):= recip(xr.ctble.frac,la)$Frac uff case failed => [failed] [per [[xr.ctble.lev, uff.element]::CK]] inv(x):% == (ix:= recip(x)) case failed => error "DIVISION BY 0 IN inv$DCCL" ix.element x1 / x2 :% == reduce(x1 *$% inv(x2)) zero? x :Boolean == x1:= reduce(x) xr:= rep x1 xr case rat => (xr.rat =$K 0) ns:= xr.ctble.lev fr:= xr.ctble.frac p:= numerator(fr)$Frac roughDegree(p)$Poly = 0 => (roughLeadingCoefficient(p)$Poly = 0) la:= law(mutcas,ns)$Cas rbdp:Record(bol:Boolean,den:Deno,pol:Poly):= makeDenominator(p,la)$Deno rbdp.bol => false rgl:Record(gpo:Gpol,lpo:List Poly):= arrange(rbdp.pol)$Gpol la:= law(mutcas,ns)$Cas sp:Record(notEq:Law,Eq:Law):= split(la,rgl.gpo) failed?(sp.notEq)$Law => if not(la = sp.Eq) then refineAndReduceLaws(ns,sp.Eq) true lane:Law:= sp.notEq failed?(sp.Eq)$Law => if not(la = lane) then if not empty? rgl.lpo then lane:= refineLaw(lane,rgl.lpo)$Law refineAndReduceLaws(ns,lane) false tow:= refineLaw(current(),ns,sp.Eq) addNext(tow) if not empty? rgl.lpo then lane:= refineLaw(lane,rgl.lpo)$Law refineAndReduceLaws(ns,lane) false areEqual(x1,x2) == x:= reduce(x1-x2) xr:= rep x xr case rat => (xr.rat =$K 0) ns:= xr.ctble.lev fr:= xr.ctble.frac p:= numerator(fr)$Frac roughDegree(p)$Poly = 0 => areEqual(roughLeadingCoefficient(p)$Poly,0) la:= law(mutcas,ns)$Cas rbdp:Record(bol:Boolean,den:Deno,pol:Poly):= makeDenominator(p,la)$Deno rbdp.bol => false rgl:Record(gpo:Gpol,lpo:List Poly):= arrange(rbdp.pol) la:= law(mutcas,ns)$Cas sp:Record(notEq:Law,Eq:Law):= split(la,rgl.gpo) failed?(sp.Eq)$Law => false failed?(sp.notEq)$Law => if not(la = sp.Eq) then refineAndReduceLaws(ns,sp.Eq) true refineAndReduceLaws(ns,sp.Eq) true areDifferent(x1,x2) == x:= reduce(x1-x2) xr:= rep x xr case rat => not(xr.rat =$K 0) ns:= xr.ctble.lev fr:= xr.ctble.frac p:= numerator(fr)$Frac roughDegree(p)$Poly = 0 => areDifferent(roughLeadingCoefficient(p)$Poly,0) la:= law(mutcas,ns)$Cas rbdp:Record(bol:Boolean,den:Deno,pol:Poly):= makeDenominator(p,la)$Deno rbdp.bol => true rgl:Record(gpo:Gpol,lpo:List Poly):= arrange(rbdp.pol) la:= law(mutcas,ns)$Cas sp:Record(notEq:Law,Eq:Law):= split(la,rgl.gpo) failed?(sp.notEq)$Law => false lane:Law:= sp.notEq failed?(sp.Eq)$Law => if not(la = lane) then if not empty? rgl.lpo then lane:= refineLaw(lane,rgl.lpo)$Law refineAndReduceLaws(ns,lane) true if not empty? rgl.lpo then lane:= refineLaw(lane,rgl.lpo)$Law refineAndReduceLaws(ns,lane) true +++ EXTERNAL dynamic set DynamicConstructibleClosure(K:Field): Exports == Implementation where DK ==> DynamicBuildField(K) ICK ==> InternalDynamicConstructibleClosure(DK) Law ==> ConstructibleLaw(ICK) Cas ==> Tower(Law) Exports ==> Join(DynamicConstructibleClosureCategory(K),_ InternalDynamicSetCategory(Cas)) Implementation ==> ICK add -- representation Rep == ICK import from Rep -- declarations x,x1,x2: % r: K ns: SingleInteger n: Integer -- define -- internal reduction, no splitting x1 + x2 :% == per reduce(rep(x1) +$Rep rep(x2)) - x :% == per reduce(-$Rep rep(x)) ns * x :% == per reduce(ns *$Rep rep(x)) n * x :% == per reduce(n *$Rep rep(x)) r * x :% == per reduce(r::DK *$Rep rep(x)) x1 * x2 :% == per reduce(rep(x1) *$Rep rep(x2)) (pri:TextWriter) << x :TextWriter == pri <<$Rep reduce(rep(x)) +++ Comments. ConstructibleClause(K:Field,D:BasicType): Exports == Implementation where DK ==> DynamicBuildField(K) ICK ==> InternalDynamicConstructibleClosure(DK) Law ==> ConstructibleLaw(ICK) Cas ==> Tower(Law) Exports ==> with -- operations valueIs: % -> D inCase: % -> Cas build: (D,Cas) -> % coerce: InternalClause(Cas,ICK,D) -> % Implementation ==> InternalClause(Cas,ICK,D) add Rep == InternalClause(Cas,ICK,D) import from Rep coerce(cl0:InternalClause(Cas,ICK,D)):% == per cl0 +++ Comments. ConstructibleControlPackage (K:Field,D:BasicType): with DK ==> DynamicBuildField(K) ICK ==> InternalDynamicConstructibleClosure(DK) Law ==> ConstructibleLaw(ICK) Cas ==> Tower(Law) CCl ==> ConstructibleClause(K,D) -- operation allCases: (()->D) -> List CCl ++ allCases(f) returns the value of f() in every case ++ together with a description of the corresponding case == add import from InternalControlPackage(Cas,ICK,D) allCases(f:()->D):List CCl == all0:= allCases(f)$InternalControlPackage(Cas,ICK,D) [oneca0::CCl for oneca0 in all0] #endif -- original end