aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2008-10-07 20:19:37 +0000
committerdos-reis <gdr@axiomatics.org>2008-10-07 20:19:37 +0000
commitd2af373ae99abdf494780c872340086cd588b990 (patch)
tree29da74227d0bb1f8c53c90d47cc05c0453881594 /src/interp
parente7edec07aedf0c1fd83171db1235120bd0f6da4f (diff)
downloadopen-axiom-d2af373ae99abdf494780c872340086cd588b990.tar.gz
* interp/define.boot (compCategoryItem): Don't check signatures yet.
* interp/c-util.boot (isKnownCategory): New. (diagnoseUknownType): Use it. Expand. * interp/compiler.boot (compCat): Use it.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot60
-rw-r--r--src/interp/compiler.boot1
-rw-r--r--src/interp/define.boot2
3 files changed, 47 insertions, 16 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index be616cc5..27abe533 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -39,6 +39,8 @@ module c_-util where
clearReplacement: %Symbol -> %Thing
replaceSimpleFunctions: %Form -> %Form
foldExportedFunctionReferences: %List -> %List
+ diagnoseUknownType: (%Mode,%Env) -> %Form
+
--%
++ if true continue compiling after errors
@@ -386,32 +388,62 @@ TrimCF() ==
nil
--%
+
+isKnownCategory: (%Mode,%Env) -> %Boolean
+isKnownCategory(c,e) ==
+ c = $Type => true
+ c = $Category => true
+ [ctor,:args] := c
+ ctor = "Join" => true -- don't check arguments yet.
+ ctor = "SubsetCategory" => true -- ditto
+ get(ctor,"isCategory",e) => true
+ false
+
+--TRACE isKnownCategory
++ Returns non-nil if `t' is a known type in the environement `e'.
-isKnownType: (%Mode,%Env) -> %Form
-isKnownType(t,e) ==
+diagnoseUknownType(t,e) ==
atom t =>
t in '($ constant) => t
t' := assoc(t,getDomainsInScope e) => t'
- get(first getmode(t,e),"isCategory",$CategoryFrame) => t
+ (m := getmode(t,e)) and isKnownCategory(m,$CategoryFrame) => t
STRINGP t => t
- t is ["Mapping",:sig] =>
- and/[isKnownType(t',e) for t' in sig] => t
- nil
- ctor := first t
+ -- ??? We should not to check for $$ at this stage.
+ -- ??? This is a bug in the compiler that needs to be fixed.
+ t = "$$" => t
+ stackSemanticError(['"The identifier", :bright t,
+ '"is not known to name a type"],nil)
+ [ctor,:args] := t
+ ctor = "Mapping" =>
+ for t' in args repeat diagnoseUknownType(t',e)
+ t
+ ctor = "Record" =>
+ for [.,.,t'] in args repeat diagnoseUknownType(t',e)
+ t
+ ctor = "Union" =>
+ if args is [[":",:.],:.] then
+ for [.,.,t'] in args repeat diagnoseUknownType(t',e)
+ else
+ for t' in args repeat diagnoseUknownType(t',e)
+ t
+ ctor = "Enumeration" =>
+ for t' in args repeat
+ IDENTP t' => nil
+ stackSemanticError(['"Enumerators must be symbols."], nil)
+ t
+ ctor = "[||]" => t
ctor in $BuiltinConstructorNames => t -- ??? check Record and Union fields
-- ??? Ideally `e' should be a local extension of $CategoryFrame
-- ??? so that we don't have to access it here as a global state.
get(ctor,"isFunctor",$CategoryFrame)
or get(ctor,"isCategory",$CategoryFrame) => t
- nil
-
-diagnoseUknownType: (%Mode,%Env) -> %Thing
-diagnoseUknownType(t,e) ==
- if not isKnownType(t,e) then
- stackWarning('"%1pb is unknown. Try importing it.",[t])
+ -- ctor maybe a constructor, but user forgot to import. Warn.
+ getConstructorAbbreviationFromDB ctor =>
+ stackWarning('"Type %1pb is not in scope. Import it",[t])
+ t
+ stackSemanticError(['"Identifier", :bright ctor,
+ '"is not known to name a constructor"],nil)
-
--% PREDICATES
diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index cb237c12..f0d1d245 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -1813,6 +1813,7 @@ compilerDoitWithScreenedLisplib(constructor, fun) ==
compCat(form is [functorName,:argl],m,e) ==
fn:= GETL(functorName,"makeFunctionList") or return nil
+ diagnoseUknownType(form,e)
[funList,e]:= FUNCALL(fn,form,form,e)
catForm:=
["Join",'(SetCategory),["CATEGORY","domain",:
diff --git a/src/interp/define.boot b/src/interp/define.boot
index a2af1e8a..ae460b75 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1691,8 +1691,6 @@ compCategoryItem(x,predl,env) ==
nil
--4. branch on a single type or a signature %with source and target
- for t in first sig repeat
- diagnoseUknownType(t,env)
noteExport(rest x,pred)
PUSH(MKQ [rest x,pred],$sigList)