diff options
| -rw-r--r-- | frontend/checkFunctionBodies.icl | 34 | ||||
| -rw-r--r-- | frontend/parse.icl | 6 | ||||
| -rw-r--r-- | frontend/postparse.icl | 16 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 2 | ||||
| -rw-r--r-- | frontend/syntax.icl | 8 |
5 files changed, 30 insertions, 36 deletions
diff --git a/frontend/checkFunctionBodies.icl b/frontend/checkFunctionBodies.icl index d0af688..3e9cd81 100644 --- a/frontend/checkFunctionBodies.icl +++ b/frontend/checkFunctionBodies.icl @@ -130,7 +130,7 @@ make_case_guards cons_symbol global_type_index alg_patterns expr_heap cs = (AlgebraicPatterns global_type_index alg_patterns,expr_heap,cs) checkFunctionBodies :: !FunctionBody !Ident !.ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState - -> (!FunctionBody, ![FreeVar], !*ExpressionState, !*ExpressionInfo, !*CheckState) + -> (!FunctionBody, ![FreeVar], !*ExpressionState,!*ExpressionInfo,!*CheckState) checkFunctionBodies (ParsedBody [{pb_args,pb_rhs={rhs_alts,rhs_locals}, pb_position} : bodies]) function_ident_for_errors e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap, es_fun_defs} e_info cs @@ -143,7 +143,7 @@ checkFunctionBodies (ParsedBody [{pb_args,pb_rhs={rhs_alts,rhs_locals}, pb_posit = addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs cs_symbol_table = removeLocalIdentsFromSymbolTable ei_expr_level var_env cs.cs_symbol_table cs = { cs & cs_symbol_table = cs_symbol_table } - (cb_args, es_var_heap) = mapSt determine_function_arg aux_patterns es_var_heap + (cb_args, es_var_heap) = mapSt determine_function_arg aux_patterns es_var_heap (rhss, free_vars, e_state=:{es_dynamics,es_expr_heap,es_var_heap}, e_info, cs) = check_function_bodies free_vars cb_args bodies e_input { e_state & es_dynamics = [], es_var_heap = es_var_heap } e_info cs (rhs, position, es_var_heap, es_expr_heap, dynamics_in_patterns, cs) @@ -178,7 +178,7 @@ where determine_function_arg _ var_store # ({bind_src,bind_dst}, var_store) = determinePatternVariable No var_store = ({ fv_ident = bind_src, fv_info_ptr = bind_dst, fv_def_level = NotALevel, fv_count = 0 }, var_store) - + check_function_bodies free_vars fun_args [{pb_args,pb_rhs={rhs_alts,rhs_locals},pb_position} : bodies] e_input=:{ei_expr_level,ei_mod_index} e_state=:{es_var_heap,es_fun_defs} e_info cs # cs = pushErrorAdmin (newPosition function_ident_for_errors pb_position) cs @@ -345,7 +345,8 @@ removeLocalsFromSymbolTable module_index level loc_vars (CollectedLocalDefs {loc :: LetBinds :== [([LetBind],[LetBind])] -checkRhs :: [FreeVar] OptGuardedAlts LocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState); +checkRhs :: [FreeVar] OptGuardedAlts LocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState + -> *(!Expression,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState); checkRhs free_vars rhs_alts rhs_locals e_input=:{ei_expr_level,ei_mod_index,ei_local_functions_index_offset} e_state e_info cs # ei_expr_level = inc ei_expr_level (loc_defs, (var_env, array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index rhs_locals ei_local_functions_index_offset e_state e_info cs @@ -441,7 +442,7 @@ where remove_seq_let_vars level [let_vars : let_vars_list] symbol_table = remove_seq_let_vars (dec level) let_vars_list (removeLocalIdentsFromSymbolTable level let_vars symbol_table) - check_sequential_lets :: [FreeVar] [NodeDefWithLocals] u:[[Ident]] !ExpressionInput *ExpressionState *ExpressionInfo *CheckState + check_sequential_lets :: [FreeVar] [NodeDefWithLocals] u:[[Ident]] !ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!LetBinds,!u:[[Ident]],!Int,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState); check_sequential_lets free_vars [seq_let:seq_lets] let_vars_list e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs # ei_expr_level = inc ei_expr_level @@ -507,7 +508,7 @@ checkLocalFunctions mod_index level (CollectedLocalDefs {loc_functions={ir_from, = (fun_defs,e_info,heaps,cs) checkExpression :: ![FreeVar] !ParsedExpr !ExpressionInput !*ExpressionState !*ExpressionInfo !*CheckState - -> *(!Expression, ![FreeVar], !*ExpressionState, !*ExpressionInfo, !*CheckState); + -> *(!Expression, ![FreeVar], !*ExpressionState,!*ExpressionInfo,!*CheckState); checkExpression free_vars (PE_List exprs) e_input e_state e_info cs # (exprs, free_vars, e_state, e_info, cs) = check_expressions free_vars exprs e_input e_state e_info cs (expr, e_state, cs_error) = build_expression exprs e_state cs.cs_error @@ -619,7 +620,7 @@ where # (result_expr, e_state, cs_error) = buildApplication symb arity 2 [left,result_expr] e_state cs_error = build_final_expression left_appls result_expr e_state cs_error -checkExpression free_vars (PE_Let strict let_locals expr) e_input=:{ei_expr_level,ei_mod_index,ei_local_functions_index_offset} e_state e_info cs +checkExpression free_vars (PE_Let let_locals expr) e_input=:{ei_expr_level,ei_mod_index,ei_local_functions_index_offset} e_state e_info cs # ei_expr_level = inc ei_expr_level (loc_defs, (var_env, array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index let_locals ei_local_functions_index_offset e_state e_info cs @@ -2585,15 +2586,14 @@ where cs = checkPatternVariable pi_def_level entry id new_info_ptr { cs & cs_symbol_table = cs_symbol_table } = (AP_Variable id new_info_ptr opt_var, ([ id : var_env ], array_patterns), { ps & ps_var_heap = ps_var_heap}, e_info, cs) check_local_lhs_pattern pattern opt_var p_input accus var_store e_info cs - = checkPattern pattern opt_var p_input accus var_store e_info cs + = checkPattern pattern opt_var p_input accus var_store e_info cs addArraySelections [] rhs_expr free_vars e_input e_state e_info cs = (rhs_expr, free_vars, e_state, e_info, cs) addArraySelections array_patterns rhs_expr free_vars e_input e_state e_info cs # (let_strict_binds, let_lazy_binds, free_vars, e_state, e_info, cs) = buildArraySelections e_input array_patterns free_vars e_state e_info cs - (let_expr_ptr, es_expr_heap) - = newPtr EI_Empty e_state.es_expr_heap + (let_expr_ptr, es_expr_heap) = newPtr EI_Empty e_state.es_expr_heap = ( Let {let_strict_binds = let_strict_binds, let_lazy_binds = let_lazy_binds, let_expr = rhs_expr, let_info_ptr = let_expr_ptr, let_expr_position = NoPos } , free_vars , { e_state & es_expr_heap = es_expr_heap} , e_info, cs ) @@ -2641,23 +2641,17 @@ buildSelections e_input {ap_opt_var, ap_array_var, ap_selections} -> (unq_select_symb, UniqueSingleArraySelector, cs) _ # (select_symb, cs) = getPredefinedGlobalSymbol PD_ArraySelectFun PD_StdArray STE_Member 2 cs -> (select_symb, UniqueSelector, cs) - e_state - = { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap } + e_state = { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap } (index_exprs, (free_vars, e_state, e_info, cs)) = mapSt (check_index_expr e_input) parsed_index_exprs (free_vars, e_state, e_info, cs) - selections - = [ ArraySelection glob_select_symb new_expr_ptr index_expr \\ new_expr_ptr<-new_expr_ptrs & index_expr<-index_exprs ] + selections = [ ArraySelection glob_select_symb new_expr_ptr index_expr \\ new_expr_ptr<-new_expr_ptrs & index_expr<-index_exprs ] = ( new_array_var , [ {lb_dst = var_for_uselect_result, lb_src = Selection selector_kind (Var bound_array_var) selections, lb_position = NoPos } , {lb_dst = new_array_var, lb_src = TupleSelect tuple_cons.glob_object 1 (Var bound_var_for_uselect_result), lb_position = NoPos } , {lb_dst = array_element_var, lb_src = TupleSelect tuple_cons.glob_object 0 (Var bound_var_for_uselect_result), lb_position = NoPos } : binds ] - , free_vars - , e_state - , e_info - , cs - ) + , free_vars, e_state, e_info , cs) check_index_expr e_input parsed_index_expr (free_vars, e_state, e_info, cs) # (index_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars parsed_index_expr e_input e_state e_info cs @@ -2802,7 +2796,7 @@ retrieveSelectorIndexes mod_index {ste_kind = STE_Selector selector_list, ste_in where adjust_mod_index mod_index selector=:{glob_module} | glob_module == NoIndex - = { selector & glob_module = mod_index } + = {selector & glob_module = mod_index} = selector retrieveSelectorIndexes mod_index off_kind = [] diff --git a/frontend/parse.icl b/frontend/parse.icl index ceb527f..faf98e1 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -3571,7 +3571,7 @@ trySimpleNonLhsExpressionT (LetToken strict) pState // let! is not supported in # (let_binds, pState) = wantLocals pState pState = wantToken FunctionContext "let expression" InToken pState (let_expr, pState) = wantExpression pState - = (True, PE_Let strict let_binds let_expr, pState) + = (True, PE_Let let_binds let_expr, pState) trySimpleNonLhsExpressionT CaseToken pState # (case_exp, pState) = wantCaseExp pState = (True, case_exp, pState) @@ -4375,7 +4375,7 @@ transform_record_or_array_update type expr updates level pState build_update record_type No expr assignments = PE_Record expr record_type assignments build_update record_type (Yes ident) expr assignments - = PE_Let False (LocalParsedDefs [buildNodeDef (PE_Ident ident) expr]) + = PE_Let (LocalParsedDefs [buildNodeDef (PE_Ident ident) expr]) (PE_Record (PE_Ident ident) record_type assignments) check_field_and_record_types :: OptionalRecordName OptionalRecordName ParseState -> (!OptionalRecordName,!ParseState); @@ -4429,7 +4429,7 @@ transform_record_or_array_update type expr updates level pState = transform_record_update NoRecordName (PE_Ident element_id) [[{nu_selectors=(reverse record_selectors), nu_update_expr=update_expr}]] (level+1) pState - = (PE_Let False + = (PE_Let (LocalParsedDefs [index_def, select_def]) (PE_Update (PE_Ident array_id) (reverse [PS_Array (PE_Ident index_id) : initial_selectors]) updated_element), pState) diff --git a/frontend/postparse.icl b/frontend/postparse.icl index fc63ca7..126d64c 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -120,7 +120,7 @@ where collectFunctions (PE_Lambda lam_ident args res pos) icl_module ca # ((args,res), ca) = collectFunctions (args,res) icl_module ca # (range, ca) = addFunctionsRange [transformLambda lam_ident args res pos] ca - = (PE_Let cIsStrict (CollectedLocalDefs { loc_functions = range, loc_nodes = [], loc_in_icl_module=icl_module }) + = (PE_Let (CollectedLocalDefs { loc_functions = range, loc_nodes = [], loc_in_icl_module=icl_module }) (PE_Ident lam_ident), ca) collectFunctions (PE_Record rec_expr type_ident fields) icl_module ca # ((rec_expr,fields), ca) = collectFunctions (rec_expr,fields) icl_module ca @@ -143,9 +143,9 @@ where (c, ca) = collectFunctions c icl_module ca (case_alts, ca) = collectFunctions case_alts icl_module ca = (PE_Case if_ident c case_alts, ca) - collectFunctions (PE_Let strict locals in_expr) icl_module ca + collectFunctions (PE_Let locals in_expr) icl_module ca # ((node_defs,in_expr), ca) = collectFunctions (locals,in_expr) icl_module ca - = (PE_Let strict node_defs in_expr, ca) + = (PE_Let node_defs in_expr, ca) collectFunctions (PE_ListCompr predef_cons_index predef_nil_index expr qualifiers) icl_module ca # (compr, ca) = transformListComprehension predef_cons_index predef_nil_index expr qualifiers ca = collectFunctions compr icl_module ca @@ -677,17 +677,17 @@ where minimum exp1 ident2=:(PE_Ident _) ca # node_def1 = PD_NodeDef (LinePos qual_filename gen_position.lc_line) ident1 (exprToRhs exp1) # (min_exp,ca) = minimum_of_idents ident1 ident2 ca - = (PE_Let cIsNotStrict (LocalParsedDefs [node_def1]) min_exp,ca) + = (PE_Let (LocalParsedDefs [node_def1]) min_exp,ca) minimum ident1=:(PE_Ident _) exp2 ca # node_def2 = PD_NodeDef (LinePos qual_filename gen_position.lc_line) ident2 (exprToRhs exp2) # (min_exp,ca) = minimum_of_idents ident1 ident2 ca - = (PE_Let cIsNotStrict (LocalParsedDefs [node_def2]) min_exp,ca) + = (PE_Let (LocalParsedDefs [node_def2]) min_exp,ca) minimum exp1 exp2 ca # pos = LinePos qual_filename gen_position.lc_line # node_def1 = PD_NodeDef pos ident1 (exprToRhs exp1) # node_def2 = PD_NodeDef pos ident2 (exprToRhs exp2) # (min_exp,ca) = minimum_of_idents ident1 ident2 ca - = (PE_Let cIsNotStrict (LocalParsedDefs [node_def1,node_def2]) min_exp,ca) + = (PE_Let (LocalParsedDefs [node_def1,node_def2]) min_exp,ca) minimum_of_idents ident1 ident2 ca # smaller_fun = get_predef_id PD_SmallerFun @@ -733,7 +733,7 @@ add_node_defs_to_exp [] exp add_node_defs_to_exp [{tg_expr=([],_)}:generators] exp = add_node_defs_to_exp generators exp add_node_defs_to_exp [{tg_expr=(node_defs,_)}:generators] exp - = PE_Let cIsNotStrict (LocalParsedDefs node_defs) (add_node_defs_to_exp generators exp) + = PE_Let (LocalParsedDefs node_defs) (add_node_defs_to_exp generators exp) transformQualifier :: Qualifier *CollectAdmin -> (TransformedQualifier, *CollectAdmin) transformQualifier {qual_generators,qual_let_defs,qual_filter, qual_position, qual_filename} ca @@ -915,7 +915,7 @@ makeComprehensions [{tq_generators,tq_let_defs,tq_filter, tq_end, tq_call, tq_lh # failure = PE_List [PE_Ident tq_fun_id : threading ++ rhs_continuation_args_from_generators tq_generators] rhs = build_rhs tq_generators success tq_let_defs tq_filter failure tq_end tq_fun_pos parsed_def = MakeNewParsedDef tq_fun_id tq_lhs_args rhs tq_fun_pos - = (PE_Let cIsStrict (LocalParsedDefs [parsed_def]) tq_call, ca) + = (PE_Let (LocalParsedDefs [parsed_def]) tq_call, ca) where build_rhs :: [TransformedGenerator] ParsedExpr LocalDefs (Optional ParsedExpr) ParsedExpr ParsedExpr Position -> Rhs build_rhs [generator : generators] success let_defs optional_filter failure end fun_pos diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index b0a3ff9..d2a47c7 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -1293,7 +1293,7 @@ instance toString KindInfo | PE_Update !ParsedExpr [ParsedSelection] ParsedExpr | PE_Case !Ident !ParsedExpr [CaseAlt] | PE_If !Ident !ParsedExpr !ParsedExpr !ParsedExpr - | PE_Let !Bool !LocalDefs !ParsedExpr + | PE_Let !LocalDefs !ParsedExpr | PE_ListCompr /*predef_cons_index:*/ !Int /*predef_nil_index:*/ !Int !ParsedExpr ![Qualifier] | PE_ArrayCompr !ArrayKind !ParsedExpr ![Qualifier] | PE_Sequ Sequence diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 16ff61b..8d429c3 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -87,7 +87,7 @@ instance toString BasicType where toString BT_Dynamic = "Dynamic" toString BT_File = "File" toString BT_World = "World" - + instance <<< BasicType where (<<<) file bt = file <<< toString bt @@ -191,10 +191,10 @@ where = file <<< consid <<< ' ' <<< strictness <<< ' ' <<< types (<<<) file (arg_type --> res_type) = file <<< arg_type <<< " -> " <<< res_type - (<<<) file (type :@: types) - = file <<< type <<< " @" <<< types (<<<) file (TB tb) = file <<< tb + (<<<) file (type :@: types) + = file <<< type <<< " @" <<< types (<<<) file TArrow = file <<< "(->)" (<<<) file (TArrow1 t) @@ -505,7 +505,7 @@ where (<<<) file (PE_Lambda _ exprs expr _) = file <<< '\\' <<< exprs <<< " -> " <<< expr (<<<) file (PE_Bound bind) = file <<< bind (<<<) file (PE_Case _ expr alts) = file <<< "case " <<< expr <<< " of\n" <<< alts - (<<<) file (PE_Let _ defs expr) = file <<< "let " <<< defs <<< " in\n" <<< expr + (<<<) file (PE_Let defs expr) = file <<< "let " <<< defs <<< " in\n" <<< expr (<<<) file (PE_DynamicPattern expr type) = file <<< expr <<< "::" <<< type (<<<) file (PE_Dynamic expr maybetype) = case maybetype of |