aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog14
-rw-r--r--src/algebra/float.spad.pamphlet5
-rw-r--r--src/algebra/fraction.spad.pamphlet2
-rw-r--r--src/algebra/polycat.spad.pamphlet8
-rw-r--r--src/interp/compiler.boot58
-rw-r--r--src/interp/format.boot1
-rw-r--r--src/interp/sys-globals.boot3
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
++