diff options
| -rw-r--r-- | src/ChangeLog | 14 | ||||
| -rw-r--r-- | src/algebra/float.spad.pamphlet | 5 | ||||
| -rw-r--r-- | src/algebra/fraction.spad.pamphlet | 2 | ||||
| -rw-r--r-- | src/algebra/polycat.spad.pamphlet | 8 | ||||
| -rw-r--r-- | src/interp/compiler.boot | 58 | ||||
| -rw-r--r-- | src/interp/format.boot | 1 | ||||
| -rw-r--r-- | src/interp/sys-globals.boot | 3 |
7 files changed, 70 insertions, 21 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 10413a15..8cc632b0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,19 @@ 2011-10-23 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/compiler.boot (compOrCroak1): Drop last argument. Tidy. + (mostSpecificTriple): New. + (compAtomWithModemap): Use it to resolve ambiguous constants. + (formatConstantCandidates): New. + (compForm1): Do try to compile constants 0 and 1 with compToApply. + * algebra/polycat.spad.pamphlet (FiniteAbelianMonoidRing) + [binomThmExpt]: Tidy. + (UnivariatePolynomialCategory) [pseudoDivide]: Likewise. + * algebra/float.spad.pamphlet (Float) [log]: Specificy type for + local variable `l'. + * interp/format.boot (formatUnabbreviatedSig): Handle constants. + +2011-10-23 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/g-opt.boot ($VMsideEffectFreeOperators): Include %fdecode. * interp/lisp-backend.boot: Expand it. * algebra/sf.spad.pamphlet (DoubleFloat): Remove %fmanexpr import. diff --git a/src/algebra/float.spad.pamphlet b/src/algebra/float.spad.pamphlet index 26c0c253..7c5a74ae 100644 --- a/src/algebra/float.spad.pamphlet +++ b/src/algebra/float.spad.pamphlet @@ -423,7 +423,10 @@ Float(): p := bits(); inc 5 -- apply log(x) = n log 2 + log(x/2**n) so that 1/2 < x < 2 if negative?(n := order x) then n := n+1 - l := if n = 0 then 0 else (x := shift(x,-n); n * log2()) + l: % := + n = 0 => 0 + x := shift(x,-n) + n * log2() -- speed the series convergence by finding m and k such that -- | exp(m/2**k) x - 1 | < 1 / 2 ** O(sqrt p) -- write log(exp(m/2**k) x) as m/2**k + log x diff --git a/src/algebra/fraction.spad.pamphlet b/src/algebra/fraction.spad.pamphlet index 6fecb082..f7d5d6e0 100644 --- a/src/algebra/fraction.spad.pamphlet +++ b/src/algebra/fraction.spad.pamphlet @@ -543,7 +543,7 @@ Fraction(S: IntegralDomain): QuotientFieldCategory S with makeFR(map(#1::%/den1,unit(ff)),lfact) factorSquareFreePolynomial(pp) == zero? pp => 0 - degree pp = 0 => makeFR(pp,empty()) + zero? degree pp => makeFR(pp,empty()) lcpp:=leadingCoefficient pp pp:=pp/lcpp denpp:="lcm"/[denom u for u in coefficients pp] diff --git a/src/algebra/polycat.spad.pamphlet b/src/algebra/polycat.spad.pamphlet index 4347438f..b56c9a97 100644 --- a/src/algebra/polycat.spad.pamphlet +++ b/src/algebra/polycat.spad.pamphlet @@ -142,7 +142,10 @@ FiniteAbelianMonoidRing(R:Ring, E:OrderedAbelianMonoid): Category == bincoef: Integer powl: List(%):= [x] for i in 2..nn repeat powl:=[x * powl.first, :powl] - yn:=y; ans:=powl.first; i:=1; bincoef:=nn + yn := y + ans := powl.first + i: Integer := 1 + bincoef := nn for xn in powl.rest repeat ans:= bincoef * xn * yn + ans bincoef:= (nn-i) * bincoef quo (i+1); i:= i+1 @@ -918,7 +921,8 @@ UnivariatePolynomialCategory(R:Ring): Category == - pseudoRemainder(p, q)) exquo q)::% pseudoDivide(p, q) == - (n := degree(p)::Integer - degree q + 1) < 1 => [1, 0, p] + n: Integer := degree(p)::Integer - degree q + 1 + n < 1 => [1, 0, p] prem := pseudoRemainder(p, q) lc := leadingCoefficient(q)**(n::NonNegativeInteger) [lc,((lc*p - prem) exquo q)::%, prem] diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 180edf0b..c6ffa376 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -50,7 +50,7 @@ module compiler where compUniquely: (%Form,%Mode,%Env) -> %Maybe %Triple compNoStacking: (%Form,%Mode,%Env) -> %Maybe %Triple compNoStacking1: (%Form,%Mode,%Env,%List %Thing) -> %Maybe %Triple -compOrCroak1: (%Form,%Mode,%Env,%Thing) -> %Maybe %Triple +compOrCroak1: (%Form,%Mode,%Env) -> %Maybe %Triple comp2: (%Form,%Mode,%Env) -> %Maybe %Triple comp3: (%Form,%Mode,%Env) -> %Maybe %Triple compExpression: (%Form,%Mode,%Env) -> %Maybe %Triple @@ -106,17 +106,21 @@ compTopLevel(x,m,e) == --keep old environment after top level function defs compOrCroak(x,m,e) + +++ True if no ambiguity is allowed in overload resolution. +$compUniquelyIfTrue := false + compUniquely(x,m,e) == $compUniquelyIfTrue: local:= true CATCH("compUniquely",comp(x,m,e)) compOrCroak(x,m,e) == - compOrCroak1(x,m,e,'comp) + compOrCroak1(x,m,e) -compOrCroak1(x,m,e,compFn) == - fn(x,m,e,nil,nil,compFn) where - fn(x,m,e,$compStack,$compErrorMessageStack,compFn) == - T:= CATCH("compOrCroak",FUNCALL(compFn,x,m,e)) => T +compOrCroak1(x,m,e) == + fn(x,m,e,nil,nil) where + fn(x,m,e,$compStack,$compErrorMessageStack) == + T:= CATCH("compOrCroak",comp(x,m,e)) => T --stackAndThrow here and moan in UT LISP K does the appropriate THROW $compStack:= [[x,m,e,$exitModeStack],:$compStack] $s: local := @@ -359,25 +363,49 @@ compExpression(x,m,e) == FUNCALL(fn,x,m,e) compForm(x,m,e) -++ Subroutine of compAtom. +++ Subroutine of compAtomWithModemap. +++ `Ts' is list of (at least 2) triples. Return the one with most +++ specific mode. Otherwise, return nil. +mostSpecificTriple(Ts,e) == + [T,:Ts] := Ts + and/[T := lesser(T,T',e) for T' in Ts] where + lesser(t,t',e) == + isSubset(t.mode,t'.mode,e) => t + isSubset(t'.mode,t.mode,e) => t' + nil + ++ Elaborate use of an overloaded constant. compAtomWithModemap: (%Symbol,%Mode,%Env,%List %Modemap) -> %Maybe %Triple compAtomWithModemap(x,m,e,mmList) == + mmList := [mm for mm in mmList | mm.mmImplementation is ['CONST,:.]] mmList = nil => nil + name := -- constant name displayed in diagnostics. + -- FIXME: Remove when the parser is fixed. + x is 'Zero => "0" + x is 'One => "1" + x -- Try constants with exact type matches, first. Ts := [[['%call,first y],mm.mmTarget,e] for mm in mmList | - mm.mmImplementation is ['CONST,:.] and mm.mmTarget = m and (y := compViableModemap(x,nil,mm,e))] Ts is [T] => T -- Only one possibility, take it. - Ts ~= nil => nil -- Ambiguous constant. + Ts ~= nil => -- Ambiguous constant. + stackMessage('"Too many (%1b) constants named %2b with type %3pb", + [#Ts,name,m]) -- Fallback to constants that are coercible to the target. - Ts := [[['%call,first y],mm.mmTarget,e] for mm in mmList | - mm.mmImplementation is ['CONST,:.] and + Ts := [[['%call,first y],mm.mmTarget,nil] for mm in mmList | coerceable(mm.mmTarget,m,e) and (y := compViableModemap(x,nil,mm,e))] - Ts is [T] => coerce(T,m) - nil -- Couldn't make sense of it. + Ts = nil => + stackMessage('"No viable constant named %1b in %2pb context",[name,m]) + Ts is [T] or (T := mostSpecificTriple(Ts,e)) => + coerce([T.expr,T.mode,e],m) + stackMessage('"Ambiguous constant %1b in %2pb constext. Candidates are %3f", + [name,m,[function formatConstantCandidates,name,Ts]]) + +++ Format constants named `op' with mode given in the list of triples `Ts'. +formatConstantCandidates(op,Ts) == + displayAmbiguousSignatures(op,[[T.mode,'constant] for T in Ts]) compAtom(x,m,e) == x is "break" => compBreak(x,m,e) @@ -499,7 +527,9 @@ compForm1(form is [op,:argl],m,e) == (T:= comp([op',:argl],domain,e) or return nil; coerce(T,m)) nil - T:= compForm2(form,m,e,getFormModemaps(form,e)) => T + T := compForm2(form,m,e,getFormModemaps(form,e)) => T + --FIXME: remove next line when the parser is fixed. + form = $Zero or form = $One => nil compToApply(op,argl,m,e) compForm2(form is [op,:argl],m,e,modemapList) == diff --git a/src/interp/format.boot b/src/interp/format.boot index 386a85cc..5f670131 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -818,6 +818,7 @@ formatUnabbreviatedSig sig == [target,:args] := dollarPercentTran sig target := formatUnabbreviated target null args => ['"() -> ",:target] + args is ['constant] => target null rest args => [:formatUnabbreviated first args,'" -> ",:target] args := formatUnabbreviatedTuple args ['"(",:args,'") -> ",:target] diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot index c9abeef9..31d062af 100644 --- a/src/interp/sys-globals.boot +++ b/src/interp/sys-globals.boot @@ -76,9 +76,6 @@ $clamList := $compCount := 0 ++ -$compUniquelyIfTrue := false - -++ $createUpdateFiles := false ++ |