diff options
author | dos-reis <gdr@axiomatics.org> | 2008-10-07 20:19:37 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2008-10-07 20:19:37 +0000 |
commit | d2af373ae99abdf494780c872340086cd588b990 (patch) | |
tree | 29da74227d0bb1f8c53c90d47cc05c0453881594 /src/interp | |
parent | e7edec07aedf0c1fd83171db1235120bd0f6da4f (diff) | |
download | open-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.boot | 60 | ||||
-rw-r--r-- | src/interp/compiler.boot | 1 | ||||
-rw-r--r-- | src/interp/define.boot | 2 |
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) |