aboutsummaryrefslogtreecommitdiff
path: root/frontend
diff options
context:
space:
mode:
authorjohnvg2002-10-18 15:08:52 +0000
committerjohnvg2002-10-18 15:08:52 +0000
commitfd701be155732d59eebdfeb73fb19a3617682b04 (patch)
tree7fb4d73b15ddc1d94433b73f73c7e0111d8f5d13 /frontend
parentadd boxed records, fix line number in "different number of (diff)
add strict dot dot expressions, transform record update
to record constructor only for records with existential variables, fix line numbers in case expressions generated from guards git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@1241 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
Diffstat (limited to 'frontend')
-rw-r--r--frontend/checkFunctionBodies.icl109
1 files changed, 64 insertions, 45 deletions
diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl
index 6f6dca3..ff81286 100644
--- a/frontend/checkFunctionBodies.icl
+++ b/frontend/checkFunctionBodies.icl
@@ -334,7 +334,7 @@ checkRhs free_vars rhs_alts rhs_locals e_input=:{ei_expr_level,ei_mod_index,ei_l
(es_fun_defs, e_info, heaps, cs)
= checkLocalFunctions ei_mod_index ei_expr_level rhs_locals ei_local_functions_index_offset e_state.es_fun_defs e_info
{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps, hp_generic_heap = e_state.es_generic_heap } cs
- (rhs_expr, free_vars, e_state, e_info, cs)
+ (rhs_expr, _, free_vars, e_state, e_info, cs)
= check_opt_guarded_alts free_vars rhs_alts { e_input & ei_expr_level = ei_expr_level }
{ e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap, es_expr_heap = heaps.hp_expression_heap,
es_type_heaps = heaps.hp_type_heaps,es_generic_heap=heaps.hp_generic_heap } e_info cs
@@ -347,37 +347,35 @@ where
check_opt_guarded_alts free_vars (GuardedAlts guarded_alts default_expr) e_input e_state e_info cs
# (let_vars_list, rev_guarded_exprs, last_expr_level, free_vars, e_state, e_info, cs)
= check_guarded_expressions free_vars guarded_alts [] [] e_input e_state e_info cs
- (default_expr, free_vars, e_state, e_info, cs)
+ (default_expr, default_expr_position, free_vars, e_state, e_info, cs)
= check_default_expr free_vars default_expr { e_input & ei_expr_level = last_expr_level } e_state e_info cs
cs = { cs & cs_symbol_table = remove_seq_let_vars e_input.ei_expr_level let_vars_list cs.cs_symbol_table }
- (_, result_expr, es_expr_heap) = convert_guards_to_cases rev_guarded_exprs default_expr e_state.es_expr_heap
- = (result_expr, free_vars, { e_state & es_expr_heap = es_expr_heap }, e_info, cs)
+ (result_expr, result_expr_position , es_expr_heap) = convert_guards_to_cases rev_guarded_exprs default_expr default_expr_position e_state.es_expr_heap
+ = (result_expr, result_expr_position, free_vars, { e_state & es_expr_heap = es_expr_heap }, e_info, cs)
check_opt_guarded_alts free_vars (UnGuardedExpr unguarded_expr) e_input e_state e_info cs
= check_unguarded_expression free_vars unguarded_expr e_input e_state e_info cs
check_default_expr free_vars (Yes default_expr) e_input e_state e_info cs
- # (expr, free_vars, e_state, e_info, cs) = check_unguarded_expression free_vars default_expr e_input e_state e_info cs
- = (Yes expr, free_vars, e_state, e_info, cs)
+ # (expr, expr_position, free_vars, e_state, e_info, cs) = check_unguarded_expression free_vars default_expr e_input e_state e_info cs
+ = (Yes expr, expr_position, free_vars, e_state, e_info, cs)
check_default_expr free_vars No e_input e_state e_info cs
- = (No, free_vars, e_state, e_info, cs)
-
- convert_guards_to_cases [(let_binds, guard, expr, guard_ident)] result_expr es_expr_heap
+ = (No, NoPos, free_vars, e_state, e_info, cs)
+
+ convert_guards_to_cases [(let_binds, guard, expr, expr_position, guard_ident)] result_expr result_expr_position es_expr_heap
# (case_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
- basic_pattern = {bp_value = (BVB True), bp_expr = expr, bp_position = NoPos }
+ basic_pattern = {bp_value = (BVB True), bp_expr = expr, bp_position = expr_position }
case_expr = Case { case_expr = guard, case_guards = BasicPatterns BT_Bool [basic_pattern],
- case_default = result_expr, case_ident = Yes guard_ident,
- case_explicit = cCaseNotExplicit,
- case_info_ptr = case_expr_ptr, case_default_pos = NoPos }
+ case_default = result_expr, case_default_pos = result_expr_position,
+ case_ident = Yes guard_ident, case_explicit = cCaseNotExplicit, case_info_ptr = case_expr_ptr }
= build_sequential_lets let_binds case_expr NoPos es_expr_heap
- convert_guards_to_cases [(let_binds, guard, expr, guard_ident) : rev_guarded_exprs] result_expr es_expr_heap
+ convert_guards_to_cases [(let_binds, guard, expr, expr_position, guard_ident) : rev_guarded_exprs] result_expr result_expr_position es_expr_heap
# (case_expr_ptr, es_expr_heap) = newPtr EI_Empty es_expr_heap
- basic_pattern = {bp_value = (BVB True), bp_expr = expr, bp_position = NoPos }
+ basic_pattern = {bp_value = (BVB True), bp_expr = expr, bp_position = expr_position }
case_expr = Case { case_expr = guard, case_guards = BasicPatterns BT_Bool [basic_pattern],
- case_default = result_expr, case_ident = Yes guard_ident,
- case_explicit = cCaseNotExplicit,
- case_info_ptr = case_expr_ptr, case_default_pos = NoPos }
- (_, result_expr, es_expr_heap) = build_sequential_lets let_binds case_expr NoPos es_expr_heap
- = convert_guards_to_cases rev_guarded_exprs (Yes result_expr) es_expr_heap
+ case_default = result_expr, case_default_pos = result_expr_position,
+ case_ident = Yes guard_ident, case_explicit = cCaseNotExplicit, case_info_ptr = case_expr_ptr }
+ (result_expr, result_expr_position, es_expr_heap) = build_sequential_lets let_binds case_expr NoPos es_expr_heap
+ = convert_guards_to_cases rev_guarded_exprs (Yes result_expr) result_expr_position es_expr_heap
check_guarded_expressions free_vars [gexpr : gexprs] let_vars_list rev_guarded_exprs e_input e_state e_info cs
# (let_vars_list, rev_guarded_exprs, ei_expr_level, free_vars, e_state, e_info, cs)
@@ -394,10 +392,10 @@ where
cs = pushErrorAdmin2 "guard" alt_position cs
(guard, free_vars, e_state, e_info, cs) = checkExpression free_vars alt_guard e_input e_state e_info cs
cs = popErrorAdmin cs
- (expr, free_vars, e_state, e_info, cs) = check_opt_guarded_alts free_vars alt_expr e_input e_state e_info cs
- = (let_vars_list, [(let_binds, guard, expr, alt_ident) : rev_guarded_exprs], ei_expr_level, free_vars, e_state, e_info, cs )
+ (expr, expr_position, free_vars, e_state, e_info, cs) = check_opt_guarded_alts free_vars alt_expr e_input e_state e_info cs
+ = (let_vars_list, [(let_binds, guard, expr, expr_position, alt_ident) : rev_guarded_exprs], ei_expr_level, free_vars, e_state, e_info, cs )
- check_unguarded_expression :: [FreeVar] ExprWithLocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
+ check_unguarded_expression :: [FreeVar] ExprWithLocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,!Position,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState);
check_unguarded_expression free_vars {ewl_nodes,ewl_expr,ewl_locals,ewl_position} e_input=:{ei_expr_level,ei_mod_index,ei_local_functions_index_offset} e_state e_info cs
# this_expr_level = inc ei_expr_level
(loc_defs, (var_env, array_patterns), e_state, e_info, cs)
@@ -409,14 +407,14 @@ where
(expr, free_vars, e_state, e_info, cs)
= addArraySelections array_patterns expr free_vars e_input e_state e_info cs
cs = { cs & cs_symbol_table = remove_seq_let_vars rhs_expr_level let_vars_list cs.cs_symbol_table }
- (_, seq_let_expr, es_expr_heap) = build_sequential_lets binds expr ewl_position e_state.es_expr_heap
+ (seq_let_expr, expr_position, es_expr_heap) = build_sequential_lets binds expr ewl_position e_state.es_expr_heap
(expr, free_vars, e_state, e_info, cs)
= checkRhssAndTransformLocalDefs free_vars loc_defs seq_let_expr e_input { e_state & es_expr_heap = es_expr_heap} e_info cs
(es_fun_defs, e_info, heaps, cs)
= checkLocalFunctions ei_mod_index rhs_expr_level ewl_locals ei_local_functions_index_offset e_state.es_fun_defs e_info
{ hp_var_heap = e_state.es_var_heap, hp_expression_heap = e_state.es_expr_heap, hp_type_heaps = e_state.es_type_heaps,hp_generic_heap=e_state.es_generic_heap } cs
(es_fun_defs,macro_defs,cs_symbol_table) = removeLocalsFromSymbolTable ei_mod_index this_expr_level var_env ewl_locals ei_local_functions_index_offset es_fun_defs e_info.ef_macro_defs cs.cs_symbol_table
- = (expr, free_vars, {e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap,
+ = (expr, expr_position, free_vars, {e_state & es_fun_defs = es_fun_defs, es_var_heap = heaps.hp_var_heap,
es_expr_heap = heaps.hp_expression_heap, es_type_heaps = heaps.hp_type_heaps, es_generic_heap=heaps.hp_generic_heap},
{e_info & ef_macro_defs=macro_defs}, { cs & cs_symbol_table = cs_symbol_table} )
@@ -468,13 +466,13 @@ where
e_state = { e_state & es_var_heap = ps_var_heap, es_expr_heap = hp_expression_heap, es_type_heaps = hp_type_heaps,es_generic_heap=hp_generic_heap,es_fun_defs = ps_fun_defs }
= (src_expr, pattern, accus, free_vars, e_state, e_info, popErrorAdmin cs)
- build_sequential_lets :: ![(![LetBind],![LetBind])] !Expression !Position !*ExpressionHeap -> (!Position, !Expression, !*ExpressionHeap)
+ build_sequential_lets :: ![(![LetBind],![LetBind])] !Expression !Position !*ExpressionHeap -> (!Expression, !Position, !*ExpressionHeap)
build_sequential_lets [] expr let_expr_position expr_heap
- = (let_expr_position, expr, expr_heap)
+ = (expr, let_expr_position, expr_heap)
build_sequential_lets [(strict_binds, lazy_binds) : seq_lets] expr let_expr_position expr_heap
- # (let_expr_position, let_expr, expr_heap) = build_sequential_lets seq_lets expr let_expr_position expr_heap
+ # (let_expr, let_expr_position, expr_heap) = build_sequential_lets seq_lets expr let_expr_position expr_heap
(let_expr, expr_heap) = buildLetExpression strict_binds lazy_binds let_expr let_expr_position expr_heap
- = (if (isEmpty strict_binds && isEmpty lazy_binds) let_expr_position NoPos, let_expr, expr_heap)
+ = ( let_expr, if (isEmpty strict_binds && isEmpty lazy_binds) let_expr_position NoPos, expr_heap)
checkLocalFunctions :: !Index !Level !LocalDefs !Int !*{#FunDef} !*ExpressionInfo !*Heaps !*CheckState
-> (!.{#FunDef},!.ExpressionInfo,!.Heaps,!.CheckState);
@@ -1022,23 +1020,35 @@ checkExpression free_vars rec=:(PE_Record record opt_type fields) e_input=:{ei_e
-> (App { app_symb = rec_cons, app_args = remove_fields exprs, app_info_ptr = nilPtr }, free_vars, e_state, e_info, cs)
_
# (rec_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars record e_input e_state e_info cs
- -> case rec_expr of
- Var {var_info_ptr,var_name}
- # (var_info, es_var_heap) = readPtr var_info_ptr e_state.es_var_heap
- e_state = { e_state & es_var_heap = es_var_heap }
- -> case var_info of
- VI_Record fields
- # (exprs, free_vars, e_state, e_info, cs)
- = check_field_exprs free_vars new_fields 0 (RK_UpdateToConstructor fields) e_input e_state e_info cs
- -> (App { app_symb = rec_cons, app_args = remove_fields exprs, app_info_ptr = nilPtr }, free_vars, e_state, e_info, cs)
- _
- # (exprs, free_vars, e_state, e_info, cs)
- = check_field_exprs free_vars new_fields 0 RK_Update e_input e_state e_info cs
- -> (RecordUpdate cons rec_expr exprs, free_vars, e_state, e_info, cs)
- _
- # (exprs, free_vars, e_state, e_info, cs)
+ # (has_exi_vars,e_info) = record_has_exi_vars e_info
+ with
+ record_has_exi_vars e_info
+ | glob_module==ei_mod_index
+ # ({cons_exi_vars}, e_info) = e_info!ef_cons_defs.[ds_index];
+ = (case cons_exi_vars of [] -> False; _ -> True, e_info);
+ # ({cons_exi_vars}, e_info) = e_info!ef_modules.[glob_module].dcl_common.com_cons_defs.[ds_index];
+ = (case cons_exi_vars of [] -> False; _ -> True, e_info);
+ | has_exi_vars
+ -> case rec_expr of
+ Var {var_info_ptr,var_name}
+ # (var_info, es_var_heap) = readPtr var_info_ptr e_state.es_var_heap
+ e_state = { e_state & es_var_heap = es_var_heap }
+ -> case var_info of
+ VI_Record fields
+ # (exprs, free_vars, e_state, e_info, cs)
+ = check_field_exprs free_vars new_fields 0 (RK_UpdateToConstructor fields) e_input e_state e_info cs
+ -> (App { app_symb = rec_cons, app_args = remove_fields exprs, app_info_ptr = nilPtr }, free_vars, e_state, e_info, cs)
+ _
+ # (exprs, free_vars, e_state, e_info, cs)
+ = check_field_exprs free_vars new_fields 0 RK_Update e_input e_state e_info cs
+ -> (RecordUpdate cons rec_expr exprs, free_vars, e_state, e_info, cs)
+ _
+ # (exprs, free_vars, e_state, e_info, cs)
+ = check_field_exprs free_vars new_fields 0 RK_Update e_input e_state e_info cs
+ -> (RecordUpdate cons rec_expr exprs, free_vars, e_state, e_info, cs)
+ # (exprs, free_vars, e_state, e_info, cs)
= check_field_exprs free_vars new_fields 0 RK_Update e_input e_state e_info cs
- -> (RecordUpdate cons rec_expr exprs, free_vars, e_state, e_info, cs)
+ -> (RecordUpdate cons rec_expr exprs, free_vars, e_state, e_info, cs)
No
-> (EE, free_vars, e_state, e_info, cs)
where
@@ -1235,6 +1245,15 @@ where
= (EE, free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdEnum})
// instead of giving an error message remember that StdEnum should have been imported.
// Error will be given in function check_needed_modules_are_imported
+ | id==local_predefined_idents.[PD_FromS] || id==local_predefined_idents.[PD_FromTS] || id==local_predefined_idents.[PD_FromSTS]
+ || id==local_predefined_idents.[PD_FromU] || id==local_predefined_idents.[PD_FromUTS] || id==local_predefined_idents.[PD_FromO]
+ || id==local_predefined_idents.[PD_FromThenS] || id==local_predefined_idents.[PD_FromThenTS] || id==local_predefined_idents.[PD_FromThenSTS]
+ || id==local_predefined_idents.[PD_FromThenU] || id==local_predefined_idents.[PD_FromThenUTS] || id==local_predefined_idents.[PD_FromThenO]
+ || id==local_predefined_idents.[PD_FromToS] || id==local_predefined_idents.[PD_FromToTS] || id==local_predefined_idents.[PD_FromToSTS]
+ || id==local_predefined_idents.[PD_FromToU] || id==local_predefined_idents.[PD_FromToUTS] || id==local_predefined_idents.[PD_FromToO]
+ || id==local_predefined_idents.[PD_FromThenToS] || id==local_predefined_idents.[PD_FromThenToTS] || id==local_predefined_idents.[PD_FromThenToSTS]
+ || id==local_predefined_idents.[PD_FromThenToU] || id==local_predefined_idents.[PD_FromThenToUTS] || id==local_predefined_idents.[PD_FromThenToO]
+ = (EE, free_vars, e_state, e_info, { cs & cs_x.x_needed_modules = cs_x.x_needed_modules bitor cNeedStdStrictLists})
# createArray_ident = local_predefined_idents.[PD__CreateArrayFun]
uselect_ident = local_predefined_idents.[PD_UnqArraySelectFun]
update_ident = local_predefined_idents.[PD_ArrayUpdateFun]