- type synonyms in type definition written to a tcl-file are fully expanded now.

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

5 files changed, 83 insertions, 103 deletions

diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl
index 9465e7e..7ab260a 100644
--- a/frontend/convertDynamics.icl
+++ b/frontend/convertDynamics.icl
@@ -13,7 +13,6 @@ extended_unify_and_coerce no yes :== no;	// change also _unify and _coerce in St
 import type_io;
 //import pp;
 
-
 :: TypeCodeVariableInfo = TCI_TypeVar !Expression | TCI_TypePatternVar !Expression
 :: DynamicValueAliasInfo :== BoundVar
 
@@ -49,22 +48,27 @@ fatal :: {#Char} {#Char} -> .a
 fatal function_name message
 	=	abort ("convertDynamics, " +++ function_name +++ ": " +++ message)
 
-//write_tcl_file :: !Int {#DclModule} CommonDefs !*File [String] -> (.Bool,.File)
-//write_tcl_file :: !Int {#DclModule} CommonDefs !*File [String] _ _ !*TypeHeaps !*PredefinedSymbols -> (.Bool,.File,!*TypeHeaps,!*PredefinedSymbols)
-// write_tcl_file ({#},{!},{#},[{#Char}],CommonDefs,{#}) :: !.Int !{#y:DclModule} CommonDefs !*File [{#Char}] !{!x:GlobalTCType} {#w:Bool} !*TypeHeaps !{#v:PredefinedSymbol} -> (.Bool,.File,.TypeHeaps,{#PredefinedSymbol}), [u <= 
-write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_module} common_defs tcl_file directly_imported_dcl_modules global_type_instances ci_type_constructor_used_in_dynamic_patterns type_heaps predefined_symbols
+write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_module} icl_common_defs tcl_file directly_imported_dcl_modules global_type_instances ci_type_constructor_used_in_dynamic_patterns type_heaps 
+			   predefined_symbols imported_types var_heap common_defs icl_mod
 	# (pre_mod, predefined_symbols) = predefined_symbols![PD_PredefinedModule]
 	# write_type_info_state2
 		= { WriteTypeInfoState |
-			wtis_type_heaps				= type_heaps
-		,	wtis_n_type_vars			= 0
-		,	wtis_predefined_module_def	= pre_mod.pds_module
+			wtis_n_type_vars				= 0
+		,	wtis_predefined_module_def		= pre_mod.pds_module
+		,	wtis_common_defs				= common_defs
+		,	wtis_type_defs					= imported_types
+	  	, 	wtis_collected_conses			= []
+	  	, 	wtis_type_heaps					= type_heaps
+	  	, 	wtis_var_heap					= var_heap
+	  	, 	wtis_main_dcl_module_n			= main_dcl_module_n
 		};
+
 	# (j,tcl_file)
 		= fposition tcl_file
 
 	#! (tcl_file,write_type_info_state)
-		= write_type_info common_defs tcl_file write_type_info_state2
+		= write_type_info icl_common_defs tcl_file write_type_info_state2
+
 	#! (tcl_file,write_type_info_state)
 		= write_type_info directly_imported_dcl_modules tcl_file write_type_info_state
 
