diff options
| -rw-r--r-- | frontend/check.icl | 37 | ||||
| -rw-r--r-- | frontend/parse.icl | 23 | ||||
| -rw-r--r-- | frontend/postparse.icl | 13 | ||||
| -rw-r--r-- | frontend/syntax.dcl | 13 | ||||
| -rw-r--r-- | frontend/syntax.icl | 12 |
5 files changed, 65 insertions, 33 deletions
diff --git a/frontend/check.icl b/frontend/check.icl index ba336a5..bb20b13 100644 --- a/frontend/check.icl +++ b/frontend/check.icl @@ -1721,13 +1721,14 @@ checkRhssAndTransformLocalDefs free_vars loc_defs rhs_expr e_input e_state e_inf (rhs_expr, es_expr_heap) = buildLetExpression [] binds rhs_expr e_state.es_expr_heap = (rhs_expr, free_vars, { e_state & es_expr_heap = es_expr_heap }, e_info, cs) -checkAndTransformPatternIntoBind free_vars [{nd_dst,nd_alts,nd_locals} : local_defs] e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs +checkAndTransformPatternIntoBind free_vars [{nd_dst,nd_alts,nd_locals,nd_position} : local_defs] e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs + # cs = pushErrorAdmin (newPosition {id_name="node definition", id_info=nilPtr} nd_position) cs # (bind_src, free_vars, e_state, e_info, cs) = checkRhs free_vars nd_alts nd_locals e_input e_state e_info cs (binds_of_bind, es_var_heap, es_expr_heap, e_info, cs) = transfromPatternIntoBind ei_mod_index ei_expr_level nd_dst bind_src e_state.es_var_heap e_state.es_expr_heap e_info cs e_state = { e_state & es_var_heap = es_var_heap, es_expr_heap = es_expr_heap } (binds_of_local_defs, free_vars, e_state, e_info, cs) = checkAndTransformPatternIntoBind free_vars local_defs e_input e_state e_info cs - = (binds_of_bind ++ binds_of_local_defs, free_vars, e_state, e_info, cs) + = (binds_of_bind ++ binds_of_local_defs, free_vars, e_state, e_info, popErrorAdmin cs) checkAndTransformPatternIntoBind free_vars [] e_input e_state e_info cs = ([], free_vars, e_state, e_info, cs) @@ -1890,23 +1891,27 @@ where check_guarded_expressions free_vars [] let_vars_list rev_guarded_exprs {ei_expr_level} e_state e_info cs = (let_vars_list, rev_guarded_exprs, ei_expr_level, free_vars, e_state, e_info, cs) - check_guarded_expression free_vars {alt_nodes,alt_guard,alt_expr,alt_ident} + check_guarded_expression free_vars {alt_nodes,alt_guard,alt_expr,alt_ident,alt_position} let_vars_list rev_guarded_exprs e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs # (let_binds, let_vars_list, ei_expr_level, free_vars, e_state, e_info, cs) = check_sequential_lets free_vars alt_nodes let_vars_list { e_input & ei_expr_level = inc ei_expr_level } e_state e_info cs e_input = { e_input & ei_expr_level = ei_expr_level } + cs = pushErrorAdmin (newPosition { id_name = "guard", id_info = nilPtr } 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 ) // JVG: added type check_unguarded_expression :: [FreeVar] ExprWithLocalDefs ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState); - check_unguarded_expression free_vars {ewl_nodes,ewl_expr,ewl_locals} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs + check_unguarded_expression free_vars {ewl_nodes,ewl_expr,ewl_locals,ewl_position} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs # this_expr_level = inc ei_expr_level (loc_defs, (var_env, array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs this_expr_level ei_mod_index ewl_locals e_state e_info cs (binds, let_vars_list, rhs_expr_level, free_vars, e_state, e_info, cs) = check_sequential_lets free_vars ewl_nodes [] { e_input & ei_expr_level = this_expr_level } e_state e_info cs + cs = pushErrorAdmin (newPosition { id_name = "", id_info = nilPtr } ewl_position) cs (expr, free_vars, e_state, e_info, cs) = checkExpression free_vars ewl_expr { e_input & ei_expr_level = rhs_expr_level } e_state e_info cs + cs = popErrorAdmin cs (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 } @@ -1926,17 +1931,22 @@ where = remove_seq_let_vars (dec level) let_vars_list (removeLocalIdentsFromSymbolTable level let_vars symbol_table) 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 - e_input = { e_input & ei_expr_level = ei_expr_level } - (src_expr, pattern_expr, (let_vars, array_patterns), free_vars, e_state, e_info, cs) = check_sequential_let free_vars seq_let e_input e_state e_info cs + # ei_expr_level + = inc ei_expr_level + e_input + = { e_input & ei_expr_level = ei_expr_level } + (src_expr, pattern_expr, (let_vars, array_patterns), free_vars, e_state, e_info, cs) + = check_sequential_let free_vars seq_let e_input e_state e_info cs (binds, loc_envs, max_expr_level, free_vars, e_state, e_info, cs) = check_sequential_lets free_vars seq_lets [let_vars : let_vars_list] e_input e_state e_info cs (let_binds, es_var_heap, es_expr_heap, e_info, cs) = transfromPatternIntoBind ei_mod_index ei_expr_level pattern_expr src_expr e_state.es_var_heap e_state.es_expr_heap e_info 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 } (strict_array_pattern_binds, lazy_array_pattern_binds, free_vars, e_state, e_info, cs) = foldSt (buildSelections e_input) array_patterns ([], [], free_vars, e_state, e_info, cs) - all_binds = [if seq_let.ndwl_strict (s, l) ([],let_binds), (strict_array_pattern_binds, lazy_array_pattern_binds) : binds] + all_binds + = [if seq_let.ndwl_strict (s, l) ([],let_binds), (strict_array_pattern_binds, lazy_array_pattern_binds) : binds] with (l,s) = splitAt ((length let_binds)-1) let_binds = (all_binds, loc_envs, max_expr_level, free_vars, e_state, e_info, cs) check_sequential_lets free_vars [] let_vars_list e_input=:{ei_expr_level} e_state e_info cs @@ -1944,8 +1954,9 @@ where // JVG: added type check_sequential_let :: [FreeVar] NodeDefWithLocals ExpressionInput *ExpressionState *ExpressionInfo *CheckState -> *(!Expression,!AuxiliaryPattern,!(![Ident],![ArrayPattern]),![FreeVar],!*ExpressionState,!*ExpressionInfo,!*CheckState); - check_sequential_let free_vars {ndwl_def={bind_src,bind_dst},ndwl_locals} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs - # (loc_defs, (loc_env, loc_array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index ndwl_locals e_state e_info cs + check_sequential_let free_vars {ndwl_def={bind_src,bind_dst},ndwl_locals, ndwl_position} e_input=:{ei_expr_level,ei_mod_index} e_state e_info cs + # cs = pushErrorAdmin (newPosition {id_name="node definition", id_info=nilPtr} ndwl_position) cs + (loc_defs, (loc_env, loc_array_patterns), e_state, e_info, cs) = checkLhssOfLocalDefs ei_expr_level ei_mod_index ndwl_locals e_state e_info cs (src_expr, free_vars, e_state, e_info, cs) = checkExpression free_vars bind_src e_input e_state e_info cs (src_expr, free_vars, e_state, e_info, cs) = addArraySelections loc_array_patterns src_expr free_vars e_input e_state e_info cs @@ -1958,7 +1969,7 @@ where = checkPattern bind_dst No { pi_def_level = ei_expr_level, pi_mod_index = ei_mod_index, pi_is_node_pattern = True } ([], []) {ps_var_heap = hp_var_heap, ps_fun_defs = es_fun_defs } e_info { cs & cs_symbol_table = cs_symbol_table } e_state = { e_state & es_var_heap = ps_var_heap, es_expr_heap = hp_expression_heap, es_type_heaps = hp_type_heaps, es_fun_defs = ps_fun_defs } - = (src_expr, pattern, accus, free_vars, e_state, e_info, cs) + = (src_expr, pattern, accus, free_vars, e_state, e_info, popErrorAdmin cs) build_sequential_lets :: ![(![Bind Expression FreeVar],![Bind Expression FreeVar])] !Expression !*ExpressionHeap -> (!Expression, !*ExpressionHeap) build_sequential_lets [] expr expr_heap @@ -3230,9 +3241,7 @@ where <=< adjust_predef_symbol PD_TypeConsSymbol mod_index STE_Constructor <=< adjust_predef_symbol PD_variablePlaceholder mod_index STE_Constructor <=< adjust_predef_symbol PD_unify mod_index STE_DclFunction -// MV .. <=< adjust_predef_symbol PD_coerce mod_index STE_DclFunction -// .. MV <=< adjust_predef_symbol PD_undo_indirections mod_index STE_DclFunction) = (class_members, class_instances, fun_types, { cs & cs_predef_symbols = cs_predef_symbols}) where diff --git a/frontend/parse.icl b/frontend/parse.icl index 277a522..cd9ffa4 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -552,10 +552,12 @@ where wantCodeRhs :: !ParseState -> (Rhs, !ParseState) wantCodeRhs pState # (expr, pState) = want_code_expr pState + (file_name, line_nr, pState) = getFileAndLineNr pState // MW++ = ( { rhs_alts = UnGuardedExpr { ewl_nodes = [] , ewl_locals = LocalParsedDefs [] , ewl_expr = expr + , ewl_position = LinePos file_name line_nr // MW++ } , rhs_locals = LocalParsedDefs [] } @@ -645,7 +647,7 @@ where want_FunctionBody :: !Token ![NodeDefWithLocals] ![GuardedExpr] !(Token -> Bool) !ParseState -> (!OptGuardedAlts, !ParseState) want_FunctionBody BarToken nodeDefs alts sep pState // # (lets, pState) = want_StrictLet pState // removed from 2.0 - # (guard_position, pState) = getPosition pState // MW4++ + # (file_name, line_nr, pState)= getFileAndLineNr pState // MW4++ (token, pState) = nextToken FunctionContext pState | token == OtherwiseToken # (token, pState) = nextToken FunctionContext pState @@ -668,7 +670,7 @@ where pState = wantEndNestedGuard (default_found expr) offside pState // MW4 was: alt = { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr } alt = { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr, - alt_ident = guard_ident guard_position.fp_line } + alt_ident = guard_ident line_nr, alt_position = LinePos file_name line_nr } (token, pState) = nextToken FunctionContext pState (nodeDefs, token, pState) = want_LetBefores token pState = want_FunctionBody token nodeDefs [alt:alts] sep pState @@ -676,7 +678,7 @@ where # (expr, pState) = root_expression True token nodeDefs2 [] sep pState // MW4 was: alt = { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr } alt = { alt_nodes = nodeDefs, alt_guard = guard, alt_expr = expr, - alt_ident = guard_ident guard_position.fp_line } + alt_ident = guard_ident line_nr, alt_position = LinePos file_name line_nr } (token, pState) = nextToken FunctionContext pState (nodeDefs, token, pState) = want_LetBefores token pState = want_FunctionBody token nodeDefs [alt:alts] sep pState @@ -690,10 +692,12 @@ where root_expression :: !Bool !Token ![NodeDefWithLocals] ![GuardedExpr] !(Token -> Bool) !ParseState -> (!OptGuardedAlts, !ParseState) root_expression withExpected token nodeDefs [] sep pState - # (expr,pState) = want_OptExprWithLocals withExpected token nodeDefs sep pState + # (file_name, line_nr, pState) = getFileAndLineNr pState // MW++ + (expr,pState) = want_OptExprWithLocals withExpected token nodeDefs sep pState = case expr of Yes expr -> ( UnGuardedExpr expr, pState) - No -> ( UnGuardedExpr {ewl_nodes = [], ewl_expr = PE_Empty, ewl_locals = LocalParsedDefs []} + No -> ( UnGuardedExpr {ewl_nodes = [], ewl_expr = PE_Empty, ewl_locals = LocalParsedDefs [], + ewl_position = LinePos file_name line_nr} , parseError "RHS: root expression" (Yes token) "= <ExprWithLocals>" pState ) root_expression withExpected token nodeDefs alts sep pState @@ -708,12 +712,14 @@ where = want_OptExprWithLocals True EqualToken nodeDefs sep (replaceToken EqualToken pState) want_OptExprWithLocals withExpected token nodeDefs sep pState | sep token - # (expr, pState) = wantExpression cIsNotAPattern pState + # (file_name, line_nr, pState) = getFileAndLineNr pState // MW++ + (expr, pState) = wantExpression cIsNotAPattern pState pState = wantEndRootExpression pState (locals,pState) = optionalLocals WithToken withExpected pState = ( Yes { ewl_nodes = nodeDefs , ewl_expr = expr , ewl_locals = locals + , ewl_position = LinePos file_name line_nr // MW++ } , pState ) @@ -753,6 +759,8 @@ where # (succ, lhs_exp, pState) = trySimpleLhsExpression pState | succ # pState = wantToken FunctionContext "let definition" EqualToken pState + (file_name, line_nr, pState) + = getFileAndLineNr pState // MW++ (rhs_exp, pState) = wantExpression cIsNotAPattern pState pState = wantEndRootExpression pState -->> ("#",lhs_exp,"=",rhs_exp) (locals , pState) = optionalLocals WithToken localsExpected pState @@ -762,6 +770,8 @@ where , bind_src = rhs_exp } , ndwl_locals = locals + , ndwl_position + = LinePos file_name line_nr // MW++ } , pState ) @@ -2225,6 +2235,7 @@ buildNodeDef lhsExpr rhsExpr { ewl_nodes = [] , ewl_locals = LocalParsedDefs [] , ewl_expr = rhsExpr + , ewl_position = NoPos // MW++ } , rhs_locals = LocalParsedDefs [] diff --git a/frontend/postparse.icl b/frontend/postparse.icl index 8a10a7e..6ef3cc4 100644 --- a/frontend/postparse.icl +++ b/frontend/postparse.icl @@ -49,6 +49,7 @@ exprToRhs expr { ewl_nodes = [] , ewl_expr = expr , ewl_locals = LocalParsedDefs [] + , ewl_position= NoPos } , rhs_locals = LocalParsedDefs [] } @@ -304,7 +305,8 @@ NoCollectedLocalDefs :== CollectedLocalDefs { loc_functions = { ir_from = 0, ir_ transformLambda :: Ident [ParsedExpr] ParsedExpr Position -> FunDef // MW was:transformLambda lam_ident args result transformLambda lam_ident args result pos - # lam_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = result, ewl_locals = NoCollectedLocalDefs }, + # lam_rhs = { rhs_alts = UnGuardedExpr { ewl_nodes = [], ewl_expr = result, ewl_locals = NoCollectedLocalDefs, + ewl_position = NoPos }, rhs_locals = NoCollectedLocalDefs } // MW4 was: lam_body = [{pb_args = args, pb_rhs = lam_rhs }] lam_body = [{pb_args = args, pb_rhs = lam_rhs, pb_position = pos }] @@ -589,8 +591,9 @@ makeComprehensions [{tq_generators, tq_filter, tq_end, tq_call, tq_lhs_args, tq_ -> optGuardedAltToRhs (GuardedAlts [ {alt_nodes = [], alt_guard = filter, alt_expr = UnGuardedExpr // MW4 was: {ewl_nodes = [], ewl_expr = success, ewl_locals = LocalParsedDefs []}}] No) - {ewl_nodes = [], ewl_expr = success, ewl_locals = LocalParsedDefs []}, - alt_ident = { id_name ="_f;" +++ toString line_nr +++ ";", id_info = nilPtr }}] No) + {ewl_nodes = [], ewl_expr = success, ewl_locals = LocalParsedDefs [], ewl_position = NoPos }, + alt_ident = { id_name ="_f;" +++ toString line_nr +++ ";", id_info = nilPtr }, + alt_position = NoPos}] No) No -> exprToRhs success (LinePos _ line_nr) = fun_pos @@ -1012,7 +1015,7 @@ reorganiseDefinitions icl_module [] _ _ _ ca reorganiseLocalDefinitions :: [ParsedDefinition] *CollectAdmin -> ([FunDef],[(Optional SymbolType,NodeDef ParsedExpr)],*CollectAdmin) reorganiseLocalDefinitions [PD_NodeDef pos pattern {rhs_alts,rhs_locals} : defs] ca # (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca - = (fun_defs, [(No, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals }) : node_defs], ca) + = (fun_defs, [(No, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals, nd_position = pos }) : node_defs], ca) reorganiseLocalDefinitions [PD_Function pos name is_infix args rhs fun_kind : defs] ca # prio = if is_infix (Prio NoAssoc 9) NoPrio fun_arity = length args @@ -1034,7 +1037,7 @@ reorganiseLocalDefinitions [PD_TypeSpec pos1 name1 prio type specials : defs] ca [PD_NodeDef pos pattern=:(PE_Ident id) {rhs_alts,rhs_locals} : defs] | belongsToTypeSpec name1 prio id False # (fun_defs, node_defs, ca) = reorganiseLocalDefinitions defs ca - -> (fun_defs, [(type, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals }) : node_defs], ca) + -> (fun_defs, [(type, { nd_dst = pattern, nd_alts = rhs_alts, nd_locals = rhs_locals, nd_position = pos }) : node_defs], ca) -> reorganiseLocalDefinitions defs (postParseError pos "function body expected" ca) _ -> reorganiseLocalDefinitions defs (postParseError pos1 "function body expected" ca) diff --git a/frontend/syntax.dcl b/frontend/syntax.dcl index 32927ce..3f20612 100644 --- a/frontend/syntax.dcl +++ b/frontend/syntax.dcl @@ -112,7 +112,8 @@ NotALevel :== -1 :: NodeDef dst = { nd_dst ::!dst, nd_alts ::!OptGuardedAlts, - nd_locals ::!LocalDefs + nd_locals ::!LocalDefs, + nd_position ::!Position } :: Rhs = @@ -882,18 +883,21 @@ cNonRecursiveAppl :== False , alt_guard :: !ParsedExpr , alt_expr :: !OptGuardedAlts , alt_ident :: !Ident + , alt_position:: !Position } :: ExprWithLocalDefs = { ewl_nodes :: ![NodeDefWithLocals] , ewl_expr :: !ParsedExpr , ewl_locals :: !LocalDefs + , ewl_position:: !Position } :: NodeDefWithLocals = - { ndwl_strict :: !Bool - , ndwl_def :: !Bind ParsedExpr ParsedExpr - , ndwl_locals :: !LocalDefs + { ndwl_strict :: !Bool + , ndwl_def :: !Bind ParsedExpr ParsedExpr + , ndwl_locals :: !LocalDefs + , ndwl_position :: !Position } :: CaseAlt = @@ -985,6 +989,7 @@ cIsNotStrict :== False | Let !Let | Case !Case | Selection !(Optional (Global DefinedSymbol)) !Expression ![Selection] + // Yes: a "!" selection | Update !Expression ![Selection] Expression | RecordUpdate !(Global DefinedSymbol) !Expression ![Bind Expression (Global FieldSymbol)] | TupleSelect !DefinedSymbol !Int !Expression diff --git a/frontend/syntax.icl b/frontend/syntax.icl index 995b10a..e695103 100644 --- a/frontend/syntax.icl +++ b/frontend/syntax.icl @@ -115,7 +115,8 @@ NotALevel :== -1 :: NodeDef dst = { nd_dst ::!dst, nd_alts ::!OptGuardedAlts, - nd_locals ::!LocalDefs + nd_locals ::!LocalDefs, + nd_position ::!Position } :: Rhs = @@ -846,18 +847,21 @@ cNotVarNumber :== -1 , alt_guard :: !ParsedExpr , alt_expr :: !OptGuardedAlts , alt_ident :: !Ident + , alt_position:: !Position } :: ExprWithLocalDefs = { ewl_nodes :: ![NodeDefWithLocals] , ewl_expr :: !ParsedExpr , ewl_locals :: !LocalDefs + , ewl_position:: !Position } :: NodeDefWithLocals = - { ndwl_strict :: !Bool - , ndwl_def :: !Bind ParsedExpr ParsedExpr - , ndwl_locals :: !LocalDefs + { ndwl_strict :: !Bool + , ndwl_def :: !Bind ParsedExpr ParsedExpr + , ndwl_locals :: !LocalDefs + , ndwl_position :: !Position } |