diff options
Diffstat (limited to 'frontend')
-rw-r--r-- | frontend/type.icl | 55 |
1 files changed, 39 insertions, 16 deletions
diff --git a/frontend/type.icl b/frontend/type.icl index 232b2a5..b65fcb4 100644 --- a/frontend/type.icl +++ b/frontend/type.icl @@ -1101,7 +1101,7 @@ where # let_binds = let_strict_binds ++ let_lazy_binds (rev_var_types, ts) = make_base let_binds [] ts var_types = reverse rev_var_types - (reqs, ts) = requirements_of_binds NoPos ti let_binds var_types (reqs, ts) + (reqs, ts) = requirements_of_binds let_binds var_types NoPos [] reqs ts (res_type, opt_expr_ptr, (reqs, ts)) = requirements_of_let_expr let_expr_position ti let_expr (reqs, ts) ts_expr_heap = writePtr let_info_ptr (EI_LetType var_types) ts.ts_expr_heap = ( res_type, opt_expr_ptr, ({ reqs & req_case_and_let_exprs = [let_info_ptr : reqs.req_case_and_let_exprs]},{ ts & ts_expr_heap = ts_expr_heap })) @@ -1114,21 +1114,39 @@ where make_base [] var_types ts = (var_types, ts) - requirements_of_binds _ _ [] _ reqs_ts - = reqs_ts - requirements_of_binds last_position ti [{lb_src, lb_position}:bs] [b_type:bts] reqs_ts - # position = if (is_a_new_position lb_position last_position) lb_position NoPos - reqs_ts - = possibly_accumulate_reqs_in_new_group position (requirements_of_bind b_type ti lb_src) reqs_ts - = requirements_of_binds lb_position ti bs bts reqs_ts + requirements_of_binds [] bts last_position new_type_coercions reqs ts + # reqs=add_new_group last_position new_type_coercions reqs + = (reqs,ts) + requirements_of_binds [{lb_src, lb_position}:bs] [b_type:bts] last_position new_type_coercions reqs ts + | is_same_position lb_position last_position + # (new_type_coercions,reqs,ts) = add_requirements_of_bind_to_group lb_src b_type new_type_coercions reqs ts + = requirements_of_binds bs bts last_position new_type_coercions reqs ts + # reqs=add_new_group last_position new_type_coercions reqs + # new_type_coercions=[] + # (new_type_coercions,reqs,ts) = add_requirements_of_bind_to_group_or_list lb_position lb_src b_type new_type_coercions reqs ts + = requirements_of_binds bs bts lb_position new_type_coercions reqs ts where - is_a_new_position (LinePos _ line_nr1) (LinePos _ line_nr2) - = line_nr1<>line_nr2 - is_a_new_position (FunPos _ line_nr1 _) (FunPos _ line_nr2 _) - = line_nr1<>line_nr2 - is_a_new_position _ _ - = True - + is_same_position (LinePos _ line_nr1) (LinePos _ line_nr2) + = line_nr1==line_nr2 + is_same_position (FunPos _ line_nr1 _) (FunPos _ line_nr2 _) + = line_nr1==line_nr2 + is_same_position _ _ + = False + + add_requirements_of_bind_to_group_or_list NoPos lb_src b_type new_type_coercions reqs ts + # (reqs,ts) = requirements_of_bind b_type ti lb_src (reqs,ts) + = (new_type_coercions,reqs,ts) + add_requirements_of_bind_to_group_or_list _ lb_src b_type new_type_coercions reqs ts + = add_requirements_of_bind_to_group lb_src b_type new_type_coercions reqs ts + + add_requirements_of_bind_to_group lb_src b_type new_type_coercions reqs ts + # old_req_type_coercions=reqs.req_type_coercions + # reqs = {reqs & req_type_coercions=new_type_coercions} + # (reqs,ts) = requirements_of_bind b_type ti lb_src (reqs,ts) + # new_type_coercions=reqs.req_type_coercions + # reqs = {reqs & req_type_coercions=old_req_type_coercions} + = (new_type_coercions,reqs,ts) + requirements_of_bind b_type ti lb_src reqs_ts # (exp_type, opt_expr_ptr, (reqs, ts)) = requirements ti lb_src reqs_ts @@ -1137,6 +1155,11 @@ where : reqs.req_type_coercions ] = ({ reqs & req_type_coercions = req_type_coercions }, { ts & ts_expr_heap = ts_expr_heap }) + add_new_group position [] reqs + = reqs + add_new_group position new_type_coercions reqs + = { reqs & req_type_coercion_groups = [{ tcg_type_coercions = new_type_coercions, tcg_position = position } : reqs.req_type_coercion_groups]} + requirements_of_let_expr NoPos ti let_expr reqs_ts = requirements ti let_expr reqs_ts requirements_of_let_expr let_expr_position ti let_expr (reqs=:{req_type_coercions=old_req_type_coercions}, ts) @@ -1152,7 +1175,7 @@ where req_type_coercion_groups = [new_group:reqs_with_new_group_in_accu.req_type_coercion_groups], req_type_coercions = old_req_type_coercions } = (res_type, opt_expr_ptr, (reqs_with_new_group, ts)) - + instance requirements DynamicExpr where |