From 8eb9ce3af8be8bf04381ab42cf6113626738e9f5 Mon Sep 17 00:00:00 2001 From: Jason Evans Date: Mon, 7 Mar 2022 21:10:17 -0800 Subject: [PATCH] Finish initial implementation of `hocc` parser (doesn't work correctly) --- bootstrap/bin/hocc/parse.ml | 464 ++++++++++++++++++++++++++++++++---- doc/tools/hocc.md | 50 ++-- 2 files changed, 450 insertions(+), 64 deletions(-) diff --git a/bootstrap/bin/hocc/parse.ml b/bootstrap/bin/hocc/parse.ml index 6e32c2a40..1be26cf44 100644 --- a/bootstrap/bin/hocc/parse.ml +++ b/bootstrap/bin/hocc/parse.ml @@ -35,15 +35,20 @@ module Error = struct {source; msg} end -type uident = Scan.Token.t -and cident = Scan.Token.t +type uident = + | Uident of {uident: Scan.Token.t} +and cident = + | Cident of {cident: Scan.Token.t} and ident = | IdentUident of {uident: uident} | IdentCident of {cident: cident} - | IdentUnder of {under: Scan.Token.t} + | IdentUscore of {uscore: Scan.Token.t} +and precs_list_body_tl = + | PrecsListBodyTlSemiUident of {semi: Scan.Token.t; uident: uident; + precs_list_body_tl: precs_list_body_tl} + | PrecsListBodyTlEpsilon and precs_list_body = - | PrecsListBodyMulti of {precs_list_body: precs_list_body; semi: Scan.Token.t; uident: uident} - | PrecsListBodyOne of {uident: uident} + | PrecsListBody of {uident: uident; precs_list_body_tl: precs_list_body_tl} and precs = | PrecsList of {lbrack: Scan.Token.t; precs_list_body: precs_list_body; rbrack: Scan.Token.t} | PrecsOne of {uident: uident} @@ -51,22 +56,23 @@ and rel = | RelLt of {lt: Scan.Token.t} | RelEq of {eq: Scan.Token.t} | RelGt of {gt: Scan.Token.t} -and prec_rel = {rel: rel; precs: prec} +and prec_rel = + | PrecRel of {rel: rel; precs: precs} and prec_rels = - | PrecRelsMulti of {prec_rels: prec_rels; prec_rel: prec_rel} - | PrecRelsOne of {prec_rel: prec_rel} + | PrecRelsPrecRel of {prec_rel: prec_rel; prec_rels: prec_rels} + | PrecRelsEpsilon and prec_type = | PrecTypePrec of {prec: Scan.Token.t} | PrecTypeLeft of {left: Scan.Token.t} | PrecTypeRight of {right: Scan.Token.t} and prec = - | PrecRels of {prec_type: prec_type; uident: uident; prec_rels: prec_rels} - | Prec of {prec_type: prec_type; uident: uident} + | Prec of {prec_type: prec_type; uident: uident; prec_rels: prec_rels} and of_type = - | OfType of {of_: Scan.Token.t; type_module: cident; dot: Scan.Token.t; type_type: uident} + | OfTypeOfModuleDotType of {of_: Scan.Token.t; type_module: cident; dot: Scan.Token.t; + type_type: uident} | OfTypeEpsilon and prec_ref = - | PrecRef of {prec: Scan.Token.t; uident: uident} + | PrecRefPrecUident of {prec: Scan.Token.t; uident: uident} | PrecRefEpsilon and token = | Token of {token: Scan.Token.t; cident: cident; of_type: of_type; prec_ref: prec_ref} @@ -74,7 +80,7 @@ and sep = | SepSemi of {semi: Scan.Token.t} | SepLineDelim of {line_delim: Scan.Token.t} and codes_tl = - | CodesTl of {sep: sep; codes: codes; codes_tl: codes_tl} + | CodesTlSepCodes of {sep: sep; codes: codes; codes_tl: codes_tl} | CodesTlEpsilon and codes = | Codes of {code: code; codes_tl: codes_tl} @@ -88,23 +94,32 @@ and code = and prod_param_type = | ProdParamTypeUident of {uident: uident} | ProdParamTypeCident of {cident: cident} -and prod_param = {ident: ident; colon: Scan.Token.t; prod_param_type: prod_param_type} +and prod_param = + | ProdParam of {ident: ident; colon: Scan.Token.t; prod_param_type: prod_param_type} +and prod_params_tl = + | ProdParamsTlProdParam of {prod_param: prod_param; prod_params_tl: prod_params_tl} + | ProdParamsTlEpsilon and prod_params = - | ProdParamsMulti of {prod_params: prod_params; prod_param: prod_param} - | ProdParamsOne of {prod_param: prod_param} + | ProdParamsProdParam of {prod_param: prod_param; prod_params_tl: prod_params_tl} and prod_pattern = | ProdPatternParams of {prod_params: prod_params} | ProdPatternEpsilon of {epsilon: Scan.Token.t} and prod = | Prod of {prod_pattern: prod_pattern; prec_ref: prec_ref} +and prods_tl = + | ProdsTlBarProd of {bar: Scan.Token.t; prod: prod; prods_tl: prods_tl} + | ProdsTlEpsilon and prods = - | ProdsMulti of {prods: prods; bar: Scan.Token.t; prod: prod} - | ProdsOne of {prod: prod} -and reduce = {prods: prods; rarrow: Scan.Token.t; code: code} + | ProdsBarProd of {bar: Scan.Token.t; prod: prod; prods_tl: prods_tl} + | ProdsProd of {prod: prod; prods_tl: prods_tl} +and reduce = + | Reduce of {prods: prods; arrow: Scan.Token.t; code: code} +and reductions_tl = + | ReductionsTlBarReduce of {bar: Scan.Token.t; reduce: reduce; reductions_tl: reductions_tl} + | ReductionsTlEpsilon and reductions = - | ReductionsMulti of {reductions: reductions; bar: Scan.Token.t; reduce: reduce} - | ReductionsBarOne of {bar: Scan.Token.t; reduce: reduce} - | ReductionsOne of {reduce: reduce} + | ReductionsBarReduce of {bar: Scan.Token.t; reduce: reduce; reductions_tl: reductions_tl} + | ReductionsReduce of {reduce: reduce; reductions_tl: reductions_tl} and nonterm_type = | NontermTypeNonterm of {nonterm: Scan.Token.t} | NontermTypeStart of {start: Scan.Token.t} @@ -117,12 +132,12 @@ and stmt = | StmtNonterm of {nonterm: nonterm} | StmtCode of {code: code} and stmts_tl = - | StmtsTl of {sep: sep; stmt: stmt; stmts_tl: stmts_tl} + | StmtsTl of {line_delim: Scan.Token.t; stmt: stmt; stmts_tl: stmts_tl} | StmtsTlEpsilon and stmts = | Stmts of {stmt: stmt; stmts_tl: stmts_tl} and hocc = - | Hocc of {hocc: Scan.Token.t; stmts: stmts} + | Hocc of {hocc: Scan.Token.t; indent: Scan.Token.t; stmts: stmts; dedent: Scan.Token.t} and eoi = | Eoi of {token: Scan.Token.t} and matter = @@ -141,11 +156,15 @@ type ctx = { errs: Error.t list; } -let next {scanner; errs} = +(* XXX Specify ~all:true in Hemlock code productions. *) +let rec next ?(all=false) {scanner; errs} = let scanner', tok = Scan.next scanner in let errs' = List.fold (Scan.Token.malformations tok) ~init:errs ~f:(fun accum mal -> Error.init_mal mal :: accum) in - {scanner=scanner'; errs=errs'}, tok + let ctx' = {scanner=scanner'; errs=errs'} in + match all, tok with + | false, HmcToken {atok=(Tok_whitespace|Tok_hash_comment|Tok_paren_comment _); _} -> next ctx' + | _ -> ctx', tok let err msg {scanner; errs} = {scanner; errs=(Error.init_scanner scanner msg) :: errs} @@ -164,27 +183,372 @@ let mapr ~child ~f ctx = let map ~child ~f ctx = mapr ~child ~f:(fun ctx' c -> ctx', Some (f c)) ctx -let rec xxx () = () (* XXX *) +let rec uident ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_uident _; _} as uident -> ctx', Some (Uident {uident}) + | _ -> err_token tok "Expected uident" ctx, None + +and cident ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_cident _; _} as cident -> ctx', Some (Cident {cident}) + | _ -> err_token tok "Expected cident" ctx, None + +and ident ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_uident _; _} as uident -> + ctx', Some (IdentUident {uident=Uident {uident}}) + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_cident _; _} as cident -> + ctx', Some (IdentCident {cident=Cident {cident}}) + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_uscore; _} as uscore -> + ctx', Some (IdentUscore {uscore}) + | _ -> err_token tok "Expected ident" ctx, None + +and precs_list_body_tl ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_semi; _} as semi -> + mapr ~child:uident ~f:(fun ctx' uident -> + map ~child:precs_list_body_tl ~f:(fun precs_list_body_tl -> + PrecsListBodyTlSemiUident {semi; uident; precs_list_body_tl} + ) ctx' + ) ctx' + | _ -> ctx, Some PrecsListBodyTlEpsilon + +and precs_list_body ctx = + mapr ~child:uident ~f:(fun ctx' uident -> + map ~child:precs_list_body_tl ~f:(fun precs_list_body_tl -> + PrecsListBody {uident; precs_list_body_tl} + ) ctx' + ) ctx + +and precs ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_lbrack; _} as lbrack -> + let rbrack ctx = begin + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_rbrack; _} -> ctx', Some tok + | _ -> err_token tok "Expected ]" ctx, None + end in + mapr ~child:precs_list_body ~f:(fun ctx' precs_list_body -> + map ~child:rbrack ~f:(fun rbrack -> + PrecsList {lbrack; precs_list_body; rbrack} + ) ctx' + ) ctx' + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_uident _; _} as uident -> + ctx', Some (PrecsOne {uident=Uident {uident}}) + | _ -> err_token tok "Expected precedence(s)" ctx, None + +and rel ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_lt; _} as lt -> ctx', Some (RelLt {lt}) + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_eq; _} as eq -> ctx', Some (RelEq {eq}) + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_gt; _} as gt -> ctx', Some (RelGt {gt}) + | _ -> err_token tok "Expected token type" ctx, None + +and prec_rel ctx = + mapr ~child:rel ~f:(fun ctx' rel -> + map ~child:precs ~f:(fun precs -> + PrecRel {rel; precs} + ) ctx' + ) ctx + +and prec_rels ctx = + let ctx', prec_rel_opt = prec_rel ctx in + match prec_rel_opt with + | Some prec_rel -> + map ~child:prec_rels ~f:(fun prec_rels -> + PrecRelsPrecRel {prec_rel; prec_rels} + ) ctx' + | None -> ctx, Some PrecRelsEpsilon + +and prec_type ctx = + let ctx', tok = next ctx in + match tok with + | HoccToken {atok=Scan.AbstractToken.Tok_prec; _} as prec -> ctx', Some (PrecTypePrec {prec}) + | HoccToken {atok=Scan.AbstractToken.Tok_left; _} as left -> ctx', Some (PrecTypeLeft {left}) + | HoccToken {atok=Scan.AbstractToken.Tok_right; _} as right -> ctx', Some (PrecTypeRight {right}) + | _ -> err_token tok "Expected token type" ctx, None + +and prec ctx = + mapr ~child:prec_type ~f:(fun ctx' prec_type -> + mapr ~child:uident ~f:(fun ctx' uident -> + map ~child:prec_rels ~f:(fun prec_rels -> + Prec {prec_type; uident; prec_rels} + ) ctx' + ) ctx' + ) ctx + +and of_type ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_of; _} as of_ -> + let dot ctx = begin + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_dot; _} -> ctx', Some tok + | _ -> err_token tok "Expected ." ctx, None + end in + mapr ~child:cident ~f:(fun ctx' type_module -> + mapr ~child:dot ~f:(fun ctx' dot -> + map ~child:uident ~f:(fun type_type -> + OfTypeOfModuleDotType {of_; type_module; dot; type_type} + ) ctx' + ) ctx' + ) ctx' + | _ -> ctx, Some OfTypeEpsilon + +and prec_ref ctx = + let ctx', tok = next ctx in + match tok with + | HoccToken {atok=Scan.AbstractToken.Tok_prec; _} as prec -> + map ~child:uident ~f:(fun uident -> + PrecRefPrecUident {prec; uident} + ) ctx' + | _ -> ctx, Some PrecRefEpsilon + +and token ctx = + let ctx', tok = next ctx in + match tok with + | HoccToken {atok=Scan.AbstractToken.Tok_token; _} as token -> + mapr ~child:cident ~f:(fun ctx' cident -> + mapr ~child:of_type ~f:(fun ctx' of_type -> + map ~child:prec_ref ~f:(fun prec_ref -> + Token {token; cident; of_type; prec_ref} + ) ctx' + ) ctx' + ) ctx' + | _ -> err_token tok "Expected token" ctx, None and sep ctx = let ctx', tok = next ctx in match tok with - | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_semi; _} -> ctx', Some (SepSemi {semi=tok}) - | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_line_delim; _} -> - ctx', Some (SepLineDelim {line_delim=tok}) + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_semi; _} as semi -> ctx', Some (SepSemi {semi}) + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_line_delim; _} as line_delim -> + ctx', Some (SepLineDelim {line_delim}) | _ -> ctx, None +and codes_tl ctx = + let ctx', sep_opt = sep ctx in + match sep_opt with + | Some sep -> + mapr ~child:codes ~f:(fun ctx' codes -> + map ~child:codes_tl ~f:(fun codes_tl -> + CodesTlSepCodes {sep; codes; codes_tl} + ) ctx' + ) ctx' + | None -> ctx, Some CodesTlEpsilon + +and codes ctx = + mapr ~child:code ~f:(fun ctx' code -> + map ~child:codes_tl ~f:(fun codes_tl -> + Codes {code; codes_tl} + ) ctx' + ) ctx + +and indent ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_indent _; _} -> ctx', Some tok + | _ -> err_token tok "Expected indent" ctx, None + +and dedent ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_dedent _; _} -> ctx', Some tok + | _ -> err_token tok "Expected dedent" ctx, None + +and code_tl ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_indent _; _} as indent -> + mapr ~child:codes ~f:(fun ctx' codes -> + mapr ~child:dedent ~f:(fun ctx' dedent -> + map ~child:code_tl ~f:(fun code_tl -> + CodeTlBlock {indent; codes; dedent; code_tl} + ) ctx' + ) ctx' + ) ctx' + | HmcToken _ as token -> + map ~child:code_tl ~f:(fun code_tl -> + CodeTlToken {token; code_tl} + ) ctx' + | _ -> ctx, Some CodeTlEpsilon + and code ctx = - ctx, None (* XXX *) + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_indent _; _} as indent -> + mapr ~child:codes ~f:(fun ctx' codes -> + mapr ~child:dedent ~f:(fun ctx' dedent -> + map ~child:code_tl ~f:(fun code_tl -> + CodeBlock {indent; codes; dedent; code_tl} + ) ctx' + ) ctx' + ) ctx' + | HmcToken _ as token -> + map ~child:code_tl ~f:(fun code_tl -> + CodeToken {token; code_tl} + ) ctx' + | _ -> err_token tok "Expected Hemlock code" ctx, None -and prec ctx = - ctx, None (* XXX *) +and prod_param_type ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_uident _; _} as uident -> + ctx', Some (ProdParamTypeUident {uident=Uident {uident}}) + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_cident _; _} as cident -> + ctx', Some (ProdParamTypeCident {cident=Cident {cident}}) + | _ -> err_token tok "Expected production parameter type" ctx, None -and token ctx = - ctx, None (* XXX *) +and prod_param ctx = + let colon ctx = begin + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_colon; _} -> ctx', Some tok + | _ -> err_token tok "Expected :" ctx, None + end in + mapr ~child:ident ~f:(fun ctx' ident -> + mapr ~child:colon ~f:(fun ctx' colon -> + map ~child:prod_param_type ~f:(fun prod_param_type -> + ProdParam {ident; colon; prod_param_type} + ) ctx' + ) ctx' + ) ctx + +and prod_params_tl ctx = + let ctx', prod_param_opt = prod_param ctx in + match prod_param_opt with + | Some prod_param -> + map ~child:prod_params_tl ~f:(fun prod_params_tl -> + ProdParamsTlProdParam {prod_param; prod_params_tl} + ) ctx' + | None -> ctx, Some ProdParamsTlEpsilon + +and prod_params ctx = + mapr ~child:prod_param ~f:(fun ctx' prod_param -> + map ~child:prod_params_tl ~f:(fun prod_params_tl -> + ProdParamsProdParam {prod_param; prod_params_tl} + ) ctx' + ) ctx + +and prod_pattern ctx = + let ctx', tok = next ctx in + match tok with + | HoccToken {atok=Scan.AbstractToken.Tok_epsilon; _} as epsilon -> + ctx', Some (ProdPatternEpsilon {epsilon}) + | _ -> map ~child:prod_params ~f:(fun prod_params -> ProdPatternParams {prod_params}) ctx + +and prod ctx = + mapr ~child:prod_pattern ~f:(fun ctx' prod_pattern -> + map ~child:prec_ref ~f:(fun prec_ref -> + Prod {prod_pattern; prec_ref} + ) ctx' + ) ctx + +and prods_tl ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_bar; _} as bar -> + mapr ~child:prod ~f:(fun ctx' prod -> + map ~child:prods_tl ~f:(fun prods_tl -> + ProdsTlBarProd {bar; prod; prods_tl} + ) ctx' + ) ctx' + | _ -> ctx, Some ProdsTlEpsilon + +and prods ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_bar; _} as bar -> + mapr ~child:prod ~f:(fun ctx' prod -> + map ~child:prods_tl ~f:(fun prods_tl -> + ProdsBarProd {bar; prod; prods_tl} + ) ctx' + ) ctx' + | _ -> + mapr ~child:prod ~f:(fun ctx' prod -> + map ~child:prods_tl ~f:(fun prods_tl -> + ProdsProd {prod; prods_tl} + ) ctx' + ) ctx + +and reduce ctx = + let arrow ctx = begin + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_arrow; _} -> ctx', Some tok + | _ -> err_token tok "Expected ->" ctx, None + end in + mapr ~child:prods ~f:(fun ctx' prods -> + mapr ~child:arrow ~f:(fun ctx' arrow -> + map ~child:code ~f:(fun code -> + Reduce {prods; arrow; code} + ) ctx' + ) ctx' + ) ctx + +and reductions_tl ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_bar; _} as bar -> + mapr ~child:reduce ~f:(fun ctx' reduce -> + map ~child:reductions_tl ~f:(fun reductions_tl -> + ReductionsTlBarReduce {bar; reduce; reductions_tl} + ) ctx' + ) ctx' + | _ -> ctx, Some ReductionsTlEpsilon + +and reductions ctx = + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_bar; _} as bar -> + mapr ~child:reduce ~f:(fun ctx' reduce -> + map ~child:reductions_tl ~f:(fun reductions_tl -> + ReductionsBarReduce {bar; reduce; reductions_tl} + ) ctx' + ) ctx' + | _ -> + mapr ~child:reduce ~f:(fun ctx' reduce -> + map ~child:reductions_tl ~f:(fun reductions_tl -> + ReductionsReduce {reduce; reductions_tl} + ) ctx' + ) ctx + +and nonterm_type ctx = + let ctx', tok = next ctx in + match tok with + | HoccToken {atok=Scan.AbstractToken.Tok_nonterm; _} as nonterm -> + ctx', Some (NontermTypeNonterm {nonterm}) + | HoccToken {atok=Scan.AbstractToken.Tok_start; _} as start -> + ctx', Some (NontermTypeStart {start}) + | _ -> err_token tok "Expected nonterm/start" ctx, None and nonterm ctx = - ctx, None (* XXX *) + let cce ctx = begin + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_colon_op "::="; _} -> ctx', Some tok + | _ -> err_token tok "Expected ::=" ctx, None + end in + mapr ~child:nonterm_type ~f:(fun ctx' nonterm_type -> + mapr ~child:cident ~f:(fun ctx' cident -> + mapr ~child:of_type ~f:(fun ctx' of_type -> + mapr ~child:prec_ref ~f:(fun ctx' prec_ref -> + mapr ~child:cce ~f:(fun ctx' cce -> + map ~child:prods ~f:(fun prods -> + Nonterm {nonterm_type; cident; of_type; prec_ref; cce; prods} + ) ctx' + ) ctx' + ) ctx' + ) ctx' + ) ctx' + ) ctx and stmt ctx = let ctx', tok = next ctx in @@ -198,12 +562,18 @@ and stmt ctx = | _ -> map ~child:code ~f:(fun code -> StmtCode {code}) ctx and stmts_tl ctx = - let ctx', sep_opt = sep ctx in - match sep_opt with - | Some sep -> begin + let line_delim ctx = begin + let ctx', tok = next ctx in + match tok with + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_line_delim; _} -> ctx', Some tok + | _ -> err_token tok "Expected line delimiter" ctx, None + end in + let ctx', line_delim_opt = line_delim ctx in + match line_delim_opt with + | Some line_delim -> begin mapr ~child:stmt ~f:(fun ctx' stmt -> mapr ~child:stmts_tl ~f:(fun ctx' stmts_tl -> - ctx', Some (StmtsTl {sep; stmt; stmts_tl}) + ctx', Some (StmtsTl {line_delim; stmt; stmts_tl}) ) ctx' ) ctx' end @@ -219,14 +589,20 @@ and stmts ctx = and hocc ctx = let ctx', tok = next ctx in match tok with - | HoccToken {atok=Scan.AbstractToken.Tok_hocc; _} -> - map ~child:stmts ~f:(fun stmts -> Hocc {hocc=tok; stmts}) ctx' + | HoccToken {atok=Scan.AbstractToken.Tok_hocc; _} as hocc -> + mapr ~child:indent ~f:(fun ctx' indent -> + mapr ~child:stmts ~f:(fun ctx' stmts -> + map ~child:dedent ~f:(fun dedent -> + Hocc {hocc; indent; stmts; dedent} + ) ctx' + ) ctx' + ) ctx' | _ -> err_token tok "Expected hocc" ctx, None and eoi ctx = let ctx', tok = next ctx in match tok with - | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_end_of_input; _} -> ctx', Some (Eoi {token=tok}) + | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_end_of_input; _} as token -> ctx', Some (Eoi {token}) | _ -> err "Unexpected token before eoi" ctx, None and matter ctx = @@ -247,7 +623,7 @@ and hmh scanner = let ctx', eoi_opt = eoi ctx' in match hocc_opt, eoi_opt with | None, _ - | _, None -> ctx'.scanner, Error ctx.errs + | _, None -> ctx'.scanner, Error ctx'.errs | Some hocc, Some eoi -> ctx'.scanner, Ok (Hmh {prelude; hocc; postlude; eoi}) and hmhi scanner = diff --git a/doc/tools/hocc.md b/doc/tools/hocc.md index 9c02e1ab9..706e551ee 100644 --- a/doc/tools/hocc.md +++ b/doc/tools/hocc.md @@ -84,9 +84,12 @@ code](#generated-code-api): [ident](#ident) ::= [uident](#uident) | [cident](#cident) | `_` +[precs_list_body_tl](#precs_list_body_tl) ::= +
    | `;` [uident](#uident) [precs_list_body_tl](#precs_list_body_tl) +
    | ε + [precs_list_body](#precs_list_body) ::= -
    | [prec_list_body](#prec_list_body) `;` [uident](#uident) -
    | [uident](#uident) +[uident](#uident) [precs_list_tl](#precs_list_tl) [precs](#precs) ::=
    | `[` [precs_list_body](#precs_list_body) `]` @@ -97,14 +100,13 @@ code](#generated-code-api): [prec_rel](#prec_rel) ::= [rel](#rel) [precs](#precs) [prec_rels](#prec_rels) ::= -
    | [prec_rels](#prec_rels) [prec_rel](#prec_rel) -
    | [prec_rel](#prec_rel) +
    | [prec_rel](#prec_rel) [prec_rels](#prec_rels) +
    | ε [prec_type](#prec_type) ::= `prec` | `left` | `right` [prec](#prec) ::= -
    | [prec_type](#prec_type) [uident](#uident) [prec_rels](#prec_rels) -
    | [prec_type](#prec_type) [uident](#uident) +[prec_type](#prec_type) [uident](#uident) [prec_rels](#prec_rels) [of_type](#of_type) ::=
    | `of` [cident](#cident) `.` [uident](#uident) @@ -117,14 +119,13 @@ code](#generated-code-api): [token](#token) ::= `token` [cident](#cident) [of_type](#of_type) [prec_ref](#prec_ref) -[sep](#sep) ::= \[line separator] | `;` +[sep](#sep) ::= \[line delimiter] | `;` [codes_tl](#codes_tl) ::=
    | [sep](#sep) [codes](#codes) [codes_tl](#codes_tl)
    | ε -[codes](#codes) ::= -
    | [code](#code) [codes_tl](#codes_tl) +[codes](#codes) ::= [code](#code) [codes_tl](#codes_tl) [code_tl](#code_tl) ::=
    | \[indent] [codes](#codes) \[dedent] [code_tl](#code_tl) @@ -142,9 +143,12 @@ code](#generated-code-api): [prod_param](#prod_param) ::= [ident](#ident) `:` [prod_param_type](#prod_param_type) +[prod_params_tl](#prod_params_tl) ::= +
    | [prod_param](#prod_param) [prod_params_tl](#prod_params_tl) +
    | ε + [prod_params](#prod_params) ::= -
    | [prod_params](#prod_params) [prod_param](#prod_param) -
    | [prod_param](#prod_param) +[prod_param](#prod_param) [prod_params_tl](#prod_params_tl) [prod_pattern](#prod_pattern) ::=
    | [prod_params](#prod_params) @@ -152,16 +156,23 @@ code](#generated-code-api): [prod](#prod) ::= [prod_pattern](#prod_pattern) [prec_ref](#prec_ref) +[prods_tl](#prods_tl) ::= +
    | `|` [prod](#prod) [prods_tl](#prods_tl) +
    | ε + [prods](#prods) ::= -
    | [prods](#prods) `|` [prod](#prod) -
    | [prod](#prod) +
    | `|` [prod](#prod) [prods_tl](#prods_tl) +
    | [prod](#prod) [prods_tl](#prods_tl) [reduce](#reduce) ::= [prods](#prods) `->` [code](#code) +[reductions_tl](#reductions_tl) ::= +
    | `|` [reduce](#reduce) [reductions_tl](#reductions_tl) +
    | ε + [reductions](#reductions) ::= -
    | [reductions](#reductions) `|` [reduce](#reduce) -
    | `|` [reduce](#reduce) -
    | [reduce](#reduce) +
    | `|` [reduce](#reduce) [reductions_tl](#reductions_tl) +
    | [reduce](#reduce) [reductions_tl](#reductions_tl) [nonterm_type](#nonterm_type) ::= `nonterm` | `start` @@ -176,13 +187,12 @@ code](#generated-code-api):
    | [code](#code) [stmts_tl](#stmts_tl) ::= -
    | [sep](#sep) [stmt](#stmt) [stmts_tl](#stmts_tl) +
    | \[line delimiter] [stmt](#stmt) [stmts_tl](#stmts_tl)
    | ε -[stmts](#stmts) ::= -
    | [stmt](#stmt) [stmts_tl](#stmts) +[stmts](#stmts) ::= [stmt](#stmt) [stmts_tl](#stmts) -[hocc](#hocc) ::= `hocc` [stmts](#stmts) +[hocc](#hocc) ::= `hocc` \[indent] [stmts](#stmts) \[dedent] [matter](#matter) ::=
    | \[Hemlock token] [matter](#matter)