Skip to content
GitLab
Commit fe83d8ad authored by Sjaak Smetsers's avatar Sjaak Smetsers
Browse files

Sjaak: No idea

parent 39da2f72
Hide whitespace changes
Inline Side-by-side
frontend/type.icl
View file @ fe83d8ad
...@@ -1956,11 +1956,9 @@ typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_de ...@@ -1956,11 +1956,9 @@ typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_de
(td_infos, hp_type_heaps, ts_error) = analTypeDefs ti_common_defs used_module_numbers hp_type_heaps ts_error (td_infos, hp_type_heaps, ts_error) = analTypeDefs ti_common_defs used_module_numbers hp_type_heaps ts_error
// MW234..
| not ts_error.ea_ok | not ts_error.ea_ok
= (ts_error.ea_ok, fun_defs, { ir_from = 0, ir_to = 0 }, {}, ti_common_defs, ti_functions, = (ts_error.ea_ok, fun_defs, { ir_from = 0, ir_to = 0 }, {}, ti_common_defs, ti_functions,
{ heaps & hp_type_heaps = hp_type_heaps }, predef_symbols, ts_error.ea_file, out) { heaps & hp_type_heaps = hp_type_heaps }, predef_symbols, ts_error.ea_file, out)
// ..MW234
# state = collect_imported_instances imports ti_common_defs {} ts_error class_instances hp_type_heaps.th_vars td_infos # state = collect_imported_instances imports ti_common_defs {} ts_error class_instances hp_type_heaps.th_vars td_infos
(_, ts_error, class_instances, th_vars, td_infos) = collect_and_check_instances (size icl_defs.com_instance_defs) ti_common_defs state (_, ts_error, class_instances, th_vars, td_infos) = collect_and_check_instances (size icl_defs.com_instance_defs) ti_common_defs state
...@@ -1968,12 +1966,9 @@ typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_de ...@@ -1968,12 +1966,9 @@ typeProgram comps main_dcl_module_n fun_defs specials list_inferred_types icl_de
ts_type_heaps = { hp_type_heaps & th_vars = th_vars }, ts_td_infos = td_infos, ts_error = ts_error, ts_out = out } ts_type_heaps = { hp_type_heaps & th_vars = th_vars }, ts_td_infos = td_infos, ts_error = ts_error, ts_out = out }
ti = { ti_common_defs = ti_common_defs, ti_functions = ti_functions,ti_main_dcl_module_n=main_dcl_module_n } ti = { ti_common_defs = ti_common_defs, ti_functions = ti_functions,ti_main_dcl_module_n=main_dcl_module_n }
special_instances = { si_next_array_member_index = fun_env_size, si_array_instances = [], si_next_TC_member_index = 0, si_TC_instances = [] } special_instances = { si_next_array_member_index = fun_env_size, si_array_instances = [], si_next_TC_member_index = 0, si_TC_instances = [] }
// MW4 was: # (type_error, fun_defs, predef_symbols, special_instances, ts) = type_components 0 comps class_instances ti (False, fun_defs, predef_symbols, special_instances, ts)
# (type_error, fun_defs, predef_symbols, special_instances, ts) = type_components list_inferred_types 0 comps class_instances ti (False, fun_defs, predef_symbols, special_instances, ts) # (type_error, fun_defs, predef_symbols, special_instances, ts) = type_components list_inferred_types 0 comps class_instances ti (False, fun_defs, predef_symbols, special_instances, ts)
(fun_defs,ts_fun_env) = update_function_types 0 comps ts.ts_fun_env fun_defs (fun_defs,ts_fun_env) = update_function_types 0 comps ts.ts_fun_env fun_defs
// MW4 was: (type_error, fun_defs, predef_symbols, special_instances, {ts_fun_env,ts_error,ts_var_heap, ts_expr_heap, ts_type_heaps})
(type_error, fun_defs, predef_symbols, special_instances, {ts_fun_env,ts_error,ts_var_heap, ts_expr_heap, ts_type_heaps, ts_out}) (type_error, fun_defs, predef_symbols, special_instances, {ts_fun_env,ts_error,ts_var_heap, ts_expr_heap, ts_type_heaps, ts_out})
// MW4 was: = type_instances specials.ir_from specials.ir_to class_instances ti (type_error, fun_defs, predef_symbols, special_instances,
= type_instances list_inferred_types specials.ir_from specials.ir_to class_instances ti (type_error, fun_defs, predef_symbols, special_instances, = type_instances list_inferred_types specials.ir_from specials.ir_to class_instances ti (type_error, fun_defs, predef_symbols, special_instances,
{ ts & ts_fun_env = ts_fun_env }) { ts & ts_fun_env = ts_fun_env })
{si_array_instances, si_next_array_member_index, si_next_TC_member_index, si_TC_instances}= special_instances {si_array_instances, si_next_array_member_index, si_next_TC_member_index, si_TC_instances}= special_instances
...@@ -1992,7 +1987,6 @@ where ...@@ -1992,7 +1987,6 @@ where
= state = state
collect_and_check_instances nr_of_instances common_defs state collect_and_check_instances nr_of_instances common_defs state
// = iFoldSt (update_instances_of_class common_defs cIclModIndex) 0 nr_of_instances state
= iFoldSt (update_instances_of_class common_defs main_dcl_module_n) 0 nr_of_instances state = iFoldSt (update_instances_of_class common_defs main_dcl_module_n) 0 nr_of_instances state
update_instances_of_class common_defs mod_index ins_index (dummy, error, class_instances, type_var_heap, td_infos) update_instances_of_class common_defs mod_index ins_index (dummy, error, class_instances, type_var_heap, td_infos)
...@@ -2057,23 +2051,17 @@ where ...@@ -2057,23 +2051,17 @@ where
= (error, IT_Node ins it_less it_greater) = (error, IT_Node ins it_less it_greater)
= (checkError ins_types " instance is overlapping" error, IT_Node ins it_less it_greater) = (checkError ins_types " instance is overlapping" error, IT_Node ins it_less it_greater)
// MW4 was: type_instances ir_from ir_to class_instances ti funs_and_state
type_instances list_inferred_types ir_from ir_to class_instances ti funs_and_state type_instances list_inferred_types ir_from ir_to class_instances ti funs_and_state
| ir_from == ir_to | ir_from == ir_to
= funs_and_state = funs_and_state
// MW4 was: # funs_and_state = type_component [ir_from] class_instances ti funs_and_state
# funs_and_state = type_component list_inferred_types [ir_from] class_instances ti funs_and_state # funs_and_state = type_component list_inferred_types [ir_from] class_instances ti funs_and_state
// MW4 was: = type_instances (inc ir_from) ir_to class_instances ti funs_and_state
= type_instances list_inferred_types (inc ir_from) ir_to class_instances ti funs_and_state = type_instances list_inferred_types (inc ir_from) ir_to class_instances ti funs_and_state
// MW4 was: type_components group_index comps class_instances ti funs_and_state
type_components list_inferred_types group_index comps class_instances ti funs_and_state type_components list_inferred_types group_index comps class_instances ti funs_and_state
| group_index == size comps | group_index == size comps
= funs_and_state = funs_and_state
#! comp = comps.[group_index] #! comp = comps.[group_index]
// MW4 was: # funs_and_state = type_component comp.group_members class_instances ti funs_and_state
# funs_and_state = type_component list_inferred_types comp.group_members class_instances ti funs_and_state # funs_and_state = type_component list_inferred_types comp.group_members class_instances ti funs_and_state
// MW4 was: = type_components (inc group_index) comps class_instances ti funs_and_state
= type_components list_inferred_types (inc group_index) comps class_instances ti funs_and_state = type_components list_inferred_types (inc group_index) comps class_instances ti funs_and_state
show_component comp fun_defs show_component comp fun_defs
...@@ -2085,20 +2073,17 @@ where ...@@ -2085,20 +2073,17 @@ where
get_index_of_start_rule predef_symbols get_index_of_start_rule predef_symbols
# ({pds_def, pds_module}, predef_symbols) = predef_symbols![PD_Start] # ({pds_def, pds_module}, predef_symbols) = predef_symbols![PD_Start]
// | pds_def <> NoIndex && pds_module == cIclModIndex
| pds_def <> NoIndex && pds_module == main_dcl_module_n | pds_def <> NoIndex && pds_module == main_dcl_module_n
= (pds_def, predef_symbols) = (pds_def, predef_symbols)
= (NoIndex, predef_symbols) = (NoIndex, predef_symbols)
// MW4 was: type_component comp class_instances ti=:{ti_common_defs} (type_error, fun_defs, predef_symbols, special_instances, ts)
type_component list_inferred_types comp class_instances ti=:{ti_common_defs} (type_error, fun_defs, predef_symbols, special_instances, ts) type_component list_inferred_types comp class_instances ti=:{ti_common_defs} (type_error, fun_defs, predef_symbols, special_instances, ts)
# (start_index, predef_symbols) = get_index_of_start_rule predef_symbols # (start_index, predef_symbols) = get_index_of_start_rule predef_symbols
// # (functions, fun_defs) = show_component comp fun_defs
# (fun_defs, predef_symbols, cons_variables, ts) = CreateInitialSymbolTypes start_index ti_common_defs comp (fun_defs, predef_symbols, [], ts) # (fun_defs, predef_symbols, cons_variables, ts) = CreateInitialSymbolTypes start_index ti_common_defs comp (fun_defs, predef_symbols, [], ts)
// MW32.. | not ts.ts_error.ea_ok // ---> ("typing", functions)
| not ts.ts_error.ea_ok
= (True, fun_defs, predef_symbols, special_instances, create_erroneous_function_types comp = (True, fun_defs, predef_symbols, special_instances, create_erroneous_function_types comp
{ ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_error = { ts.ts_error & ea_ok = True } }) { ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_error = { ts.ts_error & ea_ok = True } })
// ..MW32
# (fun_reqs, (cons_variables, fun_defs, ts)) = type_functions comp ti cons_variables fun_defs ts # (fun_reqs, (cons_variables, fun_defs, ts)) = type_functions comp ti cons_variables fun_defs ts
#! nr_of_type_variables = ts.ts_var_store #! nr_of_type_variables = ts.ts_var_store
# (subst, ts_type_heaps, ts_error) # (subst, ts_type_heaps, ts_error)
...@@ -2130,7 +2115,6 @@ where ...@@ -2130,7 +2115,6 @@ where
(subst, ts_fun_env) = expand_function_types comp subst ts.ts_fun_env (subst, ts_fun_env) = expand_function_types comp subst ts.ts_fun_env
attr_var_env = createArray nr_of_attr_vars TA_None attr_var_env = createArray nr_of_attr_vars TA_None
var_env = { subst & [i] = TE \\ i <- [0..dec ts_var_store]} var_env = { subst & [i] = TE \\ i <- [0..dec ts_var_store]}
// MW4 was: (fun_defs, ts) = cleanUpAndCheckFunctionTypes comp fun_reqs dict_types start_index ti_common_defs contexts coer_demanded attr_partition var_env attr_var_env
(fun_defs, ts) = cleanUpAndCheckFunctionTypes comp fun_reqs dict_types start_index list_inferred_types ti_common_defs contexts coer_demanded attr_partition var_env attr_var_env (fun_defs, ts) = cleanUpAndCheckFunctionTypes comp fun_reqs dict_types start_index list_inferred_types ti_common_defs contexts coer_demanded attr_partition var_env attr_var_env
(fun_defs, { ts & ts_error = ts_error, ts_fun_env = ts_fun_env, ts_type_heaps = ts_type_heaps, (fun_defs, { ts & ts_error = ts_error, ts_fun_env = ts_fun_env, ts_type_heaps = ts_type_heaps,
ts_td_infos = ts_td_infos, ts_var_heap = os_var_heap, ts_expr_heap = os_symbol_heap }) ts_td_infos = ts_td_infos, ts_var_heap = os_var_heap, ts_expr_heap = os_symbol_heap })
...@@ -2158,15 +2142,6 @@ where ...@@ -2158,15 +2142,6 @@ where
{ ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_expr_heap = ts_expr_heap, ts_error = { ts_error & ea_ok = True }, { ts & ts_var_store = 0, ts_attr_store = FirstAttrVar, ts_expr_heap = ts_expr_heap, ts_error = { ts_error & ea_ok = True },
ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars = tci_type_var_heap }, ts_fun_env = ts_fun_env}) ts_var_heap = ts_var_heap, ts_type_heaps = { ts_type_heaps & th_vars = tci_type_var_heap }, ts_fun_env = ts_fun_env})
/* MW4 was
unify_requirements_of_functions :: ![FunctionRequirements] !TypeInput !*{!Type} !*TypeHeaps !*ErrorAdmin -> (!*{!Type},!*TypeHeaps,!*ErrorAdmin)
unify_requirements_of_functions [{fe_requirements={req_type_coercions},fe_location} : reqs_list] modules subst heaps ts_error
# ts_error = setErrorAdmin fe_location ts_error
(subst, heaps, ts_error) = unify_coercions req_type_coercions modules subst heaps ts_error
= unify_requirements_of_functions reqs_list modules subst heaps ts_error
unify_requirements_of_functions [] modules subst heaps ts_error
= (subst, heaps, ts_error)
*/
unify_requirements_of_functions :: ![FunctionRequirements] !TypeInput !*{!Type} !*TypeHeaps !*ErrorAdmin -> (!*{!Type},!*TypeHeaps,!*ErrorAdmin) unify_requirements_of_functions :: ![FunctionRequirements] !TypeInput !*{!Type} !*TypeHeaps !*ErrorAdmin -> (!*{!Type},!*TypeHeaps,!*ErrorAdmin)
unify_requirements_of_functions [{fe_requirements={req_type_coercion_groups},fe_location={ip_ident}} : reqs_list] ti subst heaps ts_error unify_requirements_of_functions [{fe_requirements={req_type_coercion_groups},fe_location={ip_ident}} : reqs_list] ti subst heaps ts_error
# (subst, heaps, ts_error) = foldSt (unify_requirements_within_one_position ip_ident ti) req_type_coercion_groups (subst, heaps, ts_error) # (subst, heaps, ts_error) = foldSt (unify_requirements_within_one_position ip_ident ti) req_type_coercion_groups (subst, heaps, ts_error)
...@@ -2174,7 +2149,6 @@ where ...@@ -2174,7 +2149,6 @@ where
unify_requirements_of_functions [] ti subst heaps ts_error unify_requirements_of_functions [] ti subst heaps ts_error
= (subst, heaps, ts_error) = (subst, heaps, ts_error)
// MW4 added..
unify_requirements_within_one_position :: !Ident !TypeInput !TypeCoercionGroup !(*{!Type}, !*TypeHeaps, !*ErrorAdmin) unify_requirements_within_one_position :: !Ident !TypeInput !TypeCoercionGroup !(*{!Type}, !*TypeHeaps, !*ErrorAdmin)
-> (*{!Type}, !*TypeHeaps, !*ErrorAdmin) -> (*{!Type}, !*TypeHeaps, !*ErrorAdmin)
unify_requirements_within_one_position _ ti {tcg_type_coercions, tcg_position=NoPos} (subst, heaps, ts_error) unify_requirements_within_one_position _ ti {tcg_type_coercions, tcg_position=NoPos} (subst, heaps, ts_error)
...@@ -2182,7 +2156,6 @@ where ...@@ -2182,7 +2156,6 @@ where
unify_requirements_within_one_position fun_symb ti {tcg_type_coercions, tcg_position} (subst, heaps, ts_error) unify_requirements_within_one_position fun_symb ti {tcg_type_coercions, tcg_position} (subst, heaps, ts_error)
# ts_error = setErrorAdmin (newPosition fun_symb tcg_position) ts_error # ts_error = setErrorAdmin (newPosition fun_symb tcg_position) ts_error
= unify_coercions tcg_type_coercions ti subst heaps ts_error = unify_coercions tcg_type_coercions ti subst heaps ts_error
// ..MW4
build_initial_coercion_env [{fe_requirements={req_attr_coercions},fe_location} : reqs_list] coercion_env build_initial_coercion_env [{fe_requirements={req_attr_coercions},fe_location} : reqs_list] coercion_env
= build_initial_coercion_env reqs_list (add_to_initial_coercion_env req_attr_coercions coercion_env) = build_initial_coercion_env reqs_list (add_to_initial_coercion_env req_attr_coercions coercion_env)
...@@ -2222,12 +2195,10 @@ where ...@@ -2222,12 +2195,10 @@ where
build_coercion_env [] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error build_coercion_env [] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
= (subst, coercion_env, type_signs, type_var_heap, error) = (subst, coercion_env, type_signs, type_var_heap, error)
// MW4 added..
build_coercion_env_for_alternative fun_symb common_defs cons_var_vects {tcg_position, tcg_type_coercions} build_coercion_env_for_alternative fun_symb common_defs cons_var_vects {tcg_position, tcg_type_coercions}
(subst, coercion_env, type_signs, type_var_heap, error) (subst, coercion_env, type_signs, type_var_heap, error)
# error = setErrorAdmin (newPosition fun_symb tcg_position) error # error = setErrorAdmin (newPosition fun_symb tcg_position) error
= add_to_coercion_env tcg_type_coercions subst coercion_env common_defs cons_var_vects type_signs type_var_heap error = add_to_coercion_env tcg_type_coercions subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
// MW4
add_to_coercion_env [{tc_offered,tc_demanded,tc_coercible,tc_position} : attr_coercions] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error add_to_coercion_env [{tc_offered,tc_demanded,tc_coercible,tc_position} : attr_coercions] subst coercion_env common_defs cons_var_vects type_signs type_var_heap error
# (subst, coercion_env, type_signs, type_var_heap, error) # (subst, coercion_env, type_signs, type_var_heap, error)
...@@ -2317,7 +2288,6 @@ where ...@@ -2317,7 +2288,6 @@ where
ts_var_heap = makeBase fun_symb 1 tb_args temp_fun_type.tst_args ts_var_heap ts_var_heap = makeBase fun_symb 1 tb_args temp_fun_type.tst_args ts_var_heap
fe_location = newPosition fun_symb fun_pos fe_location = newPosition fun_symb fun_pos
ts_error = setErrorAdmin fe_location ts_error ts_error = setErrorAdmin fe_location ts_error
// MW4 was: reqs = { req_overloaded_calls = [], req_type_coercions = [], req_attr_coercions = [], req_case_and_let_exprs = [], req_cons_variables = cons_variables }
reqs = { req_overloaded_calls = [], req_type_coercion_groups = [], req_type_coercions = [], reqs = { req_overloaded_calls = [], req_type_coercion_groups = [], req_type_coercions = [],
req_attr_coercions = [], req_case_and_let_exprs = [], req_cons_variables = cons_variables } req_attr_coercions = [], req_case_and_let_exprs = [], req_cons_variables = cons_variables }
( rhs_type, rhs_expr_ptr, (rhs_reqs, ts)) = requirements ti tb_rhs (reqs, ( rhs_type, rhs_expr_ptr, (rhs_reqs, ts)) = requirements ti tb_rhs (reqs,
...@@ -2328,7 +2298,6 @@ where ...@@ -2328,7 +2298,6 @@ where
type_coercion_group_from_accu = { tcg_type_coercions = req_type_coercions, tcg_position = fun_pos } type_coercion_group_from_accu = { tcg_type_coercions = req_type_coercions, tcg_position = fun_pos }
req_type_coercion_groups = [type_coercion_group_from_accu:rhs_reqs.req_type_coercion_groups] req_type_coercion_groups = [type_coercion_group_from_accu:rhs_reqs.req_type_coercion_groups]
= ( { fe_location = fe_location, fe_context = if (has_option fun_type) (Yes temp_fun_type.tst_context) No, fe_index = fun_index, = ( { fe_location = fe_location, fe_context = if (has_option fun_type) (Yes temp_fun_type.tst_context) No, fe_index = fun_index,
// MW4 was: fe_requirements = { rhs_reqs & req_type_coercions = req_type_coercions, req_cons_variables = [] }}, (rhs_reqs.req_cons_variables, fun_defs,
fe_requirements = { rhs_reqs & req_type_coercions = [], req_type_coercion_groups = req_type_coercion_groups, req_cons_variables = [] } fe_requirements = { rhs_reqs & req_type_coercions = [], req_type_coercion_groups = req_type_coercion_groups, req_cons_variables = [] }
}, },
(rhs_reqs.req_cons_variables, fun_defs, { ts & ts_expr_heap = ts_expr_heap })) (rhs_reqs.req_cons_variables, fun_defs, { ts & ts_expr_heap = ts_expr_heap }))
......
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