implementation module predef
import syntax, hashtable
:: PredefinedSymbols :== {# PredefinedSymbol}
:: PredefinedSymbol =
{ pds_ident :: !Ident
, pds_module :: !Index
, pds_def :: !Index
}
/* identifiers not present the hastable */
PD_PredefinedModule :== 0
PD_StringType :== 1
PD_ListType :== 2
PD_Arity2TupleType :== 3
PD_Arity32TupleType :== 33
PD_LazyArrayType :== 34
PD_StrictArrayType :== 35
PD_UnboxedArrayType :== 36
PD_ConsSymbol :== 37
PD_NilSymbol :== 38
PD_Arity2TupleSymbol :== 39
PD_Arity32TupleSymbol :== 69
PD_TypeVar_a0 :== 70
PD_TypeVar_a31 :== 101
/* Dynamics */
PD_TypeCodeMember :== 102
// MV ...
PD_DynamicTemp :== 103
PD_DynamicValue :== 104
PD_DynamicType :== 105
// ... MV
/* identifiers present in the hastable */
PD_StdArray :== 106
PD_StdEnum :== 107
PD_StdBool :== 108
PD_AndOp :== 109
PD_OrOp :== 110
/* Array functions */
PD_ArrayClass :== 111
PD_CreateArrayFun :== 112
PD__CreateArrayFun :== 113
PD_ArraySelectFun :== 114
PD_UnqArraySelectFun :== 115
PD_ArrayUpdateFun :== 116
PD_ArrayReplaceFun :== 117
PD_ArraySizeFun :== 118
PD_UnqArraySizeFun :== 119
/* Enum/Comprehension functions */
PD_SmallerFun :== 120
PD_LessOrEqualFun:== 121
PD_SubFun:==122
PD_IncFun :== 123
PD_From :== 124
PD_FromThen :== 125
PD_FromTo :== 126
PD_FromThenTo :== 127
/* Dynamics */
PD_TypeCodeClass :== 128
PD_TypeObjectType :== 129
PD_TypeConsSymbol :== 130
PD_unify :== 131
// MV ..
PD_coerce :== 132
PD_variablePlaceholder :== 133
PD_StdDynamics :== 134
PD_undo_indirections :== 135
// MV ...
//PD_ModuleType :== 136
PD_ModuleConsSymbol :== 137
// ... MV
/* Generics */
PD_StdGeneric :== 138
PD_TypeISO :== 139
PD_ConsISO :== 140
PD_iso_to :== 141
PD_iso_from :== 142
PD_TypeUNIT :== 143
PD_ConsUNIT :== 144
PD_TypeEITHER :== 145
PD_ConsLEFT :== 146
PD_ConsRIGHT :== 147
PD_TypePAIR :== 148
PD_ConsPAIR :== 149
PD_TypeARROW :== 150
PD_ConsARROW :== 151
PD_TypeConsDefInfo :== 152
PD_ConsConsDefInfo :== 153
PD_TypeTypeDefInfo :== 154
PD_ConsTypeDefInfo :== 155
PD_cons_info :== 156
PD_TypeCONS :== 157
PD_ConsCONS :== 158
PD_isomap_ARROW_ :== 159
PD_isomap_ID :== 160
/* StdMisc */
PD_StdMisc :== 161
PD_abort :== 162
PD_undef :== 163
PD_Start :== 164
PD_DummyForStrictAliasFun :== 165
PD_NrOfPredefSymbols :== 166
(<<=) infixl
(<<=) state val
:== let (array, symbol_table) = state
(name, index) = val
(id_info, new_symbol_table) = newPtr EmptySymbolTableEntry symbol_table
in ({ array & [index] = { pds_ident = { id_name = name, id_info = id_info }, pds_module = NoIndex, pds_def = NoIndex } }, new_symbol_table)
(<<-) infixl
(<<-) (array, hash_table) (name, table_kind, index)
// # (id, hash_table) = putIdentInHashTable name table_kind hash_table
# ({boxed_ident=id}, hash_table) = putIdentInHashTable name table_kind hash_table
= ({ array & [index] = { pds_ident = id, pds_module = NoIndex, pds_def = NoIndex } }, hash_table)
GetTupleConsIndex tup_arity :== PD_Arity2TupleSymbol + tup_arity - 2
GetTupleTypeIndex tup_arity :== PD_Arity2TupleType + tup_arity - 2
buildPredefinedSymbols :: !*HashTable -> (!.PredefinedSymbols,!*HashTable)
buildPredefinedSymbols hash_table=:{hte_symbol_heap}
# predef_symbol_table = createArray PD_NrOfPredefSymbols { pds_ident = { id_name = "", id_info = nilPtr }, pds_module = NoIndex, pds_def = NoIndex }
(predef_symbol_table, hte_symbol_heap) = fill_table_without_hashing (predef_symbol_table, hte_symbol_heap)
= fill_table_with_hashing (predef_symbol_table, { hash_table & hte_symbol_heap = hte_symbol_heap })
where
fill_table_without_hashing tables
= build_variables 0 32 (build_tuples 2 32 tables)
<<= ("_predefined", PD_PredefinedModule)
<<= ("_string", PD_StringType)
<<= ("_list", PD_ListType) <<= ("_cons", PD_ConsSymbol) <<= ("_nil", PD_NilSymbol)
<<= ("_array", PD_LazyArrayType) <<= ("_!array", PD_StrictArrayType) <<= ("_#array", PD_UnboxedArrayType)
<<= ("_type_code", PD_TypeCodeMember)
<<= ("_dummyForStrictAlias", PD_DummyForStrictAliasFun) // MW++
where
build_tuples tup_arity max_arity tables
| tup_arity > max_arity
= tables
# tup_name = "_tuple" +++ toString tup_arity
= build_tuples (inc tup_arity) max_arity (tables <<= (tup_name, GetTupleTypeIndex tup_arity)
<<= (tup_name, GetTupleConsIndex tup_arity))
build_variables var_number max_arity tables
| var_number == max_arity
= tables
# var_name = "a" +++ toString var_number
= build_variables (inc var_number) max_arity (tables <<= (var_name, PD_TypeVar_a0 + var_number))
fill_table_with_hashing tables
# (predefs, hash_table) = tables
<<- ("StdArray", IC_Module, PD_StdArray) <<- ("StdEnum", IC_Module, PD_StdEnum) <<- ("StdBool", IC_Module, PD_StdBool)
<<- ("&&", IC_Expression, PD_AndOp) <<- ("||", IC_Expression, PD_OrOp)
<<- ("Array", IC_Class, PD_ArrayClass)
<<- ("createArray", IC_Expression, PD_CreateArrayFun)
<<- ("_createArray", IC_Expression, PD__CreateArrayFun)
<<- ("select", IC_Expression, PD_ArraySelectFun)
<<- ("uselect", IC_Expression, PD_UnqArraySelectFun) <<- ("update", IC_Expression, PD_ArrayUpdateFun)
<<- ("replace", IC_Expression, PD_ArrayReplaceFun) <<- ("size", IC_Expression, PD_ArraySizeFun)
<<- ("usize", IC_Expression, PD_UnqArraySizeFun)
// RWS ... <<- ("_smaller", IC_Expression, PD_SmallerFun) <<- ("_inc", IC_Expression, PD_IncFun)
<<- ("<", IC_Expression, PD_SmallerFun) <<- ("<=", IC_Expression, PD_LessOrEqualFun)
<<- ("-", IC_Expression, PD_SubFun) <<- ("inc", IC_Expression, PD_IncFun)
// ... RWS
<<- ("_from", IC_Expression, PD_From) <<- ("_from_then", IC_Expression, PD_FromThen)
<<- ("_from_to", IC_Expression, PD_FromTo) <<- ("_from_then_to", IC_Expression, PD_FromThenTo)
<<- ("TC", IC_Class, PD_TypeCodeClass)
<<- ("T_ypeObjectType", IC_Type, PD_TypeObjectType)
<<- ("T_ypeConsSymbol", IC_Expression, PD_TypeConsSymbol)
<<- ("P_laceholder", IC_Expression, PD_variablePlaceholder)
<<- ("_unify", IC_Expression, PD_unify)
<<- ("_coerce", IC_Expression, PD_coerce) /* MV */
<<- ("StdDynamic", IC_Module, PD_StdDynamics)
<<- ("_undo_indirections", IC_Expression, PD_undo_indirections)
// MV..
<<- ("DynamicTemp", IC_Type, PD_DynamicTemp)
// <<- ("Module", IC_Type, PD_ModuleType)
<<- ("__Module", IC_Expression, PD_ModuleConsSymbol)
// ..MV
// AA..
<<- ("StdGeneric", IC_Module, PD_StdGeneric)
<<- ("ISO", IC_Type, PD_TypeISO)
<<- ("_ISO", IC_Expression, PD_ConsISO)
//<<- ("iso_from", IC_Field {id_name="", id_info=nilPtr}, PD_iso_from)
//<<- ("iso_to", IC_Field {id_name="", id_info=nilPtr}, PD_iso_to)
<<- ("UNIT", IC_Type, PD_TypeUNIT)
<<- ("UNIT", IC_Expression, PD_ConsUNIT)
<<- ("EITHER", IC_Type, PD_TypeEITHER)
<<- ("LEFT", IC_Expression, PD_ConsLEFT)
<<- ("RIGHT", IC_Expression, PD_ConsRIGHT)
<<- ("PAIR", IC_Type, PD_TypePAIR)
<<- ("PAIR", IC_Expression, PD_ConsPAIR)
<<- ("ARROW", IC_Type, PD_TypeARROW)
<<- ("ARROW", IC_Expression, PD_ConsARROW)
<<- ("isomap_ARROW_", IC_Expression, PD_isomap_ARROW_)
<<- ("isomap_ID", IC_Expression, PD_isomap_ID)
<<- ("ConsDefInfo", IC_Type, PD_TypeConsDefInfo)
<<- ("_ConsDefInfo", IC_Expression, PD_ConsConsDefInfo)
<<- ("TypeDefInfo", IC_Type, PD_TypeTypeDefInfo)
<<- ("_TypeDefInfo", IC_Expression, PD_ConsTypeDefInfo)
<<- ("CONS", IC_Type, PD_TypeCONS)
<<- ("CONS", IC_Expression, PD_ConsCONS)
<<- ("_cons_info", IC_Expression, PD_cons_info)
<<- ("StdMisc", IC_Module, PD_StdMisc)
<<- ("abort", IC_Expression, PD_abort)
<<- ("undef", IC_Expression, PD_undef)
// ..AA
<<- ("Start", IC_Expression, PD_Start)
# ({pds_ident}, predefs) = predefs![PD_TypeISO]
# (predefs, hash_table)= (predefs, hash_table)
<<- ("iso_from", IC_Field pds_ident, PD_iso_from)
<<- ("iso_to", IC_Field pds_ident, PD_iso_to)
# ({pds_ident}, predefs) = predefs![PD_DynamicTemp]
# (predefs, hash_table)= (predefs, hash_table)
<<- ("type", IC_Field pds_ident, PD_DynamicType)
<<- ("value", IC_Field pds_ident, PD_DynamicValue)
<<- ("Start", IC_Expression, PD_Start)
= (predefs, hash_table)
MakeTupleConsSymbIndex arity :== arity - 2 + cArity2TupleConsSymbIndex
MakeTupleTypeSymbIndex arity :== arity - 2 + cArity2TupleTypeSymbIndex
MakeNilExpression pre_def_symbols :== PE_List [PE_Ident pre_def_symbols.[PD_NilSymbol]]
MakeConsExpression a1 a2 pre_def_symbols :== PE_List [PE_Ident pre_def_symbols.[PD_ConsSymbol], a1, a2]
MaxTupleArity :== 32
cLazyArray :== 0
cStrictArray :== 1
cUnboxedArray :== 2
cConsSymbIndex :== 0
cNilSymbIndex :== 1
cArity2TupleConsSymbIndex :== 2
//Arity32TupleConsSymbIndex :== 32
cListTypeSymbIndex :== 0
cArity2TupleTypeSymbIndex :== 1
//Arity32TupleTypeSymbIndex :== 31
cLazyArraySymbIndex :== 32
cStrictArraySymbIndex :== 33
cUnboxedArraySymbIndex :== 34
cLastPredefinedConstructor :== 32
cLastPredefinedType :== 34
cTCClassSymbIndex :== 0
cTCMemberSymbIndex :== 0
cTCInstanceSymbIndex :== 0
buildPredefinedModule :: !*PredefinedSymbols -> (!ScannedModule, !.PredefinedSymbols)
buildPredefinedModule pre_def_symbols
# (type_var_id, pre_def_symbols) = pre_def_symbols![PD_TypeVar_a0]
(cons_id, pre_def_symbols) = pre_def_symbols![PD_ConsSymbol]
(nil_id, pre_def_symbols) = pre_def_symbols![PD_NilSymbol]
(string_id, pre_def_symbols) = pre_def_symbols![PD_StringType]
(list_id, pre_def_symbols) = pre_def_symbols![PD_ListType]
(unb_array_id, pre_def_symbols) = pre_def_symbols![PD_UnboxedArrayType]
(pre_mod_symb, pre_def_symbols) = pre_def_symbols![PD_PredefinedModule]
(alias_dummy_symb, pre_def_symbols) = pre_def_symbols![PD_DummyForStrictAliasFun] // MW++
(cons_symb, pre_def_symbols) = new_defined_symbol PD_ConsSymbol 2 cConsSymbIndex pre_def_symbols
(nil_symb, pre_def_symbols) = new_defined_symbol PD_NilSymbol 0 cNilSymbIndex pre_def_symbols
pre_mod_id = pre_mod_symb.pds_ident
type_var = MakeTypeVar type_var_id.pds_ident
type_var_with_attr = MakeAttributedType (TV type_var)
list_type = MakeAttributedType (TA (MakeNewTypeSymbIdent list_id.pds_ident 1) [type_var_with_attr])
unb_arr_of_char_type = MakeAttributedType (TA (MakeNewTypeSymbIdent unb_array_id.pds_ident 1) [MakeAttributedType (TB BT_Char)])
(string_def, pre_def_symbols) = make_type_def PD_StringType [] (SynType unb_arr_of_char_type) pre_def_symbols
(list_def, pre_def_symbols) = make_type_def PD_ListType [type_var] (AlgType [cons_symb,nil_symb]) pre_def_symbols
cons_def = { pc_cons_name = cons_id.pds_ident, pc_cons_arity = 2, pc_arg_types = [type_var_with_attr, list_type],
pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
nil_def = { pc_cons_name = nil_id.pds_ident, pc_cons_arity = 0, pc_arg_types = [],
pc_cons_prio = NoPrio, pc_exi_vars = [], pc_cons_pos = PreDefPos pre_mod_id}
(array_def, pre_def_symbols) = make_type_def PD_LazyArrayType [type_var] (AbstractType cAllBitsClear) pre_def_symbols
(strict_def, pre_def_symbols) = make_type_def PD_StrictArrayType [type_var] (AbstractType cIsHyperStrict) pre_def_symbols
(unboxed_def, pre_def_symbols) = make_type_def PD_UnboxedArrayType [type_var] (AbstractType cIsHyperStrict) pre_def_symbols
(type_defs, cons_defs, pre_def_symbols) = add_tuple_defs pre_mod_id MaxTupleArity [array_def,strict_def,unboxed_def] [] pre_def_symbols
alias_dummy_type = make_identity_fun_type alias_dummy_symb.pds_ident type_var // MW++
(class_def, member_def, pre_def_symbols) = make_TC_class_def pre_def_symbols
= ({ mod_name = pre_mod_id, mod_type = MK_System, mod_imports = [], mod_imported_objects = [],
mod_defs = {
def_types = [string_def, list_def : type_defs], def_constructors
= [ParsedConstructorToConsDef cons_def, ParsedConstructorToConsDef nil_def : cons_defs], def_selectors = [], def_classes = [class_def],
def_macros = { ir_from = 0, ir_to = 0 }, def_members = [member_def], def_funtypes = [alias_dummy_type], def_instances = [], /* AA */ def_generics = [] }}, pre_def_symbols)
where
add_tuple_defs pre_mod_id tup_arity type_defs cons_defs pre_def_symbols
| tup_arity >= 2
# (type_vars, pre_def_symbols) = make_type_vars tup_arity [] pre_def_symbols
(tuple_id, pre_def_symbols) = pre_def_symbols![GetTupleConsIndex tup_arity]
tuple_cons_symb = { ds_ident = tuple_id.pds_ident, ds_index = MakeTupleConsSymbIndex tup_arity, ds_arity = tup_arity }
(tuple_type_def, pre_def_symbols) = make_type_def (GetTupleTypeIndex tup_arity) type_vars (AlgType [tuple_cons_symb]) pre_def_symbols
tuple_cons_def = { pc_cons_name = tuple_id.pds_ident, pc_cons_arity = tup_arity, pc_cons_pos = PreDefPos pre_mod_id,
pc_arg_types = [ MakeAttributedType (TV tv) \\ tv <- type_vars], pc_cons_prio = NoPrio, pc_exi_vars = []}
= add_tuple_defs pre_mod_id (dec tup_arity) [tuple_type_def : type_defs] [ParsedConstructorToConsDef tuple_cons_def : cons_defs] pre_def_symbols
= (type_defs, cons_defs, pre_def_symbols)
where
make_type_vars nr_of_vars type_vars pre_def_symbols
| nr_of_vars == 0
= (type_vars, pre_def_symbols)
# nr_of_vars = dec nr_of_vars
# (var_id, pre_def_symbols) = pre_def_symbols![PD_TypeVar_a0 + nr_of_vars]
= make_type_vars nr_of_vars [MakeTypeVar var_id.pds_ident : type_vars] pre_def_symbols
new_defined_symbol symbol_index arity ds_index pre_def_symbols
# (ds_ident, pre_def_symbols) = pre_def_symbols![symbol_index]
= ({ ds_ident = ds_ident.pds_ident, ds_arity = arity/*AA: was 2*/, ds_index = ds_index }, pre_def_symbols)
make_type_def type_cons_index type_vars type_rhs pre_def_symbols
# (type_ident, pre_def_symbols) = pre_def_symbols![type_cons_index]
= (MakeTypeDef type_ident.pds_ident (map (\tv -> MakeAttributedTypeVar tv) type_vars) type_rhs TA_None [] NoPos, pre_def_symbols)
make_TC_class_def pre_def_symbols
# (tc_class_name, pre_def_symbols) = pre_def_symbols![PD_TypeCodeClass]
(type_var_id, pre_def_symbols) = pre_def_symbols![PD_TypeVar_a0]
(tc_member_name, pre_def_symbols) = pre_def_symbols![PD_TypeCodeMember]
class_var = MakeTypeVar type_var_id.pds_ident
me_type = { st_vars = [], st_args = [], st_arity = 0,
st_result = { at_attribute = TA_None, at_annotation = AN_None, at_type = TV class_var },
st_context = [ {tc_class = {glob_module = NoIndex, glob_object = {ds_ident = tc_class_name.pds_ident, ds_arity = 1, ds_index = NoIndex }},
tc_types = [ TV class_var ], tc_var = nilPtr }],
st_attr_vars = [], st_attr_env = [] }
member_def = { me_symb = tc_member_name.pds_ident, me_type = me_type, me_pos = NoPos, me_priority = NoPrio,
me_offset = NoIndex, me_class_vars = [], me_class = { glob_module = NoIndex, glob_object = NoIndex}, me_type_ptr = nilPtr }
class_def = { class_name = tc_class_name.pds_ident, class_arity = 1, class_args = [class_var], class_context = [],
class_members = {{ds_ident = tc_member_name.pds_ident, ds_index = cTCMemberSymbIndex, ds_arity = 0 }}, class_cons_vars = 0,
class_dictionary = { ds_ident = { tc_class_name.pds_ident & id_info = nilPtr }, ds_arity = 0, ds_index = NoIndex }, class_pos = NoPos }
= (class_def, member_def, pre_def_symbols)
// MW..
make_identity_fun_type alias_dummy_id type_var
# a = { at_attribute = TA_Anonymous, at_annotation = AN_Strict, at_type = TV type_var }
id_symbol_type = { st_vars = [], st_args = [a], st_arity = 1, st_result = a, st_context = [],
st_attr_vars = [], st_attr_env = [] } // !.a -> .a
= { ft_symb = alias_dummy_id, ft_arity = 1, ft_priority = NoPrio, ft_type = id_symbol_type, ft_pos = NoPos,
ft_specials = SP_None, ft_type_ptr = nilPtr }
// ..MW