From d2af373ae99abdf494780c872340086cd588b990 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Tue, 7 Oct 2008 20:19:37 +0000
Subject: 	* 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.

---
 src/ChangeLog            |  7 ++++++
 src/interp/c-util.boot   | 60 +++++++++++++++++++++++++++++++++++++-----------
 src/interp/compiler.boot |  1 +
 src/interp/define.boot   |  2 --
 4 files changed, 54 insertions(+), 16 deletions(-)

diff --git a/src/ChangeLog b/src/ChangeLog
index 728dccd1..6681df69 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,10 @@
+2008-10-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* 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.
+
 2008-10-07  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/nruncomp.boot: Remove unused variable $maximalViews.
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)
 
-- 
cgit v1.2.3