@@ -80,31 +84,29 @@ write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_modul
 				help_20_compiler :: {#{#Char}} -> {#{#Char}}
 				help_20_compiler l = l
 		
-	#! (type_heaps,_)
-		= f write_type_info_state;	
-		
+		 
 	#! tcl_file
 		= fwritei (size main_dcl_module.dcl_common.com_type_defs) tcl_file
 	#! tcl_file
-		= fwritei (size main_dcl_module.dcl_common.com_cons_defs) tcl_file
+	 	= fwritei (size main_dcl_module.dcl_common.com_cons_defs) tcl_file
+	 
+	#! (type_heaps,imported_types,var_heap)
+		= f write_type_info_state;	
 				
-	= (True,tcl_file,type_heaps,predefined_symbols) 
+	= (True,tcl_file,type_heaps,predefined_symbols,imported_types,var_heap) 
 where
 
 	collect_type_constructors_in_dynamic_patterns :: !Int !Int [TypeSymbIdent] -> [TypeSymbIdent]
 	collect_type_constructors_in_dynamic_patterns i limit type_constructors_in_dynamic_patterns
 		=	[]
 
-	f write_type_info_state=:{wtis_type_heaps}
-		= (wtis_type_heaps,{write_type_info_state & wtis_type_heaps = abort "convertDynamics.icl"});
-
-
+	f write_type_info_state=:{wtis_type_heaps,wtis_type_defs,wtis_var_heap}
+		= (wtis_type_heaps,wtis_type_defs,wtis_var_heap)
 
 /*2.0
 f (Yes tcl_file)
 	= tcl_file;
 0.2*/
-
 			
 convertDynamicPatternsIntoUnifyAppls :: {! GlobalTCType} !{# CommonDefs} !Int !*{! Group} !*{#FunDef} !*PredefinedSymbols !*VarHeap !*TypeHeaps !*ExpressionHeap (Optional *File) {# DclModule} !IclModule [String]
 			-> (!*{! Group}, !*{#FunDef}, !*PredefinedSymbols, !*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps, !*ExpressionHeap, (Optional *File))
@@ -125,17 +127,18 @@ convertDynamicPatternsIntoUnifyAppls global_type_instances common_defs main_dcl_
 							})
 			
 	// store type info			
-	# (tcl_file,type_heaps,ci_predef_symb)
+	# (tcl_file,type_heaps,ci_predef_symb,imported_types,ci_var_heap)
 		= case tcl_file of
 			No
-				-> (No,type_heaps,ci_predef_symb)
+				-> (No,type_heaps,ci_predef_symb,imported_types,ci_var_heap)
 			_ 
 				# tcl_file = f tcl_file;
-				# (ok,tcl_file,type_heaps,ci_predef_symb)
-					= write_tcl_file main_dcl_module_n dcl_mods icl_mod.icl_common tcl_file directly_imported_dcl_modules global_type_instances ci_type_constructor_used_in_dynamic_patterns type_heaps ci_predef_symb
+				# (ok,tcl_file,type_heaps,ci_predef_symb,imported_types,ci_var_heap)
+					= write_tcl_file main_dcl_module_n dcl_mods icl_mod.icl_common tcl_file directly_imported_dcl_modules global_type_instances ci_type_constructor_used_in_dynamic_patterns type_heaps ci_predef_symb 
+									 imported_types ci_var_heap common_defs icl_mod
 				| not ok
 					-> abort "convertDynamicPatternsIntoUnifyAppls: error writing tcl file"
-					-> (Yes tcl_file,type_heaps,ci_predef_symb)
+					-> (Yes tcl_file,type_heaps,ci_predef_symb,imported_types,ci_var_heap)
 
 	= (groups, fun_defs, ci_predef_symb, imported_types, [], ci_var_heap, type_heaps, ci_expr_heap, tcl_file)
 where
diff --git a/frontend/type_io.dcl b/frontend/type_io.dcl
index 05b91af..15962ca 100644
--- a/frontend/type_io.dcl
+++ b/frontend/type_io.dcl
@@ -17,14 +17,19 @@ splitBy :: Char {#Char} -> [{#Char}]
 //			system.
 
 import scanner, general, Heap, typeproperties, utilities, checksupport
-
 import StdEnv
+import trans
 
 :: WriteTypeInfoState
 	= { 
-		wtis_type_heaps			:: !.TypeHeaps
-	,	wtis_n_type_vars		:: !Int
-	,	wtis_predefined_module_def	:: !Index
+		wtis_n_type_vars						:: !Int
+	,	wtis_predefined_module_def				:: !Index
+	,	wtis_common_defs						:: !{#CommonDefs}	
+	,	wtis_type_defs							:: !.{#{#CheckedTypeDef}}
+	,	wtis_collected_conses					:: !ImportedConstructors
+	,	wtis_type_heaps							:: !.TypeHeaps
+	,	wtis_var_heap							:: !.VarHeap
+	,	wtis_main_dcl_module_n 					:: !Int
 	};
 
 class WriteTypeInfo a 
@@ -45,3 +50,5 @@ instance WriteTypeInfo {#b} | select_u, size_u, WriteTypeInfo b
 instance WriteTypeInfo (a,b) | WriteTypeInfo a & WriteTypeInfo b
 
 instance WriteTypeInfo TypeSymbIdent
+
+instance WriteTypeInfo Int 
\ No newline at end of file
diff --git a/frontend/type_io.icl b/frontend/type_io.icl
index d4b151c..fa4ab7f 100644
--- a/frontend/type_io.icl
+++ b/frontend/type_io.icl
@@ -9,6 +9,7 @@ implementation module type_io
 
 import StdEnv, compare_constructor
 import scanner, general, Heap, typeproperties, utilities, checksupport
+import trans
 
 import type_io_common
 // normal form:
@@ -19,18 +20,20 @@ import type_io_common
 //		module
 //
 // unsupported:
-// - 	type synonyms
 // - 	ADTs
 
-//import DebugUtilities;
 F a b :== b;
 
 :: WriteTypeInfoState
 	= { 
-		wtis_type_heaps				:: !.TypeHeaps
-	,	wtis_n_type_vars			:: !Int
-	,	wtis_predefined_module_def	:: !Index
-
+		wtis_n_type_vars						:: !Int
+	,	wtis_predefined_module_def				:: !Index
+	,	wtis_common_defs						:: !{#CommonDefs}	
+	,	wtis_type_defs							:: !.{#{#CheckedTypeDef}}
+	,	wtis_collected_conses					:: !ImportedConstructors
+	,	wtis_type_heaps							:: !.TypeHeaps
+	,	wtis_var_heap							:: !.VarHeap
+	,	wtis_main_dcl_module_n 					:: !Int
 	};
 	
 class WriteTypeInfo a 
@@ -64,63 +67,25 @@ where
  		# (_,(_,th_vars))
  			= mapSt normalize_type_var cons_exi_vars (wtis_n_type_vars,th_vars)
   		# wtis
- 			= { wtis &
- 				wtis_type_heaps		=  { wtis.wtis_type_heaps & th_vars = th_vars }
- 			}
+ 			= { wtis & wtis_type_heaps.th_vars = th_vars }
  		// ... normalize
 
 		# (tcl_file,wtis)
 			= write_type_info cons_symb tcl_file wtis
 		# (tcl_file,wtis)
 			= write_type_info cons_type tcl_file wtis
+		
 		# (tcl_file,wtis)
 			= write_type_info cons_arg_vars tcl_file wtis
-//		# (tcl_file,wtis)
-//			= write_type_info cons_priority tcl_file wtis
-
 		# (tcl_file,wtis)
 			= write_type_info cons_index tcl_file wtis
+						
 		# (tcl_file,wtis)
 			= write_type_info cons_type_index tcl_file wtis
 		# (tcl_file,wtis)
 			= write_type_info cons_exi_vars tcl_file wtis
-	
 		= (tcl_file,wtis)
-		
-/*
-instance WriteTypeInfo Priority
-where 
-	write_type_info (Prio assoc i) tcl_file wtis
-		# tcl_file
-			= fwritec PrioCode tcl_file
-		# (tcl_file,wtis)
-			= write_type_info assoc tcl_file wtis
-		# (tcl_file,wtis)
-			= write_type_info i tcl_file wtis
-		= (tcl_file,wtis)
-	write_type_info NoPrio tcl_file wtis
-		# tcl_file
-			= fwritec NoPrioCode tcl_file 
-		= (tcl_file,wtis)
-		
-instance WriteTypeInfo Assoc
-where 
-	write_type_info LeftAssoc tcl_file wtis
-		# tcl_file
-			= fwritec LeftAssocCode tcl_file 
-		= (tcl_file,wtis)
-
-	write_type_info RightAssoc tcl_file wtis
-		# tcl_file
-			= fwritec RightAssocCode tcl_file
-		= (tcl_file,wtis)	
-
-	write_type_info NoAssoc tcl_file wtis
-		# tcl_file
-			= fwritec NoAssocCode tcl_file 
-		= (tcl_file,wtis)	
-*/
-		
+			
 //1.3
 instance WriteTypeInfo TypeDef TypeRhs
 //3.1
@@ -136,7 +101,7 @@ where
  			= mapSt normalize_type_var td_args (0,th_vars)
   		# wtis
  			= { wtis &
- 				wtis_type_heaps		=  { wtis.wtis_type_heaps & th_vars = th_vars }
+ 				wtis_type_heaps.th_vars = th_vars
  			,	wtis_n_type_vars		= n_type_vars
  			}
  		// ... normalize
@@ -146,7 +111,7 @@ where
 		# (tcl_file,wtis)
  			= write_type_info td_arity tcl_file wtis 				
  		# (tcl_file,wtis)
- 			= write_type_info td_args tcl_file wtis
+ 			= write_type_info td_args tcl_file wtis	
 		# (tcl_file,wtis)
  			= write_type_info td_rhs tcl_file wtis
  			
@@ -157,16 +122,15 @@ normalize_type_var td_arg=:{atv_variable={tv_info_ptr}} (id,th_vars)
 	# th_vars
 		= writePtr tv_info_ptr (TVI_Normalized id) th_vars
 	= (id,(inc id,th_vars));
-		
+
 sel_type_var_heap :: !*WriteTypeInfoState -> (!*TypeVarHeap,!*WriteTypeInfoState)
 sel_type_var_heap wtis=:{wtis_type_heaps}
 	# (th_vars,wtis_type_heaps)
 		= sel wtis_type_heaps
 	= (th_vars,{ wtis & wtis_type_heaps = wtis_type_heaps} )
-	
-	where
-		sel wtis_type_heaps=:{th_vars}
-			= (th_vars,{ wtis_type_heaps & th_vars = newHeap } )
+where
+	sel wtis_type_heaps=:{th_vars}
+		= (th_vars,{ wtis_type_heaps & th_vars = newHeap } )
  
 instance WriteTypeInfo ATypeVar
 where 
@@ -187,7 +151,7 @@ where
 
   		# wtis 
  			= { wtis &
- 				wtis_type_heaps		=  { wtis.wtis_type_heaps & th_vars = th_vars }
+ 				wtis_type_heaps.th_vars = th_vars
  			}
  		= (tcl_file,wtis)	
  	where 
@@ -209,9 +173,7 @@ where
 	write_type_info (SynType _) tcl_file wtis
 		# tcl_file
  			= fwritec SynTypeCode tcl_file;
- 			
- 		// unimplemented
- 		= (tcl_file,wtis) 
+  		= (tcl_file,wtis) 
 		
 	write_type_info (RecordType {rt_constructor,rt_fields}) tcl_file wtis
  		#! tcl_file
@@ -258,10 +220,12 @@ where
 			= write_type_info fs_index tcl_file wtis
 		= (tcl_file,wtis)
 		
-// NEW ->
 instance WriteTypeInfo SymbolType
 where
-	write_type_info {st_vars,st_args,st_args_strictness,st_arity,st_result} tcl_file wtis
+	write_type_info symbol_type tcl_file wtis
+		#! ({st_vars,st_args,st_args_strictness,st_arity,st_result},wtis)
+			= expand_symbol_type symbol_type wtis
+
 		# (tcl_file,wtis)
 			= write_type_info st_vars tcl_file wtis
 		# (tcl_file,wtis)
@@ -273,7 +237,18 @@ where
 		# (tcl_file,wtis)
 			= write_type_info st_result tcl_file wtis
 		= (tcl_file,wtis)
-	
+	where
+		expand_symbol_type symbol_type wtis=:{wtis_common_defs,wtis_type_defs,wtis_main_dcl_module_n,wtis_collected_conses,wtis_type_heaps,wtis_var_heap}
+			# (expanded_symbol_type,wtis_type_defs,wtis_collected_conses,wtis_type_heaps,wtis_var_heap)
+				= convertSymbolType False wtis_common_defs symbol_type wtis_main_dcl_module_n wtis_type_defs [] /* ? */ wtis_type_heaps wtis_var_heap;
+			# wtis
+				= { wtis &
+					wtis_type_defs							= wtis_type_defs
+				,	wtis_type_heaps							= wtis_type_heaps
+				,	wtis_var_heap							= wtis_var_heap
+				};
+			= (expanded_symbol_type,wtis)
+				
 instance WriteTypeInfo StrictnessList
 where
 	write_type_info NotStrict tcl_file wtis
@@ -311,8 +286,6 @@ where
 			= write_type_info atypes tcl_file wtis
 		# (tcl_file,wtis)
 			= write_type_info NotStrict tcl_file wtis			
-//		# (tcl_file,wtis)
-//			= write_annotated_type_info atypes strictness tcl_file wtis
 		= (tcl_file,wtis)
 
 	write_type_info (TAS type_symb_ident atypes strictness) tcl_file wtis
@@ -324,8 +297,6 @@ where
 			= write_type_info atypes tcl_file wtis
 		# (tcl_file,wtis)
 			= write_type_info strictness tcl_file wtis			
-//		# (tcl_file,wtis)
-//			= write_annotated_type_info atypes strictness tcl_file wtis
 		= (tcl_file,wtis)
 
 	write_type_info (atype1 --> atype2) tcl_file wtis
@@ -415,7 +386,7 @@ where
 
 instance WriteTypeInfo TypeSymbIdent
 where
-	write_type_info tsi=:{type_name,type_arity,type_index={glob_module}} tcl_file wtis=:{wtis_predefined_module_def}
+	write_type_info tsi=:{type_name,type_arity,type_index={glob_module,glob_object}} tcl_file wtis=:{wtis_predefined_module_def}
 		# is_type_without_definition
 			= glob_module == wtis_predefined_module_def
 		# tcl_file
@@ -423,12 +394,13 @@ where
 
 		# (tcl_file,wtis)
 			= write_type_info type_name tcl_file wtis
-		# (tcl_file,wtis)
+		# (tcl_file,wtis)		 
 			= write_type_info type_arity tcl_file wtis
 		# (tcl_file,wtis)
 			= write_type_info tsi.type_index tcl_file wtis
+
 		= (tcl_file,wtis)
-	
+
 instance WriteTypeInfo (Global object) | WriteTypeInfo object
 where
 	write_type_info {glob_object,glob_module} tcl_file wtis
@@ -437,7 +409,7 @@ where
 		# (tcl_file,wtis)
 			= write_type_info glob_module tcl_file wtis
 		= (tcl_file,wtis)
-
+ 
 // basic and structural write_type_info's
 instance WriteTypeInfo Int 
 where
@@ -497,7 +469,6 @@ where
 			= write_type_info c2 tcl_file wtis
 		= (tcl_file,wtis)
 
-// MV ...
 from CoclSystemDependent import DirectorySeparator, ensureCleanSystemFilesExists
 
 openTclFile :: !Bool !String !*Files -> (Optional .File, !*Files)
@@ -551,6 +522,4 @@ splitBy char string
 				=	splitBy` frm (to+1)
 		stringSize
 			=	size string
-
-// ... copy from compile.icl
-// ... MV
+// ... copy from compile.icl
\ No newline at end of file
diff --git a/frontend/type_io_common.dcl b/frontend/type_io_common.dcl
index 1e7dabd..d8df928 100644
--- a/frontend/type_io_common.dcl
+++ b/frontend/type_io_common.dcl
@@ -85,3 +85,4 @@ create_type_string type_name module_name
 			(type_name +++ (APPEND_DEFINING_TYPE_MODULE_NAMES_TO_TYPE_NAMES ("'" +++ module_name ) ""))
 
 get_type_name_and_module_name_from_type_string :: !String -> (!String,!String)
+
diff --git a/frontend/type_io_common.icl b/frontend/type_io_common.icl
index 3d8caf8..15ce77c 100644
--- a/frontend/type_io_common.icl
+++ b/frontend/type_io_common.icl
@@ -112,4 +112,4 @@ where
 					= (True,i)
 					= CharIndex s (inc i) char;
 				= abort "CharIndex: index out of range"
-	
\ No newline at end of file
+