- change in strictness information

- each placeholder now has two arguments

* In order to use dynamics, a new compiler, {static,dynamic}-linker and a new
 StdDynamicEnv are necessary.


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

5 files changed, 106 insertions, 69 deletions

diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl
index aefc2fb..6744d11 100644
--- a/frontend/convertDynamics.icl
+++ b/frontend/convertDynamics.icl
@@ -792,7 +792,7 @@ where
 // MW0		create_variable :: !Ident VarInfoPtr !*ConversionInfo -> (Bind Expression FreeVar, !*ConversionInfo)
 		create_variable :: !Ident VarInfoPtr !*ConversionInfo -> (LetBind, !*ConversionInfo)
 		create_variable var_name var_info_ptr ci
-			# (placeholder_symb, ci) = getSymbol PD_variablePlaceholder SK_Constructor 3 ci
+			# (placeholder_symb, ci) = getSymbol PD_variablePlaceholder SK_Constructor 2 ci
 			  cyclic_var = {var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}	
 			  cyclic_fv = varToFreeVar cyclic_var 1	
 // MW0			= ({ bind_src = App {	app_symb = placeholder_symb,
@@ -1128,8 +1128,8 @@ where
 	create_variable var_name var_info_ptr ci
 		# (placeholder_symb, ci) 
 			= case generate_universal_type_variables of
-				False	-> getSymbol PD_variablePlaceholder SK_Constructor 3 ci
-				True 	-> getSymbol PD_UvariablePlaceholder SK_Constructor 3 ci
+				False	-> getSymbol PD_variablePlaceholder SK_Constructor 2 ci
+				True 	-> getSymbol PD_UvariablePlaceholder SK_Constructor 2 ci
 		  cyclic_var = {var_name = var_name, var_info_ptr = var_info_ptr, var_expr_ptr = nilPtr}	
 		  cyclic_fv = varToFreeVar cyclic_var 1	
 	// MW0	= ({ bind_src = App {	app_symb = placeholder_symb,
diff --git a/frontend/type_io.dcl b/frontend/type_io.dcl
index 54c6034..25a48b3 100644
--- a/frontend/type_io.dcl
+++ b/frontend/type_io.dcl
@@ -33,6 +33,7 @@ where
 	
 instance WriteTypeInfo CommonDefs, Char, [a] | WriteTypeInfo a
 
+instance WriteTypeInfo StrictnessList
 /*2.0
 instance WriteTypeInfo {#b} | Array {#} b & WriteTypeInfo b 
 0.2*/
diff --git a/frontend/type_io.icl b/frontend/type_io.icl
index ece6b41..201e6d7 100644
--- a/frontend/type_io.icl
+++ b/frontend/type_io.icl
@@ -213,10 +213,14 @@ where
  		// unimplemented
  		= (tcl_file,wtis) 
 		
-	write_type_info (RecordType {rt_fields}) tcl_file wtis
+	write_type_info (RecordType {rt_constructor,rt_fields}) tcl_file wtis
  		#! tcl_file
  			= fwritec RecordTypeCode tcl_file;
-		= write_type_info rt_fields tcl_file wtis
+		#! (tcl_file,wtis)
+			= write_type_info rt_constructor tcl_file wtis
+		#! (tcl_file,wtis)
+			= write_type_info rt_fields tcl_file wtis
+		= (tcl_file,wtis)
 
 	write_type_info (AbstractType _) tcl_file wtis
  		#! tcl_file
@@ -261,26 +265,34 @@ where
 		# (tcl_file,wtis)
 			= write_type_info st_vars tcl_file wtis
 		# (tcl_file,wtis)
-			= write_annotated_type_info st_args st_args_strictness tcl_file wtis
+			= write_type_info st_args tcl_file wtis
+		# (tcl_file,wtis)
+			= write_type_info st_args_strictness tcl_file wtis
 		# (tcl_file,wtis)
 			= write_type_info st_arity tcl_file wtis
 		# (tcl_file,wtis)
 			= write_type_info st_result tcl_file wtis
 		= (tcl_file,wtis)
