diff options
Diffstat (limited to 'src/boot/fe')
| -rw-r--r-- | src/boot/fe/ast.ml | 8 | ||||
| -rw-r--r-- | src/boot/fe/item.ml | 30 |
2 files changed, 23 insertions, 15 deletions
diff --git a/src/boot/fe/ast.ml b/src/boot/fe/ast.ml index 09037510..770b57bf 100644 --- a/src/boot/fe/ast.ml +++ b/src/boot/fe/ast.ml @@ -299,9 +299,14 @@ and domain = DOMAIN_local | DOMAIN_thread +(* + * PAT_tag uses lval for the tag constructor so that we can reuse our lval + * resolving machinery. The lval is restricted during parsing to have only + * named components. + *) and pat = PAT_lit of lit - | PAT_tag of ((name identified) * (pat array)) + | PAT_tag of (lval * (pat array)) | PAT_slot of ((slot identified) * ident) | PAT_wild @@ -331,6 +336,7 @@ and lval_component = | COMP_atom of atom +(* identifying the name_base here is sufficient to identify the full lval *) and lval = LVAL_base of name_base identified | LVAL_ext of (lval * lval_component) diff --git a/src/boot/fe/item.ml b/src/boot/fe/item.ml index 209526e5..031b9e49 100644 --- a/src/boot/fe/item.ml +++ b/src/boot/fe/item.ml @@ -127,6 +127,16 @@ and parse_auto_slot_and_init and parse_stmts (ps:pstate) : Ast.stmt array = let apos = lexpos ps in + + let rec name_to_lval (apos:pos) (bpos:pos) (name:Ast.name) + : Ast.lval = + match name with + Ast.NAME_base nb -> + Ast.LVAL_base (span ps apos bpos nb) + | Ast.NAME_ext (n, nc) -> + Ast.LVAL_ext (name_to_lval apos bpos n, Ast.COMP_named nc) + in + match peek ps with LOG -> @@ -139,15 +149,6 @@ and parse_stmts (ps:pstate) : Ast.stmt array = bump ps; begin - let rec name_to_lval (bpos:pos) (name:Ast.name) - : Ast.lval = - match name with - Ast.NAME_base nb -> - Ast.LVAL_base (span ps apos bpos nb) - | Ast.NAME_ext (n, nc) -> - Ast.LVAL_ext (name_to_lval bpos n, Ast.COMP_named nc) - in - let rec carg_path_to_lval (bpos:pos) (path:Ast.carg_path) : Ast.lval = match path with @@ -171,7 +172,7 @@ and parse_stmts (ps:pstate) : Ast.stmt array = let synthesise_check_call (bpos:pos) (constr:Ast.constr) : (Ast.lval * (Ast.atom array)) = - let lval = name_to_lval bpos constr.Ast.constr_name in + let lval = name_to_lval apos bpos constr.Ast.constr_name in let args = Array.map (carg_to_atom bpos) constr.Ast.constr_args in @@ -243,13 +244,14 @@ and parse_stmts (ps:pstate) : Ast.stmt array = |_ -> raise (unexpected ps) end else - let pats = - paren_comma_list parse_pat ps - in - Ast.PAT_tag ((span ps apos bpos name), pats) + let lv = name_to_lval apos bpos name in + Ast.PAT_tag (lv, paren_comma_list parse_pat ps) + | LIT_INT _ | LIT_CHAR _ | LIT_BOOL _ -> Ast.PAT_lit (Pexp.parse_lit ps) + | UNDERSCORE -> bump ps; Ast.PAT_wild + | tok -> raise (Parse_err (ps, "Expected pattern but found '" ^ (string_of_tok tok) ^ "'")) |