check imports of types that occur only in a cached definition module,

we can currently only check if there is an import, not whether it should be a qualified import


git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@2776 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

3 files changed, 73 insertions, 2 deletions

diff --git a/frontend/checktypes.icl b/frontend/checktypes.icl
index 393459d..2c7c413 100644
--- a/frontend/checktypes.icl
+++ b/frontend/checktypes.icl
@@ -3,7 +3,7 @@ implementation module checktypes
 import StdEnv, compare_types
 import syntax, checksupport, typesupport, utilities
 import genericsupport
-from explicitimports import search_qualified_ident,::NameSpaceN,TypeNameSpaceN,ClassNameSpaceN
+from explicitimports import search_qualified_ident,qualified_import_for_type,::NameSpaceN,TypeNameSpaceN,ClassNameSpaceN
 
 ::	TypeSymbols = 
 	{	ts_type_defs		:: !.{# CheckedTypeDef}
@@ -377,7 +377,7 @@ check_context_class (TCGeneric gtc=:{gtc_generic, gtc_kind}) tc_types mod_index
 				= (tc_class, class_defs, modules, cs)
 				# cs = {cs & cs_error = checkError gen_ident "a generic context is not allowed in a dynamic type" cs.cs_error}
 				= (tc_class, class_defs, modules, cs)
-			# cs_error = checkError gen_ident "generic used with wrong arity: generic has always has one class argument" cs.cs_error  
+			# cs_error = checkError gen_ident "generic used with wrong arity: generic always has one class argument" cs.cs_error  
 			= (TCGeneric {gtc & gtc_class=clazz}, class_defs, modules, {cs & cs_error = cs_error})
 		# cs_error = checkError gen_ident "generic undefined" cs.cs_error
 		= (TCGeneric {gtc & gtc_class=clazz}, class_defs, modules, {cs & cs_error = cs_error})
@@ -392,6 +392,59 @@ check_context_types tc_class [TV _ : types] cs
 check_context_types tc_class [type : types] cs
 	= check_context_types tc_class types cs
 
+cached_used_type_is_imported :: !Ident !Int !SymbolPtr !*SymbolTable -> (!Bool,!*SymbolTable)
+cached_used_type_is_imported {id_info,id_name} module_n module_ptr symbol_table
+	# (entry=:{ste_kind,ste_def_level,ste_index}, symbol_table)	= readPtr id_info symbol_table
+	// both normal and qualified import are allowed, because the required information is no longer available (to do)
+	= case ste_kind of
+		STE_Type
+			| ste_def_level==cGlobalScope
+				-> (True,symbol_table)
+		STE_Imported STE_Type ste_mod_index
+			| ste_mod_index==module_n
+				-> (True,symbol_table)
+		_
+			# ({ste_kind}, symbol_table) = readPtr module_ptr symbol_table
+			-> case ste_kind of
+				STE_ModuleQualifiedImports sorted_qualified_imports
+					| qualified_import_for_type id_name sorted_qualified_imports
+						-> (True,symbol_table)
+				_
+					-> (False,symbol_table)
+
+check_imports_of_cached_used_types :: [GlobalIndex] Int Int *{#CheckedTypeDef} *{#DclModule} *CheckState -> (!*{#CheckedTypeDef},!*{#DclModule},!*CheckState)
+check_imports_of_cached_used_types [{gi_module,gi_index} : used_types] module_index type_index ts_type_defs modules cs
+	| gi_module==cPredefinedModuleIndex
+		= check_imports_of_cached_used_types used_types module_index type_index ts_type_defs modules cs
+	# (module_ptr,modules) = modules![gi_module].dcl_name.id_info
+	| gi_module==module_index
+		# (type_ident,ts_type_defs) = ts_type_defs![gi_index].td_ident
+		  (is_imported,symbol_table) = cached_used_type_is_imported type_ident gi_module module_ptr cs.cs_symbol_table
+		  cs & cs_symbol_table=symbol_table
+		| is_imported
+			= check_imports_of_cached_used_types used_types module_index type_index ts_type_defs modules cs
+			= error_and_check_imports_of_cached_used_types type_ident used_types module_index type_index ts_type_defs modules cs
+		# (type_ident,modules) = modules![gi_module].dcl_common.com_type_defs.[gi_index].td_ident
+		  (is_imported,symbol_table) = cached_used_type_is_imported type_ident gi_module module_ptr cs.cs_symbol_table
+		  cs & cs_symbol_table=symbol_table
+		| is_imported
+			= check_imports_of_cached_used_types used_types module_index type_index ts_type_defs modules cs
+			= error_and_check_imports_of_cached_used_types type_ident used_types module_index type_index ts_type_defs modules cs
+where
+	error_and_check_imports_of_cached_used_types type_ident used_types module_index type_index ts_type_defs modules cs
+		# (module_name,modules) = modules![gi_module].dcl_name.id_name
+		# (td_pos, ts_type_defs) = ts_type_defs![type_index].td_pos
+		# cs & cs_error = checkErrorWithPosition type_ident td_pos ("not imported in implementation module (from "+++module_name+++")") cs.cs_error
+		= check_imports_of_cached_used_types used_types module_index type_index ts_type_defs modules cs
+check_imports_of_cached_used_types [] module_index type_index ts_type_defs modules cs
+	= (ts_type_defs,modules,cs)
+
+check_imports_of_cached_type_def :: Int Int *TypeSymbols *CheckState -> (!*TypeSymbols,!*CheckState)
+check_imports_of_cached_type_def type_index module_index ts=:{ts_type_defs,ts_modules} cs
+	# (td_used_types, ts_type_defs) = ts_type_defs![type_index].td_used_types
+	#! (ts_type_defs,ts_modules,cs) = check_imports_of_cached_used_types td_used_types module_index type_index ts_type_defs ts_modules cs
+	= ({ts & ts_type_defs = ts_type_defs, ts_modules = ts_modules},cs)
+
 emptyIdent name :== { id_name = name, id_info = nilPtr }
 
 checkTypeDef :: !Index !Index !v:{#ClassDef} !*TypeSymbols !*TypeInfo !*CheckState -> (!v:{#ClassDef},!*TypeSymbols,!*TypeInfo,!*CheckState);
@@ -635,6 +688,7 @@ where
 	check_type_def module_index opt_icl_info type_index (class_defs, ts, ti, cs)
 		| has_to_be_checked module_index opt_icl_info type_index
 			= checkTypeDef type_index module_index class_defs ts ti cs
+			# (ts,cs) = check_imports_of_cached_type_def type_index module_index ts cs
 			= (class_defs, ts, ti, cs)
 
 	has_to_be_checked module_index No type_index
diff --git a/frontend/explicitimports.dcl b/frontend/explicitimports.dcl
index f428874..afd799a 100644
--- a/frontend/explicitimports.dcl
+++ b/frontend/explicitimports.dcl
@@ -48,4 +48,6 @@ search_qualified_ident :: !Ident {#Char} !NameSpaceN !*CheckState -> (!Bool,!Dec
 search_qualified_import :: !String !SortedQualifiedImports !NameSpaceN -> (!Bool,!DeclarationRecord)
 search_qualified_imports :: !String !SortedQualifiedImports !NameSpaceN -> [DeclarationRecord]
 
+qualified_import_for_type :: !String !SortedQualifiedImports -> Bool
+
 restore_module_ste_kinds_in_symbol_table :: ![(SymbolPtr,STE_Kind)] !*SymbolTable -> *SymbolTable
diff --git a/frontend/explicitimports.icl b/frontend/explicitimports.icl
index de2c248..40b6ecd 100644
--- a/frontend/explicitimports.icl
+++ b/frontend/explicitimports.icl
@@ -1021,6 +1021,21 @@ search_qualified_imports name (SortedQualifiedImports (Declaration declaration=:
 		= search_qualified_imports name sqi_left  name_space_n
 		= search_qualified_imports name sqi_right name_space_n
 
+qualified_import_for_type :: !String !SortedQualifiedImports -> Bool
+qualified_import_for_type name EmptySortedQualifiedImports
+	= False
+qualified_import_for_type name (SortedQualifiedImports (Declaration declaration=:{decl_ident={id_name},decl_kind}) sqi_left sqi_right)
+	| name==id_name
+		# decl_name_space_n = imported_ste_kind_to_name_space_n decl_kind
+		| TypeNameSpaceN == decl_name_space_n
+			= True
+		| TypeNameSpaceN < decl_name_space_n
+			= qualified_import_for_type name sqi_left
+			= qualified_import_for_type name sqi_right
+	| name<id_name
+		= qualified_import_for_type name sqi_left
+		= qualified_import_for_type name sqi_right
+
 restore_module_ste_kinds_in_symbol_table :: ![(SymbolPtr,STE_Kind)] !*SymbolTable -> *SymbolTable
 restore_module_ste_kinds_in_symbol_table [(ptr,ste_kind):ptrs_and_ste_kinds] symbol_table
 	# (ste,symbol_table) = readPtr ptr symbol_table