-
-write_annotated_type_info l strictness tcl_file wtis
-	# tcl_file
-		= fwritei (length l) tcl_file
-	= write_annotated_type_info_loop l 0 tcl_file wtis
-	where
-		write_annotated_type_info_loop [] arg_index tcl_file wtis
-			= (tcl_file,wtis)
-		write_annotated_type_info_loop [x:xs] arg_index tcl_file wtis
-			# tcl_file = fwritec (if (arg_is_strict arg_index strictness) '!' ' ') tcl_file
-			# (tcl_file,wtis)
-				= write_type_info x tcl_file wtis
-			= write_annotated_type_info_loop xs (arg_index+1) tcl_file wtis
-		
+	
+instance WriteTypeInfo StrictnessList
+where
+	write_type_info NotStrict tcl_file wtis
+		# tcl_file
+			= fwritec NotStrictCode tcl_file
+		= (tcl_file,wtis)
+	write_type_info (Strict i) tcl_file wtis
+		# tcl_file
+			= fwritec StrictCode tcl_file
+		# tcl_file
+			= fwritei i tcl_file
+		= (tcl_file,wtis)
+	write_type_info (StrictList i tail) tcl_file wtis
+		# tcl_file
+			= fwritec StrictListCode tcl_file
+		# tcl_file
+			= fwritei i tcl_file
+		= write_type_info tail tcl_file wtis
+				
 instance WriteTypeInfo AType
 where
 	write_type_info {at_type} tcl_file wtis
@@ -292,20 +304,28 @@ instance WriteTypeInfo Type
 where
 	write_type_info (TA type_symb_ident atypes) tcl_file wtis
 		# tcl_file
-			= fwritec TypeTACode tcl_file
+			= fwritec TypeTASCode tcl_file
 		# (tcl_file,wtis)
 			= write_type_info type_symb_ident tcl_file wtis
 		# (tcl_file,wtis)
 			= 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
 		# tcl_file
-			= fwritec TypeTACode tcl_file
+			= fwritec TypeTASCode tcl_file
 		# (tcl_file,wtis)
 			= write_type_info type_symb_ident tcl_file wtis
 		# (tcl_file,wtis)
-			= write_annotated_type_info atypes strictness tcl_file wtis
+			= 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
diff --git a/frontend/type_io_common.dcl b/frontend/type_io_common.dcl
index 8c2c9cc..f466789 100644
--- a/frontend/type_io_common.dcl
+++ b/frontend/type_io_common.dcl
@@ -28,43 +28,53 @@ RecordTypeCode					:== (toChar 7)
 AbstractTypeCode				:== (toChar 8)
 
 // Type
-TypeTACode						:== (toChar 9)		// TA
-TypeArrowCode 					:== (toChar 10)		// -->
-TypeConsApplyCode				:== (toChar 11)		// :@:
-TypeTBCode						:== (toChar 12)		// TB
-TypeGTVCode						:== (toChar 13)		// GTV
-TypeTVCode						:== (toChar 14)		// TV
-TypeTQVCode						:== (toChar 15)		// TempTQV
-TypeTECode						:== (toChar 16)		// TE
+//TypeTACode						:== (toChar 9)		// TA
+TypeTASCode						:== (toChar 10)		// TAS
+TypeArrowCode 					:== (toChar 11)		// -->
+TypeConsApplyCode				:== (toChar 12)		// :@:
+TypeTBCode						:== (toChar 13)		// TB
+TypeGTVCode						:== (toChar 14)		// GTV
+TypeTVCode						:== (toChar 15)		// TV
+TypeTQVCode						:== (toChar 16)		// TempTQV
+TypeTECode						:== (toChar 17)		// TE
 
 // Type; TB
-BT_IntCode						:== (toChar 17)	
-BT_CharCode						:== (toChar 18)
-BT_RealCode						:== (toChar 19)
-BT_BoolCode						:== (toChar 20)
-BT_DynamicCode					:== (toChar 21)
-BT_FileCode						:== (toChar 22)
-BT_WorldCode					:== (toChar 23)
-BT_StringCode					:== (toChar 24)
+BT_IntCode						:== (toChar 18)	
+BT_CharCode						:== (toChar 19)
+BT_RealCode						:== (toChar 20)
+BT_BoolCode						:== (toChar 21)
+BT_DynamicCode					:== (toChar 22)
+BT_FileCode						:== (toChar 23)
+BT_WorldCode					:== (toChar 24)
+BT_StringCode					:== (toChar 25)
 
 // ConsVariable	
-ConsVariableCVCode				:== (toChar 25)	
-ConsVariableTempCVCode			:== (toChar 26)
-ConsVariableTempQCVCode			:== (toChar 27)
+ConsVariableCVCode				:== (toChar 26)	
+ConsVariableTempCVCode			:== (toChar 27)
+ConsVariableTempQCVCode			:== (toChar 28)
 
 // TypeSymbIdent
-TypeSymbIdentWithoutDefinition	:== (toChar 28)		// valid only for predefined in PD_PredefinedModule e.g. _String, _List
-TypeSymbIdentWithDefinition		:== (toChar 29)		// for all types which have definitions in some .icl-module
+TypeSymbIdentWithoutDefinition	:== (toChar 29)		// valid only for predefined in PD_PredefinedModule e.g. _String, _List
+TypeSymbIdentWithDefinition		:== (toChar 30)		// for all types which have definitions in some .icl-module
 
 // Maybe
