aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog5
-rw-r--r--src/interp/c-util.boot4
-rw-r--r--src/interp/compiler.boot4
-rw-r--r--src/interp/info.boot17
4 files changed, 18 insertions, 12 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index d0969f3e..8eaaee6c 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,10 @@
2008-05-23 Gabriel Dos Reis <gdr@cs.tamu.edu>
+ * interp/c-util.boot (stackAndThrow): Take an optional parameter.
+ * interp/compiler.boot (compReturn): Robustify.
+ (unknownTypeError): Likewise.
+ * interp/info.boot (knownInfo): Likewise.
+
* algebra/modgcd.spad.pamphlet: Fix sectioning thinko.
2008-05-23 Gabriel Dos Reis <gdr@cs.tamu.edu>
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 65636852..05dd92c4 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -527,7 +527,9 @@ stackMessageIfNone msg ==
[msg,:$compErrorMessageStack]
nil
-stackAndThrow msg ==
+stackAndThrow(msg, args == nil) ==
+ if args ^= nil then
+ msg := buildMessage(msg,args)
$compErrorMessageStack:= [msg,:$compErrorMessageStack]
THROW("compOrCroak",nil)
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 0f42b428..3fc3b462 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -920,7 +920,7 @@ compLeave(["leave",level,x],m,e) ==
compReturn: (%Form,%Mode,%Env) -> %Maybe %Triple
compReturn(["return",level,x],m,e) ==
null $exitModeStack =>
- stackSemanticError(["the return before","%b",x,"%d","is unneccessary"],nil)
+ stackAndThrow('"the return before %1b is unneccessary",[x])
nil
level^=1 => userError '"multi-level returns not supported"
index:= MAX(0,#$exitModeStack-1)
@@ -1206,7 +1206,7 @@ unknownTypeError name ==
name:=
name is [op,:.] => op
name
- stackSemanticError(["%b",name,"%d","is not a known type"],nil)
+ stackAndThrow('"%1b is not a known type",[name])
compPretend: (%Form,%Mode,%Env) -> %Maybe %Triple
compPretend(["pretend",x,t],m,e) ==
diff --git a/src/interp/info.boot b/src/interp/info.boot
index 21bc44ba..68bf58e3 100644
--- a/src/interp/info.boot
+++ b/src/interp/info.boot
@@ -164,10 +164,10 @@ knownInfo pred ==
pred is ["or",:l] => or/[knownInfo u for u in l]
pred is ["and",:l] => and/[knownInfo u for u in l]
pred is ["ATTRIBUTE",name,attr] =>
- v:= compForMode(name,$EmptyMode,$e)
- null v => stackSemanticError(["can't find category of ",name],nil)
- [vv,.,.]:= compMakeCategoryObject(CADR v,$e)
- null vv => stackSemanticError(["can't make category of ",name],nil)
+ v:= compForMode(name,$EmptyMode,$e) or return
+ stackAndThrow('"can't find category of %1pb",[name])
+ [vv,.,.]:= compMakeCategoryObject(CADR v,$e) or return
+ stackAndThrow('"can't make category of %1pb",[name])
member(attr,vv.2) => true
x:= assoc(attr,vv.2) => knownInfo CADR x
--format is a list of two elements: information, predicate
@@ -176,15 +176,14 @@ knownInfo pred ==
cat is ["ATTRIBUTE",:a] => knownInfo ["ATTRIBUTE",name,:a]
cat is ["SIGNATURE",:a] => knownInfo ["SIGNATURE",name,:a]
name is ['Union,:.] => false
- v:= compForMode(name,$EmptyMode,$e)
- null v => stackSemanticError(["can't find category of ",name],nil)
+ v:= compForMode(name,$EmptyMode,$e) or return
+ stackAndThrow('"can't find category of %1pb",[name])
vmode := CADR v
cat = vmode => true
vmode is ["Join",:l] and member(cat,l) => true
- [vv,.,.]:= compMakeCategoryObject(vmode,$e)
+ [vv,.,.]:= compMakeCategoryObject(vmode,$e) or return
+ stackAndThrow('"cannot find category %1pb",[vmode])
catlist := vv.4
- --catlist := SUBST(name,'$,vv.4)
- null vv => stackSemanticError(["can't make category of ",name],nil)
member(cat,first catlist) => true --checks princ. ancestors
(u:=assoc(cat,CADR catlist)) and knownInfo(CADR u) => true
-- previous line checks fundamental anscestors, we should check their