Commit 41cd21f5 authored by Camil Staps's avatar Camil Staps 🐧 Committed by johnvg@science.ru.nl

Add macros ConsNumberNewType, ConsNumberAddedConstructor and...

Add macros ConsNumberNewType, ConsNumberAddedConstructor and DefinedSymbolArityNewType for cons_number and ds_arity fields of new types and added constructors
parent 38389946
......@@ -2444,6 +2444,6 @@ markExports {dcl_functions,dcl_common={com_type_defs,com_cons_defs,com_selector_
= beExportField True fs_index
export_constructor constructor_index
| com_cons_defs.[constructor_index].cons_number <> -2
| com_cons_defs.[constructor_index].cons_number <> ConsNumberNewType
= beExportConstructor constructor_index
= \ bs=:{bes_backEnd} -> bs
......@@ -1347,7 +1347,7 @@ renumber_icl_definitions_without_functions_as_dcl_definitions (Yes icl_to_dcl_in
# com_selector_defs=reorder_and_enlarge_array com_selector_defs n_dictionary_selectors icl_to_dcl_index_table.[cSelectorDefs]
{sd_ident=dummy_ident,sd_field=dummy_ident,sd_type=dummy_symbol_type,sd_exi_vars=[],sd_field_nr=0,sd_type_index=0,sd_type_ptr=nilPtr,sd_pos=NoPos}
# com_cons_defs=reorder_and_enlarge_array com_cons_defs n_dictionary_constructors icl_to_dcl_index_table.[cConstructorDefs]
{cons_ident=dummy_ident,cons_type=dummy_symbol_type,cons_priority=NoPrio,cons_number= -1,cons_type_index= -1,cons_exi_vars=[],cons_type_ptr=nilPtr,cons_pos=NoPos}
{cons_ident=dummy_ident,cons_type=dummy_symbol_type,cons_priority=NoPrio,cons_number=NoIndex,cons_type_index= -1,cons_exi_vars=[],cons_type_ptr=nilPtr,cons_pos=NoPos}
# com_class_defs=reorder_array com_class_defs icl_to_dcl_index_table.[cClassDefs]
# com_member_defs=reorder_array com_member_defs icl_to_dcl_index_table.[cMemberDefs]
# com_instance_defs=reorder_array com_instance_defs icl_to_dcl_index_table.[cInstanceDefs]
......
......@@ -1389,7 +1389,7 @@ where
= (SK_OverloadedFunction { glob_object = def_index, glob_module = mod_index }, st_arity, me_priority)
ste_kind_to_symbol_kind STE_Constructor def_index mod_index {dcl_common={com_cons_defs}}
# {cons_type={st_arity,st_args,st_context},cons_priority,cons_number} = com_cons_defs.[def_index]
| cons_number <> -2
| cons_number <> ConsNumberNewType
| isEmpty st_context && no_TFAC_argument st_args
= (SK_Constructor {glob_object = def_index, glob_module = mod_index}, st_arity, cons_priority)
= (SK_OverloadedConstructor {glob_object = def_index, glob_module = mod_index}, st_arity, cons_priority)
......@@ -1400,7 +1400,7 @@ where
e_state, { e_info & ef_member_defs = ef_member_defs }, cs)
determine_info_of_symbol {ste_kind=STE_Constructor, ste_index} _ e_input=:{ei_mod_index} e_state e_info cs
# ({cons_type={st_arity,st_args,st_context},cons_priority,cons_number}, e_info) = e_info!ef_cons_defs.[ste_index]
| cons_number <> -2
| cons_number <> ConsNumberNewType
| isEmpty st_context && no_TFAC_argument st_args
= (SK_Constructor {glob_object = ste_index, glob_module = ei_mod_index}, st_arity, cons_priority, e_state, e_info, cs)
= (SK_OverloadedConstructor {glob_object = ste_index, glob_module = ei_mod_index}, st_arity, cons_priority, e_state, e_info, cs)
......@@ -1438,7 +1438,7 @@ checkQualifiedIdentExpression free_vars module_id ident_name is_expr_list e_inpu
-> (app_expr, free_vars, e_state, e_info, cs)
STE_Imported STE_Constructor mod_index
# ({cons_type={st_arity,st_args,st_context},cons_priority,cons_number}, e_info) = e_info!ef_modules.[mod_index].dcl_common.com_cons_defs.[decl_index]
| cons_number <> -2
| cons_number <> ConsNumberNewType
| isEmpty st_context
| no_TFAC_argument st_args
# kind = SK_Constructor { glob_object = decl_index, glob_module = mod_index }
......@@ -1841,7 +1841,7 @@ checkPatternConstructor mod_index is_expr_list {ste_index, ste_kind} cons_ident
= determine_pattern_symbol mod_index ste_index ste_kind cons_ident.id_name ef_cons_defs ef_modules cs_error
e_info = { e_info & ef_cons_defs = ef_cons_defs, ef_modules = ef_modules }
cons_symbol = { glob_object = MakeDefinedSymbol cons_ident cons_index cons_arity, glob_module = cons_module }
| cons_number > -2
| cons_number >= NoIndex
# global_type_index = {gi_module = cons_module, gi_index = cons_type_index}
| is_expr_list
= (AP_Constant (APK_Constructor global_type_index) cons_symbol cons_priority, ps, e_info, {cs & cs_error = cs_error})
......@@ -1852,12 +1852,12 @@ checkPatternConstructor mod_index is_expr_list {ste_index, ste_kind} cons_ident
(toString cons_arity+++" constructor arguments are missing")
cs & cs_error = checkError cons_ident error_message cs_error
= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, cs)
| cons_number == -2
| cons_number == ConsNumberNewType
| is_expr_list
= (AP_Constant (APK_NewTypeConstructor cons_type_index) cons_symbol cons_priority, ps, e_info, {cs & cs_error = cs_error})
# cs & cs_error = checkError cons_ident "constructor argument is missing" cs_error
= (AP_NewType cons_symbol cons_type_index AP_Empty opt_var, ps, e_info, cs)
// cons_number == -3
| cons_number == ConsNumberAddedConstructor
# (type_rhs,e_info)
= case ste_kind of
STE_Constructor
......@@ -1902,7 +1902,7 @@ checkQualifiedPatternConstructor ste_kind ste_index decl_ident module_name ident
= determine_pattern_symbol mod_index ste_index ste_kind module_name ident_name ef_cons_defs ef_modules cs_error
e_info = { e_info & ef_cons_defs = ef_cons_defs, ef_modules = ef_modules }
cons_symbol = { glob_object = MakeDefinedSymbol decl_ident cons_index cons_arity, glob_module = cons_module }
| cons_number > -2
| cons_number >= NoIndex
# global_type_index = {gi_module = cons_module, gi_index = cons_type_index}
| is_expr_list
= (AP_Constant (APK_Constructor global_type_index) cons_symbol cons_priority, ps, e_info, {cs & cs_error = cs_error})
......@@ -1910,12 +1910,12 @@ checkQualifiedPatternConstructor ste_kind ste_index decl_ident module_name ident
= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, {cs & cs_error = cs_error})
# cs & cs_error = checkError ident_name "constructor arguments are missing" cs_error
= (AP_Algebraic cons_symbol global_type_index [] opt_var, ps, e_info, cs)
| cons_number == -2
| cons_number == ConsNumberNewType
| is_expr_list
= (AP_Constant (APK_NewTypeConstructor cons_type_index) cons_symbol cons_priority, ps, e_info, {cs & cs_error = cs_error})
# cs & cs_error = checkError ident_name "constructor argument is missing" cs_error
= (AP_NewType cons_symbol cons_type_index AP_Empty opt_var, ps, e_info, cs)
// cons_number == -3
| cons_number == ConsNumberAddedConstructor
# (type_rhs,e_info)
= case ste_kind of
STE_Constructor
......
......@@ -536,7 +536,7 @@ where
# type_lhs = { at_attribute = cti_lhs_attribute,
at_type = TA (MakeTypeSymbIdent { glob_object = cti_type_index, glob_module = cti_module_index } td_ident td_arity)
[{at_attribute = atv_attribute,at_type = TV atv_variable} \\ {atv_variable, atv_attribute} <- td_args]}
class_defs_ts_ti_cs = bind_types_of_constructor cti -2 (atype_vars_to_type_vars td_args) attr_vars type_lhs ds_index class_defs_ts_ti_cs
class_defs_ts_ti_cs = bind_types_of_constructor cti ConsNumberNewType (atype_vars_to_type_vars td_args) attr_vars type_lhs ds_index class_defs_ts_ti_cs
= (td_rhs, class_defs_ts_ti_cs)
check_rhs_of_TypeDef {td_rhs = AbstractSynType properties type} _ cti (class_defs,ts,ti,cs)
# (type, type_attr, (ts,ti,cs)) = bindTypes cti type (ts,ti,cs)
......@@ -597,7 +597,7 @@ where
# (ts,cs) = if (ds_arity>32)
(constructor_has_too_many_arguments ds_index ds_ident ds_arity ts cs)
(ts,cs);
# class_defs_ts_ti_cs = bind_types_of_constructor cti -3 free_vars free_attrs type_lhs ds_index (class_defs,ts,ti,cs)
# class_defs_ts_ti_cs = bind_types_of_constructor cti ConsNumberAddedConstructor free_vars free_attrs type_lhs ds_index (class_defs,ts,ti,cs)
= bind_types_of_added_constructors cti free_vars free_attrs type_lhs conses class_defs_ts_ti_cs
bind_types_of_added_constructors _ _ _ _ [] class_defs_ts_ti_cs
= class_defs_ts_ti_cs
......
......@@ -1011,13 +1011,17 @@ cNotVarNumber :== -1
{ cons_ident :: !Ident
, cons_type :: !SymbolType
, cons_priority :: !Priority
, cons_number :: !Index // -2 for newtype constructor, -3 for added constructor
, cons_number :: !Index
, cons_type_index :: !Index
, cons_exi_vars :: ![ATypeVar]
, cons_type_ptr :: !VarInfoPtr
, cons_pos :: !Position
}
// Possible values for cons_number (-1 is reserved for NoIndex):
ConsNumberNewType :== -2
ConsNumberAddedConstructor :== -3
:: SelectorDef =
{ sd_ident :: !Ident // IC_Selector
, sd_field :: !Ident // IC_Field
......
......@@ -801,7 +801,7 @@ freshAlgebraicType {gi_module,gi_index} patterns common_defs ts=:{ts_var_store,t
where
fresh_symbol_types [{ap_symbol={glob_object,glob_module},ap_expr}] common_defs td_attrs td_args var_store attr_store type_heaps all_exis_variables
# {cons_type = {st_args,st_attr_env,st_result,st_context}, cons_exi_vars, cons_number, cons_type_index} = common_defs.[glob_module].com_cons_defs.[glob_object.ds_index]
| cons_number <> -3
| cons_number <> ConsNumberAddedConstructor
# (exis_variables, var_store, attr_store, type_heaps) = freshExistentialVariables cons_exi_vars var_store attr_store type_heaps
(attr_env, th_attrs) = fresh_environment st_attr_env [] type_heaps.th_attrs
(result_type, type_heaps) = freshCopy st_result { type_heaps & th_attrs = th_attrs }
......@@ -828,7 +828,7 @@ where
# (cons_types, result_type, attr_env, constructor_contexts, var_store, attr_store, type_heaps, all_exis_variables)
= fresh_symbol_types patterns common_defs td_attrs td_args var_store attr_store type_heaps all_exis_variables
# {cons_type = {st_args,st_attr_env,st_context}, cons_exi_vars,cons_number, cons_type_index} = common_defs.[glob_module].com_cons_defs.[glob_object.ds_index]
| cons_number <> -3
| cons_number <> ConsNumberAddedConstructor
# (exis_variables, var_store, attr_store, type_heaps) = freshExistentialVariables cons_exi_vars var_store attr_store type_heaps
(attr_env, th_attrs) = fresh_environment st_attr_env attr_env type_heaps.th_attrs
(fresh_args, type_heaps) = freshCopy st_args { type_heaps & th_attrs = th_attrs }
......
Markdown is supported
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