aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--frontend/convertDynamics.icl2
-rw-r--r--frontend/type_io.dcl4
-rw-r--r--frontend/type_io.icl147
3 files changed, 127 insertions, 26 deletions
diff --git a/frontend/convertDynamics.icl b/frontend/convertDynamics.icl
index 495ec59..e67724d 100644
--- a/frontend/convertDynamics.icl
+++ b/frontend/convertDynamics.icl
@@ -50,6 +50,8 @@ pl [x:xs] = x +++ " , " +++ (pl xs)
F :: !a .b -> .b
F a b = b
+
+//write_tcl_file :: !Int {#DclModule} CommonDefs !*File [String] -> (.Bool,.File)
write_tcl_file :: !Int {#DclModule} CommonDefs !*File [String] -> (.Bool,.File)
write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_module} common_defs tcl_file directly_imported_dcl_modules
#! tcl_file
diff --git a/frontend/type_io.dcl b/frontend/type_io.dcl
index 8a84194..25e5aee 100644
--- a/frontend/type_io.dcl
+++ b/frontend/type_io.dcl
@@ -14,6 +14,10 @@ where
instance WriteTypeInfo CommonDefs, Char, [a] | WriteTypeInfo a
+/*2.0
+instance WriteTypeInfo String
+0.2*/
+
//1.3
instance WriteTypeInfo {#b} | select_u, size_u, WriteTypeInfo b
//3.1
diff --git a/frontend/type_io.icl b/frontend/type_io.icl
index 40908ea..7d1a56c 100644
--- a/frontend/type_io.icl
+++ b/frontend/type_io.icl
@@ -35,8 +35,13 @@ where
= AlgType (sortBy (\{ds_ident={id_name=id_name1}} {ds_ident={id_name=id_name2}} -> id_name1 < id_name2) defined_symbols)
normalise_type_def i
= i
-
+
+//1.3
instance NormaliseTypeDef TypeDef rhs | NormaliseTypeDef rhs
+//3.1
+/*2.0
+instance NormaliseTypeDef (TypeDef rhs) | NormaliseTypeDef rhs
+0.2*/
where
normalise_type_def type_def=:{td_args,td_arity}
= type_def
@@ -115,7 +120,12 @@ where
= fwritec NoAssocCode tcl_file
= tcl_file
+//1.3
instance WriteTypeInfo TypeDef TypeRhs
+//3.1
+/*2.0
+instance WriteTypeInfo (TypeDef TypeRhs)
+0.2*/
where
write_type_info /*{td_name,td_arity,td_args,td_rhs}*/ type_def tcl_file
# {td_name,td_arity,td_args,td_rhs}
@@ -152,9 +162,7 @@ instance WriteTypeInfo TypeVar
where
write_type_info {tv_name} tcl_file
// writing tv_name as number suffices
- | F ("TypeVar: " +++ tv_name.id_name) True
= write_type_info tv_name tcl_file
-
AlgTypeCode =: (toChar 5)
SynTypeCode =: (toChar 6)
@@ -208,7 +216,6 @@ where
# tcl_file
= fwritei (size id_name) tcl_file
= fwrites id_name tcl_file
-// = write_type_info id_name tcl_file;
instance WriteTypeInfo FieldSymbol
where
@@ -237,16 +244,13 @@ where
instance WriteTypeInfo AType
where
- write_type_info {/*at_attribute,*/ at_annotation,at_type} tcl_file
-// # tcl_file
-// = write_type_info at_attribute tcl_file
+ write_type_info {at_annotation,at_type} tcl_file
# tcl_file
= write_type_info at_annotation tcl_file
# tcl_file
= write_type_info at_type tcl_file
= tcl_file
-
TypeTACode =: (toChar 9) // TA
TypeArrowCode =: (toChar 10) // -->
TypeConsApplyCode =: (toChar 11) // :@:
@@ -310,8 +314,6 @@ where
# tcl_file
= write_type_info type tcl_file
-> tcl_file
- _
- -> abort "mismatch" ---> tb
= tcl_file
write_type_info (GTV type_var) tcl_file
@@ -376,6 +378,18 @@ where
# tcl_file
= write_type_info type_arity tcl_file
= tcl_file
+
+/*2.0
+instance WriteTypeInfo String
+where
+ write_type_info s tcl_file
+ # tcl_file
+ = fwritei (size s) tcl_file
+ = fwrites s tcl_file
+ // warning:
+ // Should be identical to the code in Ident
+
+0.2*/
// basic and structural write_type_info's
instance WriteTypeInfo Int
@@ -383,7 +397,12 @@ where
write_type_info i tcl_file
= fwritei i tcl_file
-instance WriteTypeInfo {#b} | select_u, size_u, WriteTypeInfo b
+//1.3
+instance WriteTypeInfo {#b} | select_u, size_u, WriteTypeInfo b
+//3.1
+/*2.0
+instance WriteTypeInfo {#b} | WriteTypeInfo b & Array {#} b
+0.2*/
where
write_type_info unboxed_array tcl_file
# s_unboxed_array
@@ -393,6 +412,7 @@ where
= write_type_info_loop 0 s_unboxed_array tcl_file
where
+
write_type_info_loop i limit tcl_file
| i == limit
= tcl_file
@@ -445,10 +465,14 @@ where
}
= (ok1&&ok2,common_defs,tcl_file)
+//1.3
instance ReadTypeInfo TypeDef TypeRhs
+//3.1
+/*2.0
+instance ReadTypeInfo (TypeDef a) | ReadTypeInfo a & DefaultElem a
+0.2*/
where
- read_type_info tcl_file
-
+ read_type_info tcl_file
// td_name
#! (ok1,td_name,tcl_file)
= read_type_info tcl_file
@@ -467,22 +491,26 @@ where
| not ok2
= (False,default_elem,tcl_file)
+
// td_rhs
#! (ok2,td_rhs,tcl_file)
= read_type_info tcl_file
| not ok2
= (False,default_elem,tcl_file)
+
# type_def
- = { default_elem &
+ = updateTypeDefRhs { default_elem &
td_name = td_name
, td_arity = td_arity
, td_args = td_args
- , td_rhs = td_rhs
- }
-
+ } td_rhs
= (ok1,type_def,tcl_file)
+updateTypeDefRhs :: (TypeDef a) a -> (TypeDef a)
+updateTypeDefRhs type_def rhs
+ = {type_def & td_rhs = rhs}
+
instance ReadTypeInfo TypeRhs
where
read_type_info tcl_file
@@ -695,7 +723,6 @@ where
}
= (ok1&&ok2&&ok3,field_symbol,tcl_file)
-/*
instance ReadTypeInfo SymbolType
where
read_type_info tcl_file
@@ -800,12 +827,27 @@ where
| c == TypeTECode
= (True,TE,tcl_file)
-//instance ReadTypeInfo ConsVariable
-//where
-
- */
-
+instance ReadTypeInfo ConsVariable
+where
+ read_type_info tcl_file
+ = abort "instance ReadTypeInfo ConsVariable"
+instance ReadTypeInfo TypeSymbIdent
+where
+ read_type_info tcl_file
+ # (ok1,type_name,tcl_file)
+ = read_type_info tcl_file
+ # (ok2,type_arity,tcl_file)
+ = read_type_info tcl_file
+
+ # type_symb_ident
+ = { default_elem &
+ type_name = type_name
+ , type_arity = type_arity
+ }
+
+ = (ok1&&ok2,type_symb_ident,tcl_file)
+
// basic and structural write_type_info's
instance ReadTypeInfo Int
where
@@ -813,7 +855,12 @@ where
read_type_info tcl_file
= freadi tcl_file
+//1.3
instance ReadTypeInfo {#b} | ReadTypeInfo b & DefaultElem b & ArrayElem b
+//3.1
+/*2.0
+instance ReadTypeInfo {#b} | ReadTypeInfo b & DefaultElem b & Array {#} b
+0.2*/
where
read_type_info tcl_file
@@ -864,7 +911,12 @@ class DefaultElem a
where
default_elem :: a
+//1.3
instance DefaultElem (TypeDef TypeRhs)
+//3.1
+/*2.0
+instance DefaultElem (TypeDef a) | DefaultElem a
+0.2*/
where
default_elem
= { TypeDef |
@@ -948,7 +1000,7 @@ where
instance DefaultElem Int
where
default_elem
- = 0 //abort "instance DefaultElem Int"
+ = 0
instance DefaultElem DefinedSymbol
where
@@ -1039,9 +1091,52 @@ where
, fs_index = default_elem
}
+//1.3
instance DefaultElem {#a} | ArrayElem, DefaultElem a
+//3.1
+/*2.0
+instance DefaultElem {#a} | Array {#} a & DefaultElem a
+0.2*/
where
default_elem
= {default_elem}
-
-
+
+instance DefaultElem TypeSymbIdent
+where
+ default_elem
+ = { TypeSymbIdent |
+ type_name = default_elem
+ , type_arity = default_elem
+ , type_index = default_elem
+ , type_prop = default_elem
+ }
+
+instance DefaultElem TypeSymbProperties
+where
+ default_elem
+ = { TypeSymbProperties |
+ tsp_sign = default_elem
+ , tsp_propagation = default_elem
+ , tsp_coercible = default_elem
+ }
+
+instance DefaultElem (Global a) | DefaultElem a
+where
+ default_elem
+ = { Global |
+ glob_object = default_elem
+ , glob_module = default_elem
+ }
+
+instance DefaultElem Bool
+where
+ default_elem
+ = False
+
+instance DefaultElem SignClassification
+where
+ default_elem
+ = { SignClassification |
+ sc_pos_vect = default_elem
+ , sc_neg_vect = default_elem
+ }
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-06 12:05:05 +0000