aboutsummaryrefslogtreecommitdiff
path: root/frontend
diff options
context:
space:
mode:
Diffstat (limited to 'frontend')
-rw-r--r--frontend/convertDynamics.icl6
-rw-r--r--frontend/type_io.dcl1
-rw-r--r--frontend/type_io.icl60
-rw-r--r--frontend/type_io_common.dcl56
-rw-r--r--frontend/type_io_common.icl52
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"