allow deriving of a qualified type (more changes may be needed)

frontend/checkgenerics.icl

@@ -326,11 +326,6 @@ where
 			# cs = {cs & cs_error = checkError type_def.td_ident "type synonym not allowed" cs.cs_error}
 			= (TA type_cons [], TypeConsSymb type_cons, type_defs, modules, heaps, cs)
 			= (TA type_cons [], TypeConsSymb type_cons, type_defs, modules, heaps, cs)
-		where
-			type_synonym_with_arguments (SynType _) arity
-				= arity>0
-			type_synonym_with_arguments _ _
-				= False
 	check_instance_type module_index (TB b) type_defs modules heaps cs
 		= (TB b, TypeConsBasic b, type_defs, modules,heaps, cs) 
 	check_instance_type module_index TArrow type_defs modules heaps cs
@@ -340,10 +335,39 @@ where
 		# tv = {tv & tv_info_ptr = tv_info_ptr}		
 		= 	( TV tv, TypeConsVar tv, type_defs, modules
 			, {heaps& hp_type_heaps = {hp_type_heaps & th_vars = th_vars}}, cs)
+	check_instance_type module_index type=:(TQualifiedIdent module_id type_name []) type_defs modules heaps cs
+		# (found,{decl_kind,decl_ident=type_ident,decl_index=type_index},cs) = search_qualified_ident module_id type_name TypeNameSpaceN cs
+		| not found
+			# cs_error = checkError ("'"+++module_id.id_name+++"'."+++type_name) "generic argument type undefined" cs.cs_error
+ 			= (type, TypeConsQualifiedIdent module_id type_name, type_defs, modules, heaps, {cs & cs_error=cs_error})
+			= case decl_kind of
+				STE_Imported STE_Type type_module
+					# (entry, cs_symbol_table) = readPtr type_ident.id_info cs.cs_symbol_table
+					# cs & cs_symbol_table = cs_symbol_table
+				  	# (type_index, type_module) = retrieveGlobalDefinition entry STE_Type module_index
+					# type_cons = MakeNewTypeSymbIdent type_ident 0
+					| type_index == NotFound
+						# cs_error = checkError type_ident "generic argument type undefined" cs.cs_error
+			 			-> (type, TypeConsQualifiedIdent module_id type_name, type_defs, modules, heaps, {cs & cs_error=cs_error})
+					# (type_def, type_defs, modules)
+						= getTypeDef module_index {glob_module=type_module, glob_object=type_index} type_defs modules
+					# type_cons = { type_cons & type_index = { glob_object = type_index, glob_module = type_module }}
+					| type_synonym_with_arguments type_def.td_rhs type_def.td_arity
+						# cs & cs_error = checkError type_def.td_ident "type synonym not allowed" cs.cs_error
+						-> (TA type_cons [], TypeConsSymb type_cons, type_defs, modules, heaps, cs)
+						-> (TA type_cons [], TypeConsSymb type_cons, type_defs, modules, heaps, cs)
+				_
+					# cs_error = checkError ("'"+++module_id.id_name+++"'."+++type_name) "not imported" cs.cs_error
+		 			-> (type, TypeConsQualifiedIdent module_id type_name, type_defs, modules, heaps, {cs & cs_error=cs_error})
 	check_instance_type module_index ins_type type_defs modules heaps cs=:{cs_error}
 		# cs_error = checkError {id_name="<>",id_info=nilPtr} "invalid generic type argument" cs_error
 		= (ins_type, TypeConsArrow, type_defs, modules, heaps, {cs & cs_error=cs_error})
 
+type_synonym_with_arguments (SynType _) arity
+	= arity>0
+type_synonym_with_arguments _ _
+	= False
+
 get_generic_index :: !Ident !Index !*CheckState -> (!GlobalIndex, !*CheckState)
 get_generic_index {id_name,id_info} mod_index cs=:{cs_symbol_table}
 	# (ste, cs_symbol_table) = readPtr id_info cs_symbol_table

frontend/genericsupport.icl

@@ -105,6 +105,7 @@ where
 	type_cons_to_str (TypeConsBasic bt) = toString bt
 	type_cons_to_str TypeConsArrow = "ARROW"
 	type_cons_to_str (TypeConsVar tv) = tv.tv_ident.id_name
+	type_cons_to_str (TypeConsQualifiedIdent _ type_name) = type_name
 
 field_n_of_GenericTypeDefDescriptor :: !String -> Int
 field_n_of_GenericTypeDefDescriptor "gtd_name" = 0

frontend/parse.icl

@@ -1980,15 +1980,17 @@ where
 		= (derive_def, pState)
 
 	get_type_cons :: Type !*ParseState -> (TypeCons, !*ParseState)	
-	get_type_cons (TA type_symb []) pState 
+	get_type_cons (TA type_symb []) pState
 		= (TypeConsSymb type_symb, pState)
-	get_type_cons (TB tb) pState 
+	get_type_cons (TB tb) pState
 		= (TypeConsBasic tb, pState)
 	get_type_cons TArrow pState
 		= (TypeConsArrow, pState)
 	get_type_cons (TV tv) pState
 		| isDclContext parseContext
-			= (TypeConsVar tv, pState)			 
+			= (TypeConsVar tv, pState)
+	get_type_cons (TQualifiedIdent module_id ident_name []) pState
+		= (TypeConsQualifiedIdent module_id ident_name, pState)
 	get_type_cons type pState 
 		# pState = parseError "generic type" No " type constructor" pState
 		= (abort "no TypeCons", pState)

frontend/syntax.dcl

@@ -445,7 +445,8 @@ instance == GenericDependency
 	= TypeConsSymb TypeSymbIdent 
 	| TypeConsBasic BasicType 
 	| TypeConsArrow
-	| TypeConsVar TypeVar 
+	| TypeConsVar TypeVar
+	| TypeConsQualifiedIdent !Ident !String 
 
 :: GenericCaseDef =
 	{	gc_pos			:: !Position			// position in the source file