-MaybeNothingCode				:== (toChar 30)
-MaybeJustCode					:== (toChar 31)
+MaybeNothingCode				:== (toChar 31)
+MaybeJustCode					:== (toChar 32)
+
+// StrictnessList
+NotStrictCode					:== (toChar 33)
+StrictCode						:== (toChar 34)
+StrictListCode					:== (toChar 35)
 
 // used by {compiler,dynamic rts} to make String representation of types
 PredefinedModuleName			:== "_predefined"
 
+isPredefinedModuleName name		:== name == PredefinedModuleName
+
 UnderscoreSystemModule			:== "_system"		// implements the predefined module
 
+LowLevelInterfaceModule			:== "StdDynamicLowLevelInterface"
+ 
 instance toString GlobalTCType
 
 instance toString BasicType
diff --git a/frontend/type_io_common.icl b/frontend/type_io_common.icl
index c47cfaa..4e575a4 100644
--- a/frontend/type_io_common.icl
+++ b/frontend/type_io_common.icl
@@ -28,37 +28,43 @@ RecordTypeCode			:== (toChar 7)
 AbstractTypeCode		:== (toChar 8)
 
 // Type
-TypeTACode				:== (toChar 9)		// TA
-TypeArrowCode 			:== (toChar 10)		// -->
-TypeConsApplyCode		:== (toChar 11)		// :@:
-TypeTBCode				:== (toChar 12)		// TB
-TypeGTVCode				:== (toChar 13)		// GTV
-TypeTVCode				:== (toChar 14)		// TV
-TypeTQVCode				:== (toChar 15)		// TempTQV
-TypeTECode				:== (toChar 16)		// TE
+//TypeTACode						:== (toChar 9)		// TA
+TypeTASCode						:== (toChar 10)		// TAS
+TypeArrowCode 					:== (toChar 11)		// -->
+TypeConsApplyCode				:== (toChar 12)		// :@:
+TypeTBCode						:== (toChar 13)		// TB
+TypeGTVCode						:== (toChar 14)		// GTV
+TypeTVCode						:== (toChar 15)		// TV
+TypeTQVCode						:== (toChar 16)		// TempTQV
+TypeTECode						:== (toChar 17)		// TE
 
 // Type; TB
-BT_IntCode				:== (toChar 17)	
-BT_CharCode				:== (toChar 18)
-BT_RealCode				:== (toChar 19)
-BT_BoolCode				:== (toChar 20)
-BT_DynamicCode			:== (toChar 21)
-BT_FileCode				:== (toChar 22)
-BT_WorldCode			:== (toChar 23)
-BT_StringCode			:== (toChar 24)
+BT_IntCode						:== (toChar 18)	
+BT_CharCode						:== (toChar 19)
+BT_RealCode						:== (toChar 20)
+BT_BoolCode						:== (toChar 21)
+BT_DynamicCode					:== (toChar 22)
+BT_FileCode						:== (toChar 23)
+BT_WorldCode					:== (toChar 24)
+BT_StringCode					:== (toChar 25)
 
 // ConsVariable	
-ConsVariableCVCode		:== (toChar 25)	
-ConsVariableTempCVCode	:== (toChar 26)
-ConsVariableTempQCVCode	:== (toChar 27)
+ConsVariableCVCode				:== (toChar 26)	
+ConsVariableTempCVCode			:== (toChar 27)
+ConsVariableTempQCVCode			:== (toChar 28)
 
 // TypeSymbIdent
-TypeSymbIdentWithoutDefinition	:== (toChar 28)		// valid only for predefined in PD_PredefinedModule e.g. _String, _List
-TypeSymbIdentWithDefinition		:== (toChar 29)		// for all types which have definitions in some .icl-module
+TypeSymbIdentWithoutDefinition	:== (toChar 29)		// valid only for predefined in PD_PredefinedModule e.g. _String, _List
+TypeSymbIdentWithDefinition		:== (toChar 30)		// for all types which have definitions in some .icl-module
 
 // Maybe
-MaybeNothingCode				:== (toChar 30)
-MaybeJustCode					:== (toChar 31)
+MaybeNothingCode				:== (toChar 31)
+MaybeJustCode					:== (toChar 32)
+
+// StrictnessList
+NotStrictCode					:== (toChar 33)
+StrictCode						:== (toChar 34)
+StrictListCode					:== (toChar 35)
 
 // used by {compiler,dynamic rts} to make String representation of types
 PredefinedModuleName			:== "_predefined"