Skip to content
GitLab
Commit 484c43f9 authored by Martijn Vervoort's avatar Martijn Vervoort
Browse files

changes: 

- module type_io_common added for communication with linkers
- minor change to convertDynamics w.r.t writing a tcl-file

stderr annoyance should be fixed
parent 7a3e3a39
Hide whitespace changes
Inline Side-by-side
frontend/convertDynamics.icl
View file @ 484c43f9
......@@ -60,6 +60,8 @@ write_tcl_file main_dcl_module_n dcl_mods=:{[main_dcl_module_n] = main_dcl_modul
= write_type_info directly_imported_dcl_modules tcl_file
#! 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
= (True,tcl_file)
//---> ("dcl",size main_dcl_module.dcl_common.com_type_defs, "icl", size common_defs.com_type_defs);
......
frontend/type_io.dcl
View file @ 484c43f9
......@@ -22,10 +22,3 @@ instance WriteTypeInfo String
instance WriteTypeInfo {#b} | select_u, size_u, WriteTypeInfo b
//3.1
// read
// read
class ReadTypeInfo a
where
read_type_info :: !*File -> (!Bool,a,!*File)
instance ReadTypeInfo CommonDefs //,TypeDef TypeRhs, ConsDef
frontend/type_io.icl
View file @ 484c43f9
......@@ -7,6 +7,7 @@ implementation module type_io
import StdEnv, compare_constructor
import scanner, general, Heap, typeproperties, utilities, checksupport
import type_io_common
// normal form:
// - type variables in type definitions are normalized by checkTypeDef in the
// module checktypes.icl. The position of a type variable in the left-hand
......@@ -81,9 +82,6 @@ where
= tcl_file
PrioCode =: toChar 0
NoPrioCode =: toChar 1
instance WriteTypeInfo Priority
where
write_type_info (Prio assoc i) tcl_file
......@@ -99,10 +97,6 @@ where
= fwritec NoPrioCode tcl_file
= tcl_file
LeftAssocCode =: toChar 2
RightAssocCode =: toChar 3
NoAssocCode =: toChar 4
instance WriteTypeInfo Assoc
where
write_type_info LeftAssoc tcl_file
......@@ -164,11 +158,6 @@ where
// writing tv_name as number suffices
= write_type_info tv_name tcl_file
AlgTypeCode =: (toChar 5)
SynTypeCode =: (toChar 6)
RecordTypeCode =: (toChar 7)
AbstractTypeCode =: (toChar 8)
instance WriteTypeInfo TypeRhs
where
write_type_info (AlgType defined_symbols) tcl_file
......@@ -250,25 +239,7 @@ where
# tcl_file
= write_type_info at_type tcl_file
= tcl_file
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
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)
instance WriteTypeInfo Type
where
write_type_info (TA type_symb_ident atypes) tcl_file
......@@ -341,11 +312,6 @@ where
# tcl_file
= fwritec TypeTECode tcl_file
= tcl_file
ConsVariableCVCode =: (toChar 25)
ConsVariableTempCVCode =: (toChar 26)
ConsVariableTempQCVCode =: (toChar 27)
instance WriteTypeInfo ConsVariable
where
......@@ -440,704 +406,3 @@ where
# tcl_file
= fwritec c tcl_file;
= tcl_file;
// read
class ReadTypeInfo a
where
read_type_info :: !*File -> (!Bool,a,!*File)
instance ReadTypeInfo CommonDefs
where
read_type_info tcl_file
# (ok1,com_type_defs,tcl_file)
= read_type_info tcl_file
# (ok2,com_cons_defs,tcl_file)
= read_type_info tcl_file
# common_defs
= { CommonDefs |
com_type_defs = com_type_defs
, com_cons_defs = com_cons_defs
, com_selector_defs = {}
, com_class_defs = {}
, com_member_defs = {}
, com_instance_defs = {}
, com_generic_defs = {}
}
= (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
// td_name
#! (ok1,td_name,tcl_file)
= read_type_info tcl_file
| F ("TypeDef '" +++ td_name.id_name +++ "'") not ok1
= (False,default_elem,tcl_file)
// td_arity
#! (ok2,td_arity,tcl_file)
= read_type_info tcl_file
| not ok2
= (False,default_elem,tcl_file)
// td_args
#! (ok2,td_args,tcl_file)
= read_type_info tcl_file
| 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
= updateTypeDefRhs { default_elem &
td_name = td_name
, td_arity = td_arity
, td_args = td_args
} 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
# (ok1,c,tcl_file)
= freadc tcl_file
| not ok1
= (False,default_elem,tcl_file)
| c == AlgTypeCode
# (ok,defined_symbols,tcl_file)
= read_type_info tcl_file
= (ok,AlgType defined_symbols,tcl_file)
| c == SynTypeCode
= (True,UnknownType,tcl_file)
| c == RecordTypeCode
# (ok,rt_fields,tcl_file)
= read_type_info tcl_file
# record_type
= { default_elem &
rt_fields = rt_fields
};
= (True,RecordType record_type,tcl_file)
| c == AbstractTypeCode
= (True,UnknownType,tcl_file)
instance ReadTypeInfo Priority
where
read_type_info tcl_file
# (ok1,p,tcl_file)
= freadc tcl_file
| not ok1
= (False,default_elem,tcl_file)
| p == PrioCode
# (ok1,assoc,tcl_file)
= read_type_info tcl_file
# (ok2,i,tcl_file)
= read_type_info tcl_file
# prio
= Prio assoc i
= (ok1&&ok2,prio,tcl_file)
| p == NoPrioCode
= (ok1,NoPrio,tcl_file)
instance ReadTypeInfo Assoc
where
read_type_info tcl_file
# (ok1,a,tcl_file)
= freadc tcl_file
| not ok1
= (False,default_elem,tcl_file)
| a == LeftAssocCode
= (ok1,LeftAssoc,tcl_file)
| a == RightAssocCode
= (ok1,RightAssoc,tcl_file)
| a == NoAssocCode
= (ok1,NoAssoc,tcl_file)
instance ReadTypeInfo DefinedSymbol
where
read_type_info tcl_file
// ds_ident
# (ok1,ds_ident,tcl_file)
= read_type_info tcl_file
| not ok1
= (False,default_elem,tcl_file)
// ds_arity
# (ok2,ds_arity,tcl_file)
= read_type_info tcl_file
| not ok2
= (False,default_elem,tcl_file)
// ds_index
# (ok3,ds_index,tcl_file)
= read_type_info tcl_file
# defined_symbol
= { default_elem &
ds_ident = ds_ident
, ds_arity = ds_arity
, ds_index = ds_index
}
= (ok3,defined_symbol,tcl_file)
instance ReadTypeInfo ConsDef
where
read_type_info tcl_file
# (ok1,cons_symb,tcl_file)
= read_type_info tcl_file
ok2 = True
cons_type = undef
// # (ok2,cons_type,tcl_file)
// = read_type_info tcl_file
# (ok3,cons_arg_vars,tcl_file)
= read_type_info tcl_file
# (ok4,cons_priority,tcl_file)
= read_type_info tcl_file
# (ok5,cons_index,tcl_file)
= read_type_info tcl_file
# (ok6,cons_type_index,tcl_file)
= read_type_info tcl_file
# (ok7,cons_exi_vars,tcl_file)
= read_type_info tcl_file
# consdef
= { default_elem &
cons_symb = cons_symb
, cons_type = cons_type
, cons_arg_vars = cons_arg_vars
, cons_priority = cons_priority
, cons_index = cons_index
, cons_type_index = cons_type_index
, cons_exi_vars = cons_exi_vars
}
= (ok1&&ok2&&ok3&&ok4&&ok5&&ok6&&ok7,consdef,tcl_file)
instance ReadTypeInfo Char
where
read_type_info :: !*File -> (!Bool,Char,!*File)
read_type_info tcl_file
= freadc tcl_file
instance ReadTypeInfo Ident
where
read_type_info :: !*File -> (!Bool,Ident,!*File)
read_type_info tcl_file
# (ok1,i,tcl_file)
= freadi tcl_file
# (id_name,tcl_file)
= freads tcl_file i;
| F ("Ident " +++ toString i +++ " - " +++ id_name) True
# ident
= { default_elem &
id_name = id_name
, id_info = nilPtr
}
= (ok1,ident,tcl_file)
instance ReadTypeInfo ATypeVar
where
read_type_info tcl_file
// atv_annotation
# (ok1,atv_annotation,tcl_file)
= read_type_info tcl_file
| not ok1
= (False,default_elem,tcl_file)
// atv_variable
# (ok2,atv_variable,tcl_file)
= read_type_info tcl_file
| not ok2
= (False,default_elem,tcl_file)
# atypevar
= { default_elem &
atv_annotation = atv_annotation
, atv_variable = atv_variable
}
= (True,atypevar,tcl_file)
instance ReadTypeInfo TypeVar
where
read_type_info tcl_file
# (ok1,tv_name,tcl_file)
= read_type_info tcl_file
# typevar
= { default_elem &
tv_name = tv_name
}
= (ok1,typevar,tcl_file)
instance ReadTypeInfo Annotation
where
read_type_info tcl_file
#! (ok1,c,tcl_file)
= freadc tcl_file
# annotation
= if (c == '!') AN_Strict AN_None
= (ok1,annotation,tcl_file)
instance ReadTypeInfo FieldSymbol
where
read_type_info tcl_file
# (ok1,fs_name,tcl_file)
= read_type_info tcl_file
# (ok2,fs_var,tcl_file)
= read_type_info tcl_file
# (ok3,fs_index,tcl_file)
= read_type_info tcl_file
# field_symbol
= { FieldSymbol |
fs_name = fs_name
, fs_var = fs_var
, fs_index = fs_index
}
= (ok1&&ok2&&ok3,field_symbol,tcl_file)
instance ReadTypeInfo SymbolType
where
read_type_info tcl_file
# (ok1,st_vars,tcl_file)
= read_type_info tcl_file
# (ok2,st_args,tcl_file)
= read_type_info tcl_file
# (ok3,st_arity,tcl_file)
= read_type_info tcl_file
# (ok4,st_result,tcl_file)
= read_type_info tcl_file
# symbol_type
= { default_elem &
st_vars = st_vars
, st_args = st_args
, st_arity = st_arity
, st_result = st_result
}
= (ok1&&ok2&&ok3&&ok4,symbol_type,tcl_file)
instance ReadTypeInfo AType
where
read_type_info tcl_file
# (ok1,at_annotation,tcl_file)
= read_type_info tcl_file
# (ok2,at_type,tcl_file)
= read_type_info tcl_file
# atype
= { default_elem &
at_annotation = at_annotation
, at_type = at_type
}
= (ok1&&ok2,atype,tcl_file)
instance ReadTypeInfo Type
where
read_type_info tcl_file
# (ok,c,tcl_file)
= freadc tcl_file
| not ok
= (False,default_elem,tcl_file)
| c == TypeTACode
# (ok1,type_symb_ident,tcl_file)
= read_type_info tcl_file
# (ok2,atypes,tcl_file)
= read_type_info tcl_file
= (ok1&&ok2,TA type_symb_ident atypes,tcl_file)
| c == TypeArrowCode
# (ok1,atype1,tcl_file)
= read_type_info tcl_file
# (ok2,atype2,tcl_file)
= read_type_info tcl_file
= (ok1&&ok2,atype1 --> atype2,tcl_file)
| c == TypeConsApplyCode
# (ok1,cons_variable,tcl_file)
= read_type_info tcl_file
# (ok2,atypes,tcl_file)
= read_type_info tcl_file
= (ok1&&ok2,cons_variable :@: atypes,tcl_file)
// TB BasicType
| c == BT_IntCode
= (True,TB BT_Int,tcl_file);
| c == BT_CharCode
= (True,TB BT_Char,tcl_file);
| c == BT_RealCode
= (True,TB BT_Real,tcl_file);
| c == BT_BoolCode
= (True,TB BT_Bool,tcl_file);
| c == BT_DynamicCode
= (True,TB BT_Dynamic,tcl_file);
| c == BT_FileCode
= (True,TB BT_File,tcl_file);
| c == BT_WorldCode
= (True,TB BT_World,tcl_file);
| c == BT_StringCode
# (ok,type,tcl_file)
= read_type_info tcl_file
= (ok,TB (BT_String type),tcl_file);
| c == TypeGTVCode
# (ok,type_var,tcl_file)
= read_type_info tcl_file
= (ok,GTV type_var,tcl_file);
| c == TypeTVCode
# (ok,type_var,tcl_file)
= read_type_info tcl_file
= (ok,TV type_var,tcl_file)
| c == TypeTQVCode
# (ok,type_var,tcl_file)
= read_type_info tcl_file
= (ok,TQV type_var,tcl_file)
| c == TypeTECode
= (True,TE,tcl_file)
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
read_type_info :: !*File -> (!Bool,Int,!*File)
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
# (ok,s_unboxed_array,tcl_file)
= freadi tcl_file
| F ("s_unboxed_array: " +++ toString s_unboxed_array) not ok
= (False,{default_elem},tcl_file)
# unboxed_array
= { default_elem \\ i <- [1..s_unboxed_array] }
= read_type_info_loop 0 s_unboxed_array tcl_file unboxed_array
where
read_type_info_loop i limit tcl_file unboxed_array
| F (" " +++ toString i) i == limit
= (True,unboxed_array,tcl_file)
# (ok,elem,tcl_file)
= read_type_info tcl_file
| not ok
= (False,unboxed_array,tcl_file)
= read_type_info_loop (inc i) limit tcl_file {unboxed_array & [i] = elem}
instance ReadTypeInfo [a] | ReadTypeInfo a
where
read_type_info tcl_file
# (ok1,limit,tcl_file)
= freadi tcl_file
| not ok1
= (False,[],tcl_file)
= read_type_info_loop 0 limit tcl_file []
where
read_type_info_loop i limit tcl_file elems
| i == limit
= (True,reverse elems,tcl_file)
# (ok,elem,tcl_file)
= read_type_info tcl_file
| not ok
= (False,[],tcl_file)
= read_type_info_loop (inc i) limit tcl_file [elem:elems]
// defaults
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 |
td_name = default_elem
, td_index = default_elem
, td_arity = default_elem
, td_args = default_elem
, td_attrs = default_elem
, td_context = default_elem
, td_rhs = default_elem
, td_attribute = default_elem
, td_pos = default_elem
}
instance DefaultElem Position
where
default_elem
= NoPos
instance DefaultElem TypeAttribute
where
default_elem
= TA_None
instance DefaultElem TypeRhs
where
default_elem