From 2c4a7a870fbf9fb36da60f760bc7f942d0132094 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Fri, 29 Aug 2008 16:22:28 +0000
Subject: 	* interp/c-util.boot (isKnownType): New. 
 (diagnoseUknownType): Likewise. 	* interp/define.boot
 (compCategoryItem): Use it.  Check for 	unknown types.

---
 src/interp/c-util.boot | 26 ++++++++++++++++++++++++++
 src/interp/define.boot |  2 ++
 2 files changed, 28 insertions(+)

(limited to 'src/interp')

diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index 88565415..c45159a7 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -355,7 +355,33 @@ TrimCF() ==
       new:= [[first u,:NREVERSE unew],:new]
   $CategoryFrame:= [[NREVERSE new]]
   nil
+
+--%
+ 
+++ Returns non-nil if `t' is a known type in the environement `e'.
+isKnownType: (%Mode,%Env) -> %Form
+isKnownType(t,e) ==
+  atom t =>
+    t in '($ constant) => t
+    t' := assoc(t,getDomainsInScope e) => t'
+    get(first getmode(t,e),"isCategory",$CategoryFrame) => t
+    STRINGP t => t
+  t is ["Mapping",:sig] => 
+    and/[isKnownType(t',e) for t' in sig] => t
+    nil
+  ctor := first 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])
+
  
 --% PREDICATES
  
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 14ff75a1..5b017517 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1602,4 +1602,6 @@ compCategoryItem(x,predl) ==
     nil
  
   --4. branch on a single type or a signature %with source and target
+  for t in first sig repeat
+    diagnoseUknownType(t,e)
   PUSH(MKQ [rest x,pred],$sigList)
-- 
cgit v1.2.3