diff options
| -rw-r--r-- | frontend/parse.icl | 59 |
1 files changed, 40 insertions, 19 deletions
diff --git a/frontend/parse.icl b/frontend/parse.icl index c1a1fef..fb691bc 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -568,7 +568,7 @@ where # (type_FIELD_ident, pState)= stringToIdent "FIELD" IC_Type pState # (type_OBJECT_ident, pState)= stringToIdent "OBJECT" IC_Type pState # (generic_ident, pState) = stringToIdent name IC_Generic pState - + # (type_cons, pState) = get_type_cons type pState with get_type_cons (TA type_symb []) pState @@ -1038,7 +1038,7 @@ where want_OptExprWithLocals withExpected token nodeDefs definingSymbol pState | isDefiningSymbol definingSymbol token # (file_name, line_nr, pState) = getFileAndLineNr pState - (expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + (expr, pState) = wantExpression pState pState = wantEndRootExpression pState (locals,pState) = optionalLocals WithToken withExpected pState = ( Yes { ewl_nodes = nodeDefs @@ -1126,7 +1126,7 @@ where # pState = wantToken FunctionContext "let definition" EqualToken pState (file_name, line_nr, pState) = getFileAndLineNr pState - (rhs_exp, pState) = wantExpressionOrPattern cIsNotAPattern pState + (rhs_exp, pState) = wantExpression pState pState = wantEndRootExpression pState -->> ("#",lhs_exp,"=",rhs_exp) (locals , pState) = optionalLocals WithToken localsExpected pState = ( True @@ -2711,18 +2711,39 @@ wantExpressionOrPattern is_pattern pState # (token, pState) = nextToken FunctionContext pState = case token of CharListToken charList // To produce a better error message - -> (PE_Empty, parseError "Expression" No ("List brackets, [ and ], around charlist '"+charList+"'") pState) + -> charListError charList pState _ | is_pattern -> wantPatternT token pState -> wantExpressionT token pState +wantPattern :: !ParseState -> (!ParsedExpr, !ParseState) +wantPattern pState + # (token, pState) = nextToken FunctionContext pState + = case token of + CharListToken charList // To produce a better error message + -> charListError charList pState + _ + -> wantPatternT token pState + +wantExpression :: !ParseState -> (!ParsedExpr, !ParseState) +wantExpression pState + # (token, pState) = nextToken FunctionContext pState + = case token of + CharListToken charList // To produce a better error message + -> charListError charList pState + _ + -> wantExpressionT token pState + +charListError charList pState + = (PE_Empty, parseError "Expression" No ("List brackets, [ and ], around charlist '"+charList+"'") pState) + wantExpressionT :: !Token !ParseState -> (!ParsedExpr, !ParseState) // FIXME, case, let and if expression should also be recognised here // and not in trySimpleNonLhsExpressionT, for example // Start = id if True id id id 17 // is currently allowed wantExpressionT DynamicToken pState - # (dyn_expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + # (dyn_expr, pState) = wantExpression pState (token, pState) = nextToken FunctionContext pState | token == DoubleColonToken # (dyn_type, pState) = wantDynamicType pState @@ -2851,7 +2872,7 @@ where where want_array_selectors :: !*ParseState -> *(![ParsedSelection], !*ParseState) want_array_selectors pState - # (index_expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + # (index_expr, pState) = wantExpression pState selector = PS_Array index_expr (token, pState) = nextToken FunctionContext pState | token == CommaToken @@ -3001,7 +3022,7 @@ trySimpleNonLhsExpressionT BackSlashToken pState = getFileAndLineNr pState (lam_args, pState) = wantList "arguments" trySimplePattern pState pState = want_lambda_sep pState - (exp, pState) = wantExpressionOrPattern cIsNotAPattern pState + (exp, pState) = wantExpression pState position = FunPos file_name line_nr lam_ident.id_name = (True, PE_Lambda lam_ident lam_args exp position, pState) where @@ -3017,7 +3038,7 @@ trySimpleNonLhsExpressionT (LetToken strict) pState // let! is not supported in // otherwise # (let_binds, pState) = wantLocals pState pState = wantToken FunctionContext "let expression" InToken pState - (let_expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + (let_expr, pState) = wantExpression pState = (True, PE_Let strict let_binds let_expr, pState) trySimpleNonLhsExpressionT CaseToken pState # (case_exp, pState) = wantCaseExp pState @@ -3332,7 +3353,7 @@ where want_qualifier pState # (qual_position, pState) = getPosition pState (qual_filename, pState) = accScanState getFilename pState - (lhs_expr, pState) = wantExpressionOrPattern cIsAPattern pState + (lhs_expr, pState) = wantPattern pState (token, pState) = nextToken FunctionContext pState | token == LeftArrowToken = want_generators IsListGenerator (toLineAndColumn qual_position) qual_filename lhs_expr pState @@ -3346,7 +3367,7 @@ where want_generators :: !GeneratorKind !LineAndColumn !FileName !ParsedExpr !ParseState -> (!Qualifier, !ParseState) want_generators gen_kind qual_position qual_filename pattern_exp pState # (gen_position, pState) = getPosition pState - # (gen_expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + # (gen_expr, pState) = wantExpression pState (token, pState) = nextToken FunctionContext pState generator = { gen_kind = gen_kind, gen_expr = gen_expr, gen_pattern = pattern_exp, gen_position = toLineAndColumn gen_position } @@ -3359,7 +3380,7 @@ where parse_optional_lets_and_filter :: !Token !ParseState -> (!LocalDefs,!Optional ParsedExpr,!ParseState) parse_optional_lets_and_filter BarToken pState - # (filter_expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + # (filter_expr, pState) = wantExpression pState = (LocalParsedDefs [], Yes filter_expr,pState) parse_optional_lets_and_filter CommaToken pState # (token, pState) = nextToken FunctionContext pState @@ -3374,7 +3395,7 @@ where parse_optional_filter :: !Token !ParseState -> (!Optional ParsedExpr,!ParseState) parse_optional_filter BarToken pState - # (filter_expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + # (filter_expr, pState) = wantExpression pState = (Yes filter_expr,pState) parse_optional_filter token pState = (No,tokenBack pState) @@ -3386,7 +3407,7 @@ where wantCaseExp :: !ParseState -> (ParsedExpr, !ParseState) wantCaseExp pState # (case_ident, pState) = internalIdent "_c" pState - (case_exp, pState) = wantExpressionOrPattern cIsNotAPattern pState + (case_exp, pState) = wantExpression pState pState = wantToken FunctionContext "case expression" OfToken pState pState = wantBeginGroup "case" pState (case_alts, (definingSymbol,pState)) @@ -3536,7 +3557,7 @@ where want_more_array_elems CurlyCloseToken pState = ([], pState) want_more_array_elems CommaToken pState - # (elem, pState) = wantExpressionOrPattern cIsNotAPattern pState + # (elem, pState) = wantExpression pState (token, pState) = nextToken FunctionContext pState (elems, pState) = want_more_array_elems token pState = ([elem : elems], pState) @@ -3603,7 +3624,7 @@ where # (selectors, pState) = wantSelectors token pState (token, pState) = nextToken FunctionContext pState | token == EqualToken - # (expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + # (expr, pState) = wantExpression pState = ({nu_selectors = selectors, nu_update_expr = expr}, pState) = ({nu_selectors = selectors, nu_update_expr = PE_Empty}, parseError "field assignment" (Yes token) "=" pState) @@ -3809,7 +3830,7 @@ try_field_assignment (IdentToken field_name) pState | isLowerCaseName field_name # (token, pState) = nextToken FunctionContext pState | token == EqualToken - # (field_expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + # (field_expr, pState) = wantExpression pState (field_id, pState) = stringToIdent field_name IC_Selector pState = (True, { bind_src = field_expr, bind_dst = FieldName field_id}, pState) = (False, abort "no field", tokenBack pState) @@ -3818,7 +3839,7 @@ try_field_assignment (QualifiedIdentToken module_name field_name) pState | isLowerCaseName field_name # (token, pState) = nextToken FunctionContext pState | token == EqualToken - # (field_expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + # (field_expr, pState) = wantExpression pState (module_id, pState) = stringToIdent module_name (IC_Module NoQualifiedIdents) pState = (True, { bind_src = field_expr, bind_dst = QualifiedFieldName module_id field_name}, pState) = (False, abort "no field", tokenBack pState) @@ -3899,11 +3920,11 @@ where want_array_assignment pState # (index_exprs, pState) = want_index_exprs pState pState = wantToken FunctionContext "array assignment" EqualToken pState - (pattern_exp, pState) = wantExpressionOrPattern cIsAPattern pState + (pattern_exp, pState) = wantPattern pState = ({bind_dst = index_exprs, bind_src = pattern_exp}, pState) want_index_exprs pState - # (index_expr, pState) = wantExpressionOrPattern cIsNotAPattern pState + # (index_expr, pState) = wantExpression pState (token, pState) = nextToken GeneralContext pState | token==CommaToken # (index_exprs, pState) = want_index_exprs pState |