diff options
| author | Camil Staps | 2017-03-06 21:46:49 +0100 |
|---|---|---|
| committer | Camil Staps | 2017-03-06 21:46:49 +0100 |
| commit | 39c83f3491142e227bd846dfd4bf729b3dcbbe48 (patch) | |
| tree | 79ec16c56e09836c5b0788a22cdcdfceff490667 | |
| parent | check imports of types that occur only in a cached definition module, (diff) | |
Lambda-case
| -rw-r--r-- | frontend/parse.icl | 27 | ||||
| -rw-r--r-- | frontend/typesupport.icl | 3 |
2 files changed, 26 insertions, 4 deletions
diff --git a/frontend/parse.icl b/frontend/parse.icl index be4cbaa..82a88e3 100644 --- a/frontend/parse.icl +++ b/frontend/parse.icl @@ -3674,6 +3674,20 @@ string_to_int s trySimpleNonLhsExpressionT :: !Token *ParseState -> *(!Bool,!ParsedExpr,!*ParseState) trySimpleNonLhsExpressionT BackSlashToken pState + # (token, pState) = nextToken FunctionContext pState + | token == CaseToken + # (lam_ident, pState) = internalIdent "_lcl" pState + (case_ident, pState) = internalIdent "_lcc" pState + (arg_ident, pState) = internalIdent "_lca" pState + (alts, pState) = wantCaseOfExp pState + (file_name, line_nr, pState) + = getFileAndLineNr pState + position = FunPos file_name line_nr lam_ident.id_name + expr = PE_Case case_ident (PE_Ident arg_ident) alts + ewl = {ewl_nodes = [], ewl_expr = expr, ewl_locals = LocalParsedDefs [], ewl_position = LinePos file_name line_nr} + rhs = {rhs_alts = UnGuardedExpr ewl, rhs_locals = LocalParsedDefs []} + = (True, PE_Lambda lam_ident [PE_Ident arg_ident] rhs position, pState) + # pState = tokenBack pState # (lam_ident, pState) = internalIdent (toString backslash) pState (file_name, line_nr, pState) = getFileAndLineNr pState @@ -4162,15 +4176,20 @@ where wantCaseExp :: !ParseState -> (ParsedExpr, !ParseState) wantCaseExp pState # (case_ident, pState) = internalIdent "_c" pState - (case_exp, pState) = wantExpression pState - pState = wantToken FunctionContext "case expression" OfToken pState + # (case_exp, pState) = wantExpression pState + # (alts, pState) = wantCaseOfExp pState + = (PE_Case case_ident case_exp alts, pState) + +wantCaseOfExp :: !ParseState -> ([CaseAlt], !ParseState) +wantCaseOfExp pState + # pState = wantToken FunctionContext "case expression" OfToken pState pState = wantBeginGroup "case" pState (case_alts, (definingSymbol,pState)) = parseList tryCaseAlt (RhsDefiningSymbolCase, pState) (found, alt, pState) = tryLastCaseAlt definingSymbol pState | found - = (PE_Case case_ident case_exp (case_alts++[alt]), wantEndCase pState) - = (PE_Case case_ident case_exp case_alts, wantEndCase pState) + = ((case_alts++[alt]), wantEndCase pState) + = (case_alts, wantEndCase pState) where tryCaseAlt :: (!RhsDefiningSymbol, !ParseState) -> (!Bool, CaseAlt, (!RhsDefiningSymbol, !ParseState)) tryCaseAlt (definingSymbol, pState) diff --git a/frontend/typesupport.icl b/frontend/typesupport.icl index 9ef0616..bce446c 100644 --- a/frontend/typesupport.icl +++ b/frontend/typesupport.icl @@ -1832,6 +1832,9 @@ optBeautifulizeIdent id_name = No where prefix_to_readable_name "_c" = "case" + prefix_to_readable_name "_lcl" = "lambdacase" + prefix_to_readable_name "_lcc" = "lambdacase" + prefix_to_readable_name "_lca" = "lambdacase" prefix_to_readable_name "_g" = "guard" prefix_to_readable_name "_f" = "filter" prefix_to_readable_name "_if" = "if" |