Commit 6d3f5a18 authored by Sjaak Smetsers's avatar Sjaak Smetsers
Browse files

buf fix (dictionary types in dcl modules)

parent d9da3ea7
......@@ -308,9 +308,9 @@ analTypeDef modules type_module type_index as=:{as_error,as_heaps,as_kind_heap,a
(is_abs_type, abs_type_properties) = is_abstract_type td_rhs
| is_abs_type
# (tdi, as_td_infos) = as_td_infos![type_module].[type_index]
= (cMAXINT, ({con_top_var_binds = [], con_var_binds = [] },
{ as & as_td_infos = { as_td_infos & [type_module].[type_index] = { tdi & tdi_kinds = [ KindConst \\ _ <- td_args ], tdi_group_vars = [ i \\ _ <- td_args & i <- [0..]],
tdi_properties = abs_type_properties }}}))
tdi = { tdi & tdi_kinds = [ KindConst \\ _ <- td_args ], tdi_group = [{glob_module = type_module, glob_object = type_index}],
tdi_group_vars = [ i \\ _ <- td_args & i <- [0..]], tdi_properties = abs_type_properties }
= (cMAXINT, ({con_top_var_binds = [], con_var_binds = [] }, { as & as_td_infos = { as_td_infos & [type_module].[type_index] = tdi}}))
# position = newPosition td_name td_pos
as_error = pushErrorAdmin position as_error
(tdi_kinds, (th_vars, as_kind_heap)) = newKindVariables td_args (as_heaps.th_vars, as_kind_heap)
......
......@@ -24,20 +24,21 @@ set_sign_in_sign_class {pos_sign,neg_sign} index {sc_pos_vect,sc_neg_vect}
typeProperties :: !Index !Index ![SignClassification] ![PropClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
-> (!TypeSymbProperties, !*TypeVarHeap, !*TypeDefInfos)
typeProperties type_index module_index hio_signs hio_props defs type_var_heap td_infos
# {td_args} = defs.[module_index].com_type_defs.[type_index]
# {td_args, td_name} = defs.[module_index].com_type_defs.[type_index]
(td_info, td_infos) = td_infos![module_index].[type_index]
(tsp_sign, type_var_heap, td_infos) = determineSignClassOfTypeDef type_index module_index td_args td_info hio_signs defs type_var_heap td_infos
(tsp_propagation, type_var_heap, td_infos) = determinePropClassOfTypeDef type_index module_index td_args td_info hio_props defs type_var_heap td_infos
tsp_coercible = (td_info.tdi_properties bitand cIsNonCoercible) == 0
= ({tsp_sign = tsp_sign, tsp_propagation = tsp_propagation, tsp_coercible = tsp_coercible }, type_var_heap, td_infos)
// ---> ("typeProperties", td_name, tsp_sign, tsp_propagation)
signClassification :: !Index !Index ![SignClassification] !{# CommonDefs } !*TypeVarHeap !*TypeDefInfos
-> (!SignClassification, !*TypeVarHeap, !*TypeDefInfos)
signClassification type_index module_index hio_signs defs type_var_heap td_infos
# {td_args} = defs.[module_index].com_type_defs.[type_index]
# {td_name,td_args} = defs.[module_index].com_type_defs.[type_index]
(td_info, td_infos) = td_infos![module_index].[type_index]
= determineSignClassOfTypeDef type_index module_index td_args td_info hio_signs defs type_var_heap td_infos
// ---> ("signClassification", td_name)
removeTopClasses [cv : cvs] [tc : tcs]
| isATopConsVar cv
= removeTopClasses cvs tcs
......@@ -54,12 +55,15 @@ determineSignClassOfTypeDef type_index module_index td_args {tdi_classification,
= case result of
Yes {ts_type_sign}
-> (ts_type_sign, type_var_heap, td_infos)
// ---> ("determineSignClassOfTypeDef1", ts_type_sign)
No
# type_var_heap = bind_type_vars_to_signs td_args tdi_group_vars tdi_cons_vars hio_signs type_var_heap
(sign_class, type_var_heap, td_infos)
= newSignClassOfTypeDefGroup tdi_group_nr { glob_module = module_index, glob_object = type_index}
tdi_group hio_signs ci type_var_heap td_infos
-> (sign_class, foldSt restore_binds_of_type_var td_args type_var_heap, td_infos)
// ---> ("determineSignClassOfTypeDef2", sign_class)
where
bind_type_vars_to_signs [{atv_variable={tv_info_ptr}}: tvs] [gv : gvs] cons_vars hio_signs type_var_heap
......@@ -237,7 +241,7 @@ determinePropClassOfTypeDef type_index module_index td_args {tdi_classification,
hio_props ci type_var_heap td_infos
# hio_props = removeTopClasses tdi_cons_vars hio_props
result = retrievePropClassification hio_props tdi_classification
// ---> (td_args, tdi_kinds, tdi_group_vars)
// ---> (td_args, tdi_kinds, tdi_group_vars)
= case result of
Yes {ts_type_prop}
-> (ts_type_prop, type_var_heap, td_infos)
......
......@@ -226,7 +226,7 @@ decodeTopConsVar cv :== ~(inc cv)
checkTypeDef type_index module_index ts=:{ts_type_defs} ti=:{ti_type_heaps} cs=:{cs_error}
#! type_def = ts_type_defs.[type_index]
# {td_name,td_pos,td_args,td_attribute,td_properties} = type_def
# {td_name,td_pos,td_args,td_attribute} = type_def
position = newPosition td_name td_pos
cs_error = pushErrorAdmin position cs_error
(td_attribute, attr_vars, th_attrs) = determine_root_attribute td_attribute td_name.id_name ti_type_heaps.th_attrs
......
......@@ -527,10 +527,12 @@ where
convertDclModule :: !{# DclModule} !{# CommonDefs} !*{#{# CheckedTypeDef}} !ImportedConstructors !*VarHeap !*TypeHeaps
-> (!*{#{# CheckedTypeDef}}, !ImportedConstructors, !*VarHeap, !*TypeHeaps)
convertDclModule dcl_mods common_defs imported_types imported_conses var_heap type_heaps
# {dcl_functions,dcl_common={com_type_defs,com_cons_defs,com_selector_defs},dcl_conversions} = dcl_mods.[cIclModIndex]
# {dcl_functions,dcl_common=dcl_common=:{com_type_defs,com_cons_defs,com_selector_defs},dcl_conversions} = dcl_mods.[cIclModIndex]
= case dcl_conversions of
Yes conversion_table
# (icl_type_defs, imported_types) = imported_types![cIclModIndex]
common_defs = { common \\ common <-: common_defs }
common_defs = { common_defs & [cIclModIndex] = dcl_common }
types_and_heaps = convert_dcl_functions dcl_functions common_defs ( { imported_types & [cIclModIndex] = com_type_defs }, imported_conses, var_heap, type_heaps)
types_and_heaps = convertConstructorTypes com_cons_defs common_defs types_and_heaps
(imported_types, imported_conses, var_heap, type_heaps) = convertSelectorTypes com_selector_defs common_defs types_and_heaps
......@@ -545,7 +547,7 @@ where
# {ft_type, ft_type_ptr} = dcl_functions.[dcl_index]
(ft_type, imported_types, imported_conses, type_heaps, var_heap) = convertSymbolType common_defs ft_type imported_types imported_conses type_heaps var_heap
= (imported_types, imported_conses, var_heap <:= (ft_type_ptr, VI_ExpandedType ft_type), type_heaps)
convertConstructorTypes cons_defs common_defs types_and_heaps
= iFoldSt (convert_constructor_type common_defs cons_defs) 0 (size cons_defs) types_and_heaps
where
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment