From d98b92c02809afa7f21dd182c4d6f40348fc38e8 Mon Sep 17 00:00:00 2001 From: Jason Evans Date: Thu, 15 Aug 2024 19:20:06 -0700 Subject: [PATCH] Refactor to converge APIs with LR-based parser --- bootstrap/bin/hocc/code.ml | 63 +++--- bootstrap/bin/hocc/parse.ml | 246 ++++++++++----------- bootstrap/bin/hocc/prec.ml | 2 +- bootstrap/bin/hocc/prec.mli | 4 +- bootstrap/bin/hocc/precs.mli | 2 +- bootstrap/bin/hocc/scan.ml | 10 +- bootstrap/bin/hocc/scan.mli | 1 + bootstrap/bin/hocc/spec.ml | 16 +- bootstrap/bin/hocc/symbol.ml | 4 +- bootstrap/bin/hocc/symbol.mli | 8 +- bootstrap/bin/hocc/symbols.mli | 4 +- bootstrap/test/hocc/Binding_error.expected | 2 +- bootstrap/test/hocc/Example_ml.expected.ml | 2 +- doc/tools/hocc.md | 4 +- 14 files changed, 192 insertions(+), 176 deletions(-) diff --git a/bootstrap/bin/hocc/code.ml b/bootstrap/bin/hocc/code.ml index f448e91b5..0b4ab16ac 100644 --- a/bootstrap/bin/hocc/code.ml +++ b/bootstrap/bin/hocc/code.ml @@ -460,9 +460,9 @@ let expand_hmi_template template_indentation template Spec.{symbols; _} formatte ] in formatter |> expand ~template_indentation template expanders -let generate_hmi conf Parse.(Hmhi {prelude; hocc; postlude; eoi=Eoi {eoi}}) io spec = +let generate_hmi conf Parse.(Hmhi {prelude; hocc_; postlude; eoi=Eoi {eoi}}) io spec = assert (Spec.conflicts spec = 0L); - let indentation = indentation_of_hocc hocc in + let indentation = indentation_of_hocc hocc_ in let module_name = module_name conf in let hmhi_name = module_name ^ ".hmhi" in let hmi_name = module_name ^ ".hmi" in @@ -478,12 +478,12 @@ let generate_hmi conf Parse.(Hmhi {prelude; hocc; postlude; eoi=Eoi {eoi}}) io s |> Fmt.fmt "[:" |> Fmt.fmt directive_pathstr |> Fmt.fmt ":1]" |> (fun formatter -> match prelude with - | Parse.Matter {token; _} -> begin - let base = match token with + | Parse.Matter {token_; _} -> begin + let base = match token_ with | HmcToken {source; _} -> Hmc.Source.Slice.base source | HoccToken _ -> not_reached () in - let past = match hocc with + let past = match hocc_ with | HmcToken _ -> not_reached () | HoccToken {source; _} -> Hmc.Source.Slice.base source in @@ -497,7 +497,7 @@ let generate_hmi conf Parse.(Hmhi {prelude; hocc; postlude; eoi=Eoi {eoi}}) io s |> (fun formatter -> match postlude with | Parse.Matter _ -> begin - let base = match hocc with + let base = match hocc_ with | HmcToken _ -> not_reached () | HoccToken {source; _} -> Hmc.Source.Slice.past source in @@ -1240,7 +1240,7 @@ let expand_hm_precs precs ~indentation formatter = | _ -> begin formatter |> Fmt.fmt "of_list Uns " - |> (Ordset.to_list doms |> List.fmt ~alt:true ~width:indentation Prec.Index.pp) + |> (Ordset.to_list doms |> List.pp Prec.Index.pp) end ) |> Fmt.fmt ")" @@ -1750,8 +1750,13 @@ let expand_hm_callbacks hocc_block symbols callbacks ~indentation formatter = |> indent |> String.fmt ~pad:overline ~just:Fmt.Left ~width:(100L - indentation) " # " |> Fmt.fmt "\n" - |> indent |> Fmt.fmt " )), tl\n" - |> indent |> Fmt.fmt " | _ -> not_reached ()" + |> indent |> Fmt.fmt " )), tl" + |> (fun formatter -> + match Callback.is_epsilon callback with + | false -> + formatter |> Fmt.fmt "\n" |> indent |> Fmt.fmt " | _ -> not_reached ()" + | true -> formatter + ) end | true -> formatter |> Fmt.fmt "fn _stack -> not_reached ()" ) @@ -1835,9 +1840,9 @@ let expand_hm_template template_indentation template hocc_block formatter |> expand ~template_indentation template expanders let generate_hm conf - Parse.(Hmh {prelude; hocc=(Hocc {hocc; _} as hocc_block); postlude; eoi=Eoi {eoi}}) io spec = + Parse.(Hmh {prelude; hocc_=(Hocc {hocc_; _} as hocc_block); postlude; eoi=Eoi {eoi}}) io spec = assert (Spec.conflicts spec = 0L); - let indentation = indentation_of_hocc hocc in + let indentation = indentation_of_hocc hocc_ in let module_name = module_name conf in let hmh_name = module_name ^ ".hmh" in let hm_name = module_name ^ ".hm" in @@ -1853,12 +1858,12 @@ let generate_hm conf |> Fmt.fmt "[:" |> Fmt.fmt directive_pathstr |> Fmt.fmt ":1]" |> (fun formatter -> match prelude with - | Parse.Matter {token; _} -> begin - let base = match token with + | Parse.Matter {token_; _} -> begin + let base = match token_ with | HmcToken {source; _} -> Hmc.Source.Slice.base source | HoccToken _ -> not_reached () in - let past = match hocc with + let past = match hocc_ with | HmcToken _ -> not_reached () | HoccToken {source; _} -> Hmc.Source.Slice.base source in @@ -2287,9 +2292,9 @@ let expand_mli_template template_indentation template Spec.{symbols; _} formatte ] in formatter |> expand ~template_indentation template expanders -let generate_mli conf Parse.(Hmhi {prelude; hocc; postlude; eoi=Eoi {eoi}}) io spec = +let generate_mli conf Parse.(Hmhi {prelude; hocc_; postlude; eoi=Eoi {eoi}}) io spec = assert (Spec.conflicts spec = 0L); - let indentation = indentation_of_hocc hocc in + let indentation = indentation_of_hocc hocc_ in let module_name = module_name conf in let hmhi_name = module_name ^ ".hmhi" in let mli_name = module_name ^ ".mli" in @@ -2302,12 +2307,12 @@ let generate_mli conf Parse.(Hmhi {prelude; hocc; postlude; eoi=Eoi {eoi}}) io s |> Fmt.fmt "*)\n" |> (fun formatter -> match prelude with - | Parse.Matter {token; _} -> begin - let base = match token with + | Parse.Matter {token_; _} -> begin + let base = match token_ with | HmcToken {source; _} -> Hmc.Source.Slice.base source | HoccToken _ -> not_reached () in - let past = match hocc with + let past = match hocc_ with | HmcToken _ -> not_reached () | HoccToken {source; _} -> Hmc.Source.Slice.base source in @@ -2320,7 +2325,7 @@ let generate_mli conf Parse.(Hmhi {prelude; hocc; postlude; eoi=Eoi {eoi}}) io s |> (fun formatter -> match postlude with | Parse.Matter _ -> begin - let base = match hocc with + let base = match hocc_ with | HmcToken _ -> not_reached () | HoccToken {source; _} -> Hmc.Source.Slice.past source in @@ -3090,7 +3095,7 @@ let expand_ml_precs precs ~indentation formatter = | _ -> begin formatter |> Fmt.fmt "of_list (module Uns) " - |> (Ordset.to_list doms |> List.fmt ~alt:true ~width:indentation ml_uns_pp) + |> (Ordset.to_list doms |> List.pp ml_uns_pp) end ) |> Fmt.fmt ")" @@ -3613,7 +3618,11 @@ let expand_ml_callbacks hocc_block symbols callbacks ~indentation formatter = |> String.fmt ~pad:overline ~just:Fmt.Left ~width:(98L - indentation) " (*" |> Fmt.fmt "*)\n" |> indent |> Fmt.fmt " )), tl\n" - |> indent |> Fmt.fmt " | _ -> not_reached ()\n" + |> (fun formatter -> + match Callback.is_epsilon callback with + | false -> formatter |> indent |> Fmt.fmt " | _ -> not_reached ()\n" + | true -> formatter + ) |> indent |> Fmt.fmt ")" end | true -> formatter |> Fmt.fmt "(fun _stack -> not_reached ())" @@ -3698,9 +3707,9 @@ let expand_ml_template template_indentation template hocc_block formatter |> expand ~template_indentation template expanders let generate_ml conf - Parse.(Hmh {prelude; hocc=(Hocc {hocc; _} as hocc_block); postlude; eoi=Eoi {eoi}}) io spec = + Parse.(Hmh {prelude; hocc_=(Hocc {hocc_; _} as hocc_block); postlude; eoi=Eoi {eoi}}) io spec = assert (Spec.conflicts spec = 0L); - let indentation = indentation_of_hocc hocc in + let indentation = indentation_of_hocc hocc_ in let module_name = module_name conf in let hmh_name = module_name ^ ".hmh" in let ml_name = module_name ^ ".ml" in @@ -3714,12 +3723,12 @@ let generate_ml conf |> (fun formatter -> match prelude with - | Parse.Matter {token; _} -> begin - let base = match token with + | Parse.Matter {token_; _} -> begin + let base = match token_ with | HmcToken {source; _} -> Hmc.Source.Slice.base source | HoccToken _ -> not_reached () in - let past = match hocc with + let past = match hocc_ with | HmcToken _ -> not_reached () | HoccToken {source; _} -> Hmc.Source.Slice.base source in diff --git a/bootstrap/bin/hocc/parse.ml b/bootstrap/bin/hocc/parse.ml index 1183bf9e1..e20789bf2 100644 --- a/bootstrap/bin/hocc/parse.ml +++ b/bootstrap/bin/hocc/parse.ml @@ -70,10 +70,10 @@ and prec_rels = | PrecRelsLtPrecs of {lt: Scan.Token.t; precs: precs} | PrecRelsEpsilon and prec_type = - | PrecTypeNeutral of {neutral: Scan.Token.t} - | PrecTypeLeft of {left: Scan.Token.t} - | PrecTypeRight of {right: Scan.Token.t} -and prec = + | PrecTypeNeutral of {neutral_: Scan.Token.t} + | PrecTypeLeft of {left_: Scan.Token.t} + | PrecTypeRight of {right_: Scan.Token.t} +and prec_ = | 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} @@ -81,13 +81,13 @@ and of_type0 = | OfType0OfType of {of_type: of_type} | OfType0Epsilon and prec_ref = - | PrecRefPrecUident of {prec: Scan.Token.t; uident: uident} + | PrecRefPrecUident of {prec_: Scan.Token.t; uident: uident} | PrecRefEpsilon and token_alias = | TokenAlias of {alias: Scan.Token.t} | TokenAliasEpsilon -and token = - | Token of {token: Scan.Token.t; cident: cident; token_alias: token_alias; of_type0: of_type0; +and token_ = + | Token of {token_: Scan.Token.t; cident: cident; token_alias: token_alias; of_type0: of_type0; prec_ref: prec_ref} and sep = | SepLineDelim of {line_delim: Scan.Token.t} @@ -110,11 +110,11 @@ and delimited = | DelimitedModule of {lcurly: Scan.Token.t; codes0: codes0; rcurly: Scan.Token.t} and code_tl = | CodeTlDelimited of {delimited: delimited; code_tl: code_tl} - | CodeTlToken of {token: Scan.Token.t; code_tl: code_tl} + | CodeTlToken of {token_: Scan.Token.t; code_tl: code_tl} | CodeTlEpsilon and code = | CodeDelimited of {delimited: delimited; code_tl: code_tl} - | CodeToken of {token: Scan.Token.t; code_tl: code_tl} + | CodeToken of {token_: Scan.Token.t; code_tl: code_tl} and prod_param_symbol = | ProdParamSymbolCident of {cident: cident} | ProdParamSymbolAlias of {alias: Scan.Token.t} @@ -128,7 +128,7 @@ and prod_params = | 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} + | ProdPatternEpsilon of {epsilon_: Scan.Token.t} and prod = | Prod of {prod_pattern: prod_pattern; prec_ref: prec_ref} and prods_tl = @@ -146,34 +146,34 @@ and reductions_tl = and reductions = | ReductionsReduction of {reduction: reduction; reductions_tl: reductions_tl} and nonterm_type = - | NontermTypeNonterm of {nonterm: Scan.Token.t} - | NontermTypeStart of {start: Scan.Token.t} -and nonterm = + | NontermTypeNonterm of {nonterm_: Scan.Token.t} + | NontermTypeStart of {start_: Scan.Token.t} +and nonterm_ = | NontermProds of {nonterm_type: nonterm_type; cident: cident; prec_ref: prec_ref; cce: Scan.Token.t; prods: prods} | NontermReductions of {nonterm_type: nonterm_type; cident: cident; of_type: of_type; prec_ref: prec_ref; cce: Scan.Token.t; reductions: reductions} and stmt = - | StmtPrec of {prec: prec} - | StmtToken of {token: token} - | StmtNonterm of {nonterm: nonterm} + | StmtPrec of {prec_: prec_} + | StmtToken of {token_: token_} + | StmtNonterm of {nonterm_: nonterm_} | StmtCode of {code: code} and 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; indent: Scan.Token.t; stmts: stmts; dedent: Scan.Token.t} +and hocc_ = + | Hocc of {hocc_: Scan.Token.t; indent: Scan.Token.t; stmts: stmts; dedent: Scan.Token.t} and eoi = | Eoi of {eoi: Scan.Token.t} and matter = - | Matter of {token: Scan.Token.t; matter: matter} + | Matter of {token_: Scan.Token.t; matter: matter} | MatterEpsilon and hmh = - | Hmh of {prelude: matter; hocc: hocc; postlude: matter; eoi: eoi} + | Hmh of {prelude: matter; hocc_: hocc_; postlude: matter; eoi: eoi} and hmhi = - | Hmhi of {prelude: matter; hocc: Scan.Token.t; postlude: matter; eoi: eoi} + | Hmhi of {prelude: matter; hocc_: Scan.Token.t; postlude: matter; eoi: eoi} (**************************************************************************************************) (* source_of_* functions. *) @@ -236,9 +236,9 @@ and source_of_prec_rels = function | PrecRelsEpsilon -> None and source_of_prec_type = function - | PrecTypeNeutral {neutral} -> token_source neutral - | PrecTypeLeft {left} -> token_source left - | PrecTypeRight {right} -> token_source right + | PrecTypeNeutral {neutral_} -> token_source neutral_ + | PrecTypeLeft {left_} -> token_source left_ + | PrecTypeRight {right_} -> token_source right_ and source_of_prec = function | Prec {prec_type; uident; prec_rels} -> @@ -257,8 +257,8 @@ and source_of_of_type0 = function | OfType0Epsilon -> None and source_of_prec_ref = function - | PrecRefPrecUident {prec; uident} -> - token_source prec + | PrecRefPrecUident {prec_; uident} -> + token_source prec_ |> join_sources (source_of_uident uident) | PrecRefEpsilon -> None @@ -267,8 +267,8 @@ and source_of_token_alias = function | TokenAliasEpsilon -> None and source_of_token = function - | Token {token; cident; token_alias; of_type0; prec_ref} -> - token_source token + | Token {token_; cident; token_alias; of_type0; prec_ref} -> + token_source token_ |> join_sources (source_of_cident cident) |> join_sources (source_of_token_alias token_alias) |> join_sources (source_of_of_type0 of_type0) @@ -309,8 +309,8 @@ and source_of_code_tl = function | CodeTlDelimited {delimited; code_tl} -> source_of_delimited delimited |> join_sources (source_of_code_tl code_tl) - | CodeTlToken {token; code_tl} -> - token_source token + | CodeTlToken {token_; code_tl} -> + token_source token_ |> join_sources (source_of_code_tl code_tl) | CodeTlEpsilon -> None @@ -318,8 +318,8 @@ and source_of_code = function | CodeDelimited {delimited; code_tl} -> source_of_delimited delimited |> join_sources (source_of_code_tl code_tl) - | CodeToken {token; code_tl} -> - token_source token + | CodeToken {token_; code_tl} -> + token_source token_ |> join_sources (source_of_code_tl code_tl) and source_of_prod_param_symbol = function @@ -346,7 +346,7 @@ and source_of_prod_params = function and source_of_prod_pattern = function | ProdPatternParams {prod_params} -> source_of_prod_params prod_params - | ProdPatternEpsilon {epsilon} -> token_source epsilon + | ProdPatternEpsilon {epsilon_} -> token_source epsilon_ and source_of_prod = function | Prod {prod_pattern; prec_ref} -> @@ -387,8 +387,8 @@ and source_of_reductions = function |> join_sources (source_of_reductions_tl reductions_tl) and source_of_nonterm_type = function - | NontermTypeNonterm {nonterm} -> token_source nonterm - | NontermTypeStart {start} -> token_source start + | NontermTypeNonterm {nonterm_} -> token_source nonterm_ + | NontermTypeStart {start_} -> token_source start_ and source_of_nonterm = function | NontermProds {nonterm_type; cident=_; prec_ref=_; cce=_; prods} -> @@ -399,9 +399,9 @@ and source_of_nonterm = function |> join_sources (source_of_reductions reductions) and source_of_stmt = function - | StmtPrec {prec} -> source_of_prec prec - | StmtToken {token} -> source_of_token token - | StmtNonterm {nonterm} -> source_of_nonterm nonterm + | StmtPrec {prec_} -> source_of_prec prec_ + | StmtToken {token_} -> source_of_token token_ + | StmtNonterm {nonterm_} -> source_of_nonterm nonterm_ | StmtCode {code} -> source_of_code code and source_of_stmts_tl = function @@ -417,29 +417,29 @@ and source_of_stmts = function |> join_sources (source_of_stmts_tl stmts_tl) and source_of_hocc = function - | Hocc {hocc; indent=_; stmts=_; dedent} -> - token_source hocc + | Hocc {hocc_; indent=_; stmts=_; dedent} -> + token_source hocc_ |> join_sources (token_source dedent) and source_of_eoi = function | Eoi {eoi} -> token_source eoi and source_of_matter = function - | Matter {token; matter} -> - token_source token + | Matter {token_; matter} -> + token_source token_ |> join_sources (source_of_matter matter) | MatterEpsilon -> None and source_of_hmh = function - | Hmh {prelude; hocc; postlude=_; eoi} -> + | Hmh {prelude; hocc_; postlude=_; eoi} -> source_of_matter prelude - |> join_sources (source_of_hocc hocc) + |> join_sources (source_of_hocc hocc_) |> join_sources (source_of_eoi eoi) and source_of_hmhi = function - | Hmhi {prelude; hocc; postlude=_; eoi} -> + | Hmhi {prelude; hocc_; postlude=_; eoi} -> source_of_matter prelude - |> join_sources (token_source hocc) + |> join_sources (token_source hocc_) |> join_sources (source_of_eoi eoi) (**************************************************************************************************) @@ -559,20 +559,20 @@ and pp_prec_rels prec_rels formatter = and fmt_prec_type ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) prec_type formatter = match prec_type with - | PrecTypeNeutral {neutral} -> + | PrecTypeNeutral {neutral_} -> formatter |> Fmt.fmt "PrecTypeNeutral " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "neutral=" |> Scan.Token.pp neutral + |> Fmt.fmt "neutral_=" |> Scan.Token.pp neutral_ |> fmt_rcurly ~alt ~width - | PrecTypeLeft {left} -> + | PrecTypeLeft {left_} -> formatter |> Fmt.fmt "PrecTypeLeft " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "left=" |> Scan.Token.pp left + |> Fmt.fmt "left_=" |> Scan.Token.pp left_ |> fmt_rcurly ~alt ~width - | PrecTypeRight {right} -> + | PrecTypeRight {right_} -> formatter |> Fmt.fmt "PrecTypeRight " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "right=" |> Scan.Token.pp right + |> Fmt.fmt "right_=" |> Scan.Token.pp right_ |> fmt_rcurly ~alt ~width and pp_prec_type prec_type formatter = fmt_prec_type prec_type formatter @@ -625,10 +625,10 @@ and pp_of_type0 of_type0 formatter = and fmt_prec_ref ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) prec_ref formatter = let width' = width + 4L in match prec_ref with - | PrecRefPrecUident {prec; uident} -> + | PrecRefPrecUident {prec_; uident} -> formatter |> Fmt.fmt "PrecRefPrecUident " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "prec=" |> Scan.Token.pp prec + |> Fmt.fmt "prec_=" |> Scan.Token.pp prec_ |> fmt_semi ~alt ~width |> Fmt.fmt "uident=" |> fmt_uident ~alt ~width:width' uident |> fmt_rcurly ~alt ~width @@ -652,10 +652,10 @@ and pp_token_alias token_alias formatter = and fmt_token ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) token formatter = let width' = width + 4L in match token with - | Token {token; cident; token_alias; of_type0; prec_ref} -> + | Token {token_; cident; token_alias; of_type0; prec_ref} -> formatter |> Fmt.fmt "Token " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "token=" |> Scan.Token.pp token + |> Fmt.fmt "token_=" |> Scan.Token.pp token_ |> fmt_semi ~alt ~width |> Fmt.fmt "cident=" |> fmt_cident ~alt ~width:width' cident |> fmt_semi ~alt ~width @@ -800,10 +800,10 @@ and fmt_code_tl ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) code_tl format |> fmt_semi ~alt ~width |> Fmt.fmt "code_tl=" |> fmt_code_tl ~alt ~width:width' code_tl |> fmt_rcurly ~alt ~width - | CodeTlToken {token; code_tl} -> + | CodeTlToken {token_; code_tl} -> formatter |> Fmt.fmt "CodeTlToken " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "token=" |> Scan.Token.pp token + |> Fmt.fmt "token_=" |> Scan.Token.pp token_ |> fmt_semi ~alt ~width |> Fmt.fmt "code_tl=" |> fmt_code_tl ~alt ~width:width' code_tl |> fmt_rcurly ~alt ~width @@ -822,10 +822,10 @@ and fmt_code ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) code formatter = |> fmt_semi ~alt ~width |> Fmt.fmt "code_tl=" |> fmt_code_tl ~alt ~width:width' code_tl |> fmt_rcurly ~alt ~width - | CodeToken {token; code_tl} -> + | CodeToken {token_; code_tl} -> formatter |> Fmt.fmt "CodeToken " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "token=" |> Scan.Token.pp token + |> Fmt.fmt "token_=" |> Scan.Token.pp token_ |> fmt_semi ~alt ~width |> Fmt.fmt "code_tl=" |> fmt_code_tl ~alt ~width:width' code_tl |> fmt_rcurly ~alt ~width @@ -905,10 +905,10 @@ and fmt_prod_pattern ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) prod_patt |> fmt_lcurly ~alt ~width |> Fmt.fmt "prod_params=" |> fmt_prod_params ~alt ~width:width' prod_params |> fmt_rcurly ~alt ~width - | ProdPatternEpsilon {epsilon} -> + | ProdPatternEpsilon {epsilon_} -> formatter |> Fmt.fmt "ProdPatternEpsilon " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "epsilon=" |> Scan.Token.pp epsilon + |> Fmt.fmt "epsilon_=" |> Scan.Token.pp epsilon_ |> fmt_rcurly ~alt ~width and pp_prod_pattern prod_pattern formatter = fmt_prod_pattern prod_pattern formatter @@ -1012,15 +1012,15 @@ and pp_reductions reductions formatter = and fmt_nonterm_type ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) nonterm_type formatter = match nonterm_type with - | NontermTypeNonterm {nonterm} -> + | NontermTypeNonterm {nonterm_} -> formatter |> Fmt.fmt "NontermTypeNonterm " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "nonterm=" |> Scan.Token.pp nonterm + |> Fmt.fmt "nonterm_=" |> Scan.Token.pp nonterm_ |> fmt_rcurly ~alt ~width - | NontermTypeStart {start} -> + | NontermTypeStart {start_} -> formatter |> Fmt.fmt "NontermTypeStart " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "start=" |> Scan.Token.pp start + |> Fmt.fmt "start_=" |> Scan.Token.pp start_ |> fmt_rcurly ~alt ~width and pp_nonterm_type nonterm_type formatter = fmt_nonterm_type nonterm_type formatter @@ -1062,20 +1062,20 @@ and pp_nonterm nonterm formatter = and fmt_stmt ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) stmt formatter = let width' = width + 4L in match stmt with - | StmtPrec {prec} -> + | StmtPrec {prec_} -> formatter |> Fmt.fmt "StmtPrec " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "prec=" |> fmt_prec ~alt ~width:width' prec + |> Fmt.fmt "prec_=" |> fmt_prec ~alt ~width:width' prec_ |> fmt_rcurly ~alt ~width - | StmtToken {token} -> + | StmtToken {token_} -> formatter |> Fmt.fmt "StmtToken " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "token=" |> fmt_token ~alt ~width:width' token + |> Fmt.fmt "token_=" |> fmt_token ~alt ~width:width' token_ |> fmt_rcurly ~alt ~width - | StmtNonterm {nonterm} -> + | StmtNonterm {nonterm_} -> formatter |> Fmt.fmt "StmtNonterm " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "nonterm=" |> fmt_nonterm ~alt ~width:width' nonterm + |> Fmt.fmt "nonterm_=" |> fmt_nonterm ~alt ~width:width' nonterm_ |> fmt_rcurly ~alt ~width | StmtCode {code} -> formatter |> Fmt.fmt "StmtCode " @@ -1118,10 +1118,10 @@ and pp_stmts stmts formatter = and fmt_hocc ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) hocc formatter = let width' = width + 4L in match hocc with - | Hocc {hocc; indent; stmts; dedent} -> + | Hocc {hocc_; indent; stmts; dedent} -> formatter |> Fmt.fmt "Hocc " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "hocc=" |> Scan.Token.pp hocc + |> Fmt.fmt "hocc_=" |> Scan.Token.pp hocc_ |> fmt_semi ~alt ~width |> Fmt.fmt "indent=" |> Scan.Token.pp indent |> fmt_semi ~alt ~width @@ -1145,10 +1145,10 @@ and pp_eoi eoi formatter = and fmt_matter ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) matter formatter = let width' = width + 4L in match matter with - | Matter {token; matter} -> + | Matter {token_; matter} -> formatter |> Fmt.fmt "Matter " |> fmt_lcurly ~alt ~width - |> Fmt.fmt "token=" |> Scan.Token.pp token + |> Fmt.fmt "token_=" |> Scan.Token.pp token_ |> fmt_semi ~alt ~width |> Fmt.fmt "matter=" |> fmt_matter ~alt ~width:width' matter |> fmt_rcurly ~alt ~width @@ -1160,12 +1160,12 @@ and pp_matter matter formatter = and fmt_hmh ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) hmh formatter = let width' = width + 4L in match hmh with - | Hmh {prelude; hocc; postlude; eoi} -> + | Hmh {prelude; hocc_; postlude; eoi} -> formatter |> Fmt.fmt "Hmh " |> fmt_lcurly ~alt ~width |> Fmt.fmt "prelude=" |> pp_matter prelude |> fmt_semi ~alt ~width - |> Fmt.fmt "hocc=" |> fmt_hocc ~alt ~width:width' hocc + |> Fmt.fmt "hocc_=" |> fmt_hocc ~alt ~width:width' hocc_ |> fmt_semi ~alt ~width |> Fmt.fmt "postlude=" |> pp_matter postlude |> fmt_semi ~alt ~width @@ -1177,12 +1177,12 @@ and pp_hmh hmh formatter = and fmt_hmhi ?(alt=Fmt.alt_default) ?(width=Fmt.width_default) hmhi formatter = let width' = width + 4L in match hmhi with - | Hmhi {prelude; hocc; postlude; eoi} -> + | Hmhi {prelude; hocc_; postlude; eoi} -> formatter |> Fmt.fmt "Hmhi " |> fmt_lcurly ~alt ~width |> Fmt.fmt "prelude=" |> pp_matter prelude |> fmt_semi ~alt ~width - |> Fmt.fmt "hocc=" |> Scan.Token.pp hocc + |> Fmt.fmt "hocc_=" |> Scan.Token.pp hocc_ |> fmt_semi ~alt ~width |> Fmt.fmt "postlude=" |> pp_matter postlude |> fmt_semi ~alt ~width @@ -1321,12 +1321,12 @@ and prec_type spine ctx = let spine = "prec_type" :: spine in let ctx', tok = next spine ctx in match tok with - | HoccToken {atok=Scan.AbstractToken.Tok_neutral; _} as neutral -> - reduce spine ctx' fmt_prec_type (PrecTypeNeutral {neutral}) - | HoccToken {atok=Scan.AbstractToken.Tok_left; _} as left -> - reduce spine ctx' fmt_prec_type (PrecTypeLeft {left}) - | HoccToken {atok=Scan.AbstractToken.Tok_right; _} as right -> - reduce spine ctx' fmt_prec_type (PrecTypeRight {right}) + | HoccToken {atok=Scan.AbstractToken.Tok_neutral; _} as neutral_ -> + reduce spine ctx' fmt_prec_type (PrecTypeNeutral {neutral_}) + | HoccToken {atok=Scan.AbstractToken.Tok_left; _} as left_ -> + reduce spine ctx' fmt_prec_type (PrecTypeLeft {left_}) + | HoccToken {atok=Scan.AbstractToken.Tok_right; _} as right_ -> + reduce spine ctx' fmt_prec_type (PrecTypeRight {right_}) | _ -> err_token tok "Expected precedence type" ctx, None and prec spine ctx = @@ -1374,9 +1374,9 @@ and prec_ref spine ctx = let spine = "prec_ref" :: spine in let ctx', tok = next spine ctx in match tok with - | HoccToken {atok=Scan.AbstractToken.Tok_prec; _} as prec -> + | HoccToken {atok=Scan.AbstractToken.Tok_prec; _} as prec_ -> map ~child:uident ~f:(fun uident -> - PrecRefPrecUident {prec; uident} + PrecRefPrecUident {prec_; uident} ) ~fmt_child:fmt_prec_ref spine ctx' | _ -> reduce spine ctx fmt_prec_ref PrecRefEpsilon @@ -1391,12 +1391,12 @@ and token_alias spine ctx = and token spine ctx = let ctx', tok = next spine ctx in match tok with - | HoccToken {atok=Scan.AbstractToken.Tok_token; _} as token -> + | HoccToken {atok=Scan.AbstractToken.Tok_token; _} as token_ -> mapr ~child:cident ~f:(fun spine ctx' cident -> mapr ~child:token_alias ~f:(fun spine ctx' token_alias -> mapr ~child:of_type0 ~f:(fun spine ctx' of_type0 -> map ~child:prec_ref ~f:(fun prec_ref -> - Token {token; cident; token_alias; of_type0; prec_ref} + Token {token_; cident; token_alias; of_type0; prec_ref} ) ~fmt_child:fmt_token spine ctx' ) spine ctx' ) spine ctx' @@ -1552,9 +1552,9 @@ and code_tl spine ctx = |Tok_rarray|Tok_rcurly |Tok_line_delim|Tok_semi|Tok_bar); _} -> reduce spine ctx fmt_code_tl CodeTlEpsilon - | HmcToken _ as token -> + | HmcToken _ as token_ -> map ~child:code_tl ~f:(fun code_tl -> - CodeTlToken {token; code_tl} + CodeTlToken {token_; code_tl} ) ~fmt_child:fmt_code_tl spine ctx' | _ -> reduce spine ctx fmt_code_tl CodeTlEpsilon @@ -1573,9 +1573,9 @@ and code spine ctx = |Tok_rarray|Tok_rcurly |Tok_line_delim|Tok_semi|Tok_bar); _} -> err_token tok "Expected Hemlock code" ctx, None - | HmcToken _ as token -> + | HmcToken _ as token_ -> map ~child:code_tl ~f:(fun code_tl -> - CodeToken {token; code_tl} + CodeToken {token_; code_tl} ) ~fmt_child:fmt_code spine ctx' | _ -> err_token tok "Expected Hemlock code" ctx, None @@ -1636,8 +1636,8 @@ and prod_pattern spine ctx = let spine = "prod_pattern" :: spine in let ctx', tok = next spine ctx in match tok with - | HoccToken {atok=Scan.AbstractToken.Tok_epsilon; _} as epsilon -> - reduce spine ctx' fmt_prod_pattern (ProdPatternEpsilon {epsilon}) + | HoccToken {atok=Scan.AbstractToken.Tok_epsilon; _} as epsilon_ -> + reduce spine ctx' fmt_prod_pattern (ProdPatternEpsilon {epsilon_}) | _ -> map ~child:prod_params ~f:(fun prod_params -> ProdPatternParams {prod_params} @@ -1721,10 +1721,10 @@ and nonterm_type spine ctx = let spine = "nonterm_type" :: spine in let ctx', tok = next spine ctx in match tok with - | HoccToken {atok=Scan.AbstractToken.Tok_nonterm; _} as nonterm -> - reduce spine ctx' fmt_nonterm_type (NontermTypeNonterm {nonterm}) - | HoccToken {atok=Scan.AbstractToken.Tok_start; _} as start -> - reduce spine ctx' fmt_nonterm_type (NontermTypeStart {start}) + | HoccToken {atok=Scan.AbstractToken.Tok_nonterm; _} as nonterm_ -> + reduce spine ctx' fmt_nonterm_type (NontermTypeNonterm {nonterm_}) + | HoccToken {atok=Scan.AbstractToken.Tok_start; _} as start_ -> + reduce spine ctx' fmt_nonterm_type (NontermTypeStart {start_}) | _ -> err_token tok "Expected 'nonterm'/'start'" ctx, None and nonterm spine ctx = @@ -1733,7 +1733,7 @@ and nonterm spine ctx = let spine = "cce" :: spine in let ctx', tok = next spine ctx in match tok with - | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_colon_op "::="; _} -> ctx', Some tok + | HoccToken {atok=Scan.AbstractToken.Tok_colon_colon_eq; _} -> ctx', Some tok | _ -> err_token tok "Expected '::='" ctx, None end in mapr ~child:nonterm_type ~f:(fun spine ctx' nonterm_type -> @@ -1766,11 +1766,11 @@ and stmt spine ctx = let _ctx', tok = next spine ctx in match tok with | HoccToken {atok=Scan.AbstractToken.(Tok_neutral|Tok_left|Tok_right); _} -> - map ~child:prec ~f:(fun prec -> StmtPrec {prec}) ~fmt_child:fmt_stmt spine ctx + map ~child:prec ~f:(fun prec_ -> StmtPrec {prec_}) ~fmt_child:fmt_stmt spine ctx | HoccToken {atok=Scan.AbstractToken.Tok_token; _} -> - map ~child:token ~f:(fun token -> StmtToken {token}) ~fmt_child:fmt_stmt spine ctx + map ~child:token ~f:(fun token_ -> StmtToken {token_}) ~fmt_child:fmt_stmt spine ctx | HoccToken {atok=Scan.AbstractToken.(Tok_nonterm|Tok_start); _} -> - map ~child:nonterm ~f:(fun nonterm -> StmtNonterm {nonterm}) ~fmt_child:fmt_stmt spine ctx + map ~child:nonterm ~f:(fun nonterm_ -> StmtNonterm {nonterm_}) ~fmt_child:fmt_stmt spine ctx | _ -> map ~child:code ~f:(fun code -> StmtCode {code}) ~fmt_child:fmt_stmt spine ctx and stmts_tl spine ctx = @@ -1805,11 +1805,11 @@ and hocc spine ctx = let spine = "hocc" :: spine in let ctx', tok = next spine ctx in match tok with - | HoccToken {atok=Scan.AbstractToken.Tok_hocc; _} as hocc -> + | HoccToken {atok=Scan.AbstractToken.Tok_hocc; _} as hocc_ -> mapr ~child:indent ~f:(fun spine ctx' indent -> mapr ~child:stmts ~f:(fun spine ctx' stmts -> map ~child:dedent ~f:(fun dedent -> - Hocc {hocc; indent; stmts; dedent} + Hocc {hocc_; indent; stmts; dedent} ) ~fmt_child:fmt_hocc spine ctx' ) spine ctx' ) spine ctx' @@ -1832,7 +1832,7 @@ and matter spine ctx = | HmcToken {atok=Hmc.Scan.AbstractToken.Tok_end_of_input; _} -> ctx, MatterEpsilon | HmcToken _ -> begin let ctx', matter_rchild = f ctx' in - ctx', Matter {token=tok; matter=matter_rchild} + ctx', Matter {token_=tok; matter=matter_rchild} end end in let ctx', matter = f ctx in @@ -1843,10 +1843,10 @@ and hmh scanner = let ctx = {scanner; errs=[]} in let ctx', hmh_opt = mapr ~child:matter ~f:(fun spine ctx' prelude -> - mapr ~child:hocc ~f:(fun spine ctx' hocc -> + mapr ~child:hocc ~f:(fun spine ctx' hocc_ -> mapr ~child:matter ~f:(fun spine ctx' postlude -> map ~child:eoi ~f:(fun eoi -> - Hmh {prelude; hocc; postlude; eoi} + Hmh {prelude; hocc_; postlude; eoi} ) ~fmt_child:fmt_hmh spine ctx' ) spine ctx' ) spine ctx' @@ -1869,10 +1869,10 @@ and hmhi scanner = let ctx = {scanner; errs=[]} in let ctx', hmh_opt = mapr ~child:matter ~f:(fun spine ctx' prelude -> - mapr ~child:hocc ~f:(fun spine ctx' hocc -> + mapr ~child:hocc ~f:(fun spine ctx' hocc_ -> mapr ~child:matter ~f:(fun spine ctx' postlude -> map ~child:eoi ~f:(fun eoi -> - Hmhi {prelude; hocc; postlude; eoi} + Hmhi {prelude; hocc_; postlude; eoi} ) ~fmt_child:fmt_hmhi spine ctx' ) spine ctx' ) spine ctx' @@ -1911,7 +1911,7 @@ let base_of_code code = | DelimitedModule {lcurly=token; _} -> of_token token and of_code = function | CodeDelimited {delimited; _} -> of_delimited delimited - | CodeToken {token; _} -> of_token token + | CodeToken {token_; _} -> of_token token_ in of_code code @@ -1943,11 +1943,11 @@ let last_token_of_code hocc_block code = | CodeTlDelimited {delimited; code_tl} -> of_code_tl code_tl |> Option.some_or_thunk ~f:(fun () -> Some (of_delimited delimited)) - | CodeTlToken {token; code_tl} -> begin + | CodeTlToken {token_; code_tl} -> begin of_code_tl code_tl |> Option.some_or_thunk ~f:(fun () -> (* Exclude comments less indented than `hocc` block from the tail. *) - match token with + match token_ with | HmcToken ctok -> begin match Hmc.Scan.ConcreteToken.atok ctok with | Tok_hash_comment @@ -1960,20 +1960,20 @@ let last_token_of_code hocc_block code = |> Text.Pos.col in match ctok_indentation >= min_comment_indentation with - | true -> Some token + | true -> Some token_ | false -> None end - | _ -> Some token + | _ -> Some token_ end - | HoccToken _ -> Some token + | HoccToken _ -> Some token_ ) end | CodeTlEpsilon -> None and of_code = function | CodeDelimited {delimited; code_tl} -> of_code_tl code_tl |> Option.some_or_thunk ~f:(fun () -> Some (of_delimited delimited)) - | CodeToken {token; code_tl} -> - of_code_tl code_tl |> Option.some_or_thunk ~f:(fun () -> Some token) + | CodeToken {token_; code_tl} -> + of_code_tl code_tl |> Option.some_or_thunk ~f:(fun () -> Some token_) in of_code code |> Option.value_hlt @@ -2053,7 +2053,7 @@ let postlude_base_of_hocc (Hocc {stmts=Stmts {stmt; stmts_tl}; _} as hocc_block) end and of_prod_pattern = function | ProdPatternParams {prod_params} -> of_prod_params prod_params - | ProdPatternEpsilon {epsilon} -> epsilon + | ProdPatternEpsilon {epsilon_} -> epsilon_ and of_prod = function | Prod {prod_pattern; prec_ref} -> begin of_prec_ref prec_ref @@ -2088,17 +2088,17 @@ let postlude_base_of_hocc (Hocc {stmts=Stmts {stmt; stmts_tl}; _} as hocc_block) | NontermProds {prods; _} -> of_prods prods | NontermReductions {reductions; _} -> of_reductions reductions and of_stmt = function - | StmtPrec {prec=Prec {uident; prec_rels; _}} -> begin + | StmtPrec {prec_=Prec {uident; prec_rels; _}} -> begin of_prec_rels prec_rels |> Option.value_or_thunk ~f:(fun () -> of_uident uident) end - | StmtToken {token=Token {cident; token_alias; of_type0; prec_ref; _}} -> begin + | StmtToken {token_=Token {cident; token_alias; of_type0; prec_ref; _}} -> begin of_prec_ref prec_ref |> Option.some_or_thunk ~f:(fun () -> of_of_type0 of_type0) |> Option.some_or_thunk ~f:(fun () -> of_token_alias token_alias) |> Option.value_or_thunk ~f:(fun () -> of_cident cident) end - | StmtNonterm {nonterm} -> of_nonterm nonterm + | StmtNonterm {nonterm_} -> of_nonterm nonterm_ | StmtCode {code} -> last_token_of_code hocc_block code and of_stmts_tl = function | StmtsTl {stmt; stmts_tl; _} -> begin diff --git a/bootstrap/bin/hocc/prec.ml b/bootstrap/bin/hocc/prec.ml index 1c78854d3..c9b1b58ed 100644 --- a/bootstrap/bin/hocc/prec.ml +++ b/bootstrap/bin/hocc/prec.ml @@ -7,7 +7,7 @@ type t = { name: string; assoc: Assoc.t option; doms: (Index.t, Index.cmper_witness) Ordset.t; - stmt: Parse.prec; + stmt: Parse.prec_; } let pp {index; name; assoc; doms; stmt} formatter = diff --git a/bootstrap/bin/hocc/prec.mli b/bootstrap/bin/hocc/prec.mli index 38ec97cf1..575855b33 100644 --- a/bootstrap/bin/hocc/prec.mli +++ b/bootstrap/bin/hocc/prec.mli @@ -19,7 +19,7 @@ type t = { doms: (Index.t, Index.cmper_witness) Ordset.t; (** Set of precedences which dominate this precedence. *) - stmt: Parse.prec; + stmt: Parse.prec_; (** Declaration AST. *) } @@ -32,5 +32,5 @@ val src_fmt: t -> (module Fmt.Formatter) -> (module Fmt.Formatter) (** Formatter which outputs precedence in hocc syntax. *) val init: index:Index.t -> name:string -> assoc:(Assoc.t option) - -> doms:(Index.t, Index.cmper_witness) Ordset.t -> stmt:Parse.prec -> t + -> doms:(Index.t, Index.cmper_witness) Ordset.t -> stmt:Parse.prec_ -> t (** Used only by [Precs.init]. *) diff --git a/bootstrap/bin/hocc/precs.mli b/bootstrap/bin/hocc/precs.mli index dd33b6166..69e06e428 100644 --- a/bootstrap/bin/hocc/precs.mli +++ b/bootstrap/bin/hocc/precs.mli @@ -11,7 +11,7 @@ val empty: t (** [empty] returns an empty set of precedences. *) val insert: name:string -> assoc:(Assoc.t option) - -> doms:(Prec.Index.t, Prec.Index.cmper_witness) Ordset.t -> stmt:Parse.prec -> t -> t + -> doms:(Prec.Index.t, Prec.Index.cmper_witness) Ordset.t -> stmt:Parse.prec_ -> t -> t (** [insert ~name ~assoc ~doms ~stmt t] creates a [Prec.t] with unique index and returns a new [t] with the production inserted. *) diff --git a/bootstrap/bin/hocc/scan.ml b/bootstrap/bin/hocc/scan.ml index 3ec2e38e7..7cce69d3e 100644 --- a/bootstrap/bin/hocc/scan.ml +++ b/bootstrap/bin/hocc/scan.ml @@ -12,6 +12,7 @@ module AbstractToken = struct | Tok_left | Tok_right | Tok_prec + | Tok_colon_colon_eq let pp t formatter = formatter |> Fmt.fmt (match t with @@ -24,11 +25,12 @@ module AbstractToken = struct | Tok_left -> "Tok_left" | Tok_right -> "Tok_right" | Tok_prec -> "Tok_prec" + | Tok_colon_colon_eq -> "::=" ) let malformations = function | Tok_hocc | Tok_token | Tok_nonterm | Tok_start | Tok_epsilon - | Tok_neutral | Tok_left | Tok_right | Tok_prec + | Tok_neutral | Tok_left | Tok_right | Tok_prec | Tok_colon_colon_eq -> [] end @@ -79,10 +81,10 @@ let pp {scan; _} formatter = Hmc.Scan.pp scan formatter let rec susp_next scan = lazy begin + let open AbstractToken in let scan', ctok = Hmc.Scan.next scan in let ctok' = match Hmc.Scan.ConcreteToken.atok ctok with | Tok_uident (Constant uident) -> begin - let open AbstractToken in let source = Hmc.Scan.ConcreteToken.source ctok in match uident with | "hocc" -> Token.HoccToken {atok=Tok_hocc; source} @@ -96,6 +98,10 @@ let rec susp_next scan = lazy begin | "prec" -> Token.HoccToken {atok=Tok_prec; source} | _ -> Token.HmcToken ctok end + | Tok_colon_op "::=" -> begin + let source = Hmc.Scan.ConcreteToken.source ctok in + Token.HoccToken {atok=Tok_colon_colon_eq; source} + end | _ -> Token.HmcToken ctok in let t' = {scan=scan'; next=susp_next scan'} in diff --git a/bootstrap/bin/hocc/scan.mli b/bootstrap/bin/hocc/scan.mli index 4be984c9a..279cebd27 100644 --- a/bootstrap/bin/hocc/scan.mli +++ b/bootstrap/bin/hocc/scan.mli @@ -14,6 +14,7 @@ module AbstractToken: sig | Tok_left | Tok_right | Tok_prec + | Tok_colon_colon_eq val pp: t -> (module Fmt.Formatter) -> (module Fmt.Formatter) diff --git a/bootstrap/bin/hocc/spec.ml b/bootstrap/bin/hocc/spec.ml index c296e3a13..dc4402cb5 100644 --- a/bootstrap/bin/hocc/spec.ml +++ b/bootstrap/bin/hocc/spec.ml @@ -104,7 +104,7 @@ let precs_init io hmh = end in let fold_stmt io precs stmt = begin match stmt with - | Parse.StmtPrec {prec=parse_prec} -> fold_prec io precs parse_prec + | Parse.StmtPrec {prec_=parse_prec} -> fold_prec io precs parse_prec | _ -> io, precs end in let rec fold_stmts_tl io precs stmts_tl = begin @@ -122,7 +122,7 @@ let precs_init io hmh = fold_stmts_tl io precs stmts_tl end end in - let io, precs = match hmh with Parse.Hmh {hocc=Hocc {stmts; _}; _} -> + let io, precs = match hmh with Parse.Hmh {hocc_=Hocc {stmts; _}; _} -> fold_stmts io Precs.empty stmts in io, precs @@ -195,7 +195,7 @@ let tokens_init io precs hmh = end in let fold_stmt io precs symbols stmt = begin match stmt with - | Parse.StmtToken {token} -> fold_token io precs symbols token + | Parse.StmtToken {token_} -> fold_token io precs symbols token_ | _ -> io, symbols end in let rec fold_stmts_tl io precs symbols stmts_tl = begin @@ -213,7 +213,7 @@ let tokens_init io precs hmh = fold_stmts_tl io precs symbols stmts_tl end end in - let io, symbols = match hmh with Parse.Hmh {hocc=Hocc {stmts; _}; _} -> + let io, symbols = match hmh with Parse.Hmh {hocc_=Hocc {stmts; _}; _} -> fold_stmts io precs Symbols.empty stmts in io, symbols @@ -263,7 +263,7 @@ let symbol_infos_init io symbols hmh = end in let fold_stmt io symbols stmt = begin match stmt with - | Parse.StmtNonterm {nonterm} -> fold_nonterm io symbols nonterm + | Parse.StmtNonterm {nonterm_} -> fold_nonterm io symbols nonterm_ | _ -> io, symbols end in let rec fold_stmts_tl io symbols stmts_tl = begin @@ -281,7 +281,7 @@ let symbol_infos_init io symbols hmh = fold_stmts_tl io symbols stmts_tl end end in - let io, symbols = match hmh with Parse.Hmh {hocc=Hocc {stmts; _}; _} -> + let io, symbols = match hmh with Parse.Hmh {hocc_=Hocc {stmts; _}; _} -> fold_stmts io symbols stmts in io, symbols @@ -628,7 +628,7 @@ let symbols_init io precs symbols hmh = end in let fold_stmt io precs symbols prods callbacks stmt = begin match stmt with - | Parse.StmtNonterm {nonterm} -> fold_nonterm io precs symbols prods callbacks nonterm + | Parse.StmtNonterm {nonterm_} -> fold_nonterm io precs symbols prods callbacks nonterm_ | _ -> io, symbols, prods, callbacks end in let rec fold_stmts_tl io precs symbols prods callbacks stmts_tl = begin @@ -744,7 +744,7 @@ let symbols_init io precs symbols hmh = let callbacks = Callbacks.empty in let prods = Prods.empty in let io, symbols, prods, callbacks = - match hmh with Parse.Hmh {hocc=Hocc {stmts; _}; _} -> + match hmh with Parse.Hmh {hocc_=Hocc {stmts; _}; _} -> fold_stmts io precs symbols prods callbacks stmts in (* Close on symbols' first/follow sets. *) diff --git a/bootstrap/bin/hocc/symbol.ml b/bootstrap/bin/hocc/symbol.ml index 02aa6df8b..5c62a2329 100644 --- a/bootstrap/bin/hocc/symbol.ml +++ b/bootstrap/bin/hocc/symbol.ml @@ -3,8 +3,8 @@ open! Basis.Rudiments module T = struct type stmt = - | Token of Parse.token - | Nonterm of Parse.nonterm + | Token of Parse.token_ + | Nonterm of Parse.nonterm_ let pp_stmt stmt formatter = match stmt with diff --git a/bootstrap/bin/hocc/symbol.mli b/bootstrap/bin/hocc/symbol.mli index 247263368..1986c205c 100644 --- a/bootstrap/bin/hocc/symbol.mli +++ b/bootstrap/bin/hocc/symbol.mli @@ -5,8 +5,8 @@ open! Basis.Rudiments (** Declaration AST. *) type stmt = - | Token of Parse.token - | Nonterm of Parse.nonterm + | Token of Parse.token_ + | Nonterm of Parse.nonterm_ module Index = SymbolIndex type t = { @@ -50,11 +50,11 @@ val pseudo_end: t (** [pseudo_end] returns a pseudo-end (⊥) symbol. *) val init_token: index:Index.t -> name:string -> qtype:QualifiedType.t -> prec:Prec.t option - -> stmt:Parse.token option -> alias:string option -> t + -> stmt:Parse.token_ option -> alias:string option -> t (** Used only by [Symbols.insert_token]. *) val init_nonterm: index:Index.t -> name:string -> qtype:QualifiedType.t -> prec:Prec.t option - -> stmt:Parse.nonterm option -> start:bool -> prods:(Prod.t, Prod.cmper_witness) Ordset.t -> t + -> stmt:Parse.nonterm_ option -> start:bool -> prods:(Prod.t, Prod.cmper_witness) Ordset.t -> t (** Used only by [Symbols.insert_nonterm]. *) val is_token: t -> bool diff --git a/bootstrap/bin/hocc/symbols.mli b/bootstrap/bin/hocc/symbols.mli index 67235f657..c50ac7278 100644 --- a/bootstrap/bin/hocc/symbols.mli +++ b/bootstrap/bin/hocc/symbols.mli @@ -26,7 +26,7 @@ val empty: t (** [empty] returns an empty set of symbols. *) val insert_token: name:string -> qtype:QualifiedType.t -> prec:Prec.t option - -> stmt:Parse.token option -> alias:string option -> t -> t + -> stmt:Parse.token_ option -> alias:string option -> t -> t (** [insert_token ~name ~qtype ~prec ~stmt ~alias t] creates a token [Symbol.t] with unique index and returns a new [t] with the symbol inserted. *) @@ -34,7 +34,7 @@ val insert_nonterm_info: name:string -> qtype:QualifiedType.t -> t -> t (** [insert_nonterm_info ~name ~qtype t] creates a non-terminal [info] and returns a new [t] with the info inserted. This is a precursor to a subsequent [insert_nonterm] call. *) -val insert_nonterm: name:string -> prec:Prec.t option -> stmt:Parse.nonterm option -> start:bool +val insert_nonterm: name:string -> prec:Prec.t option -> stmt:Parse.nonterm_ option -> start:bool -> prods:(Prod.t, Prod.cmper_witness) Ordset.t -> t -> t (** [insert_token ~name ~prec ~stmt ~start ~prods t] creates a non-terminal [Symbol.t] with unique index and returns a new [t] with the symbol inserted. *) diff --git a/bootstrap/test/hocc/Binding_error.expected b/bootstrap/test/hocc/Binding_error.expected index 756434edf..6eb8a6ba7 100644 --- a/bootstrap/test/hocc/Binding_error.expected +++ b/bootstrap/test/hocc/Binding_error.expected @@ -1,3 +1,3 @@ hocc: Parsing "./Binding_error.hmh" hocc: Generating LR(1) specification -hocc: At ["./Binding_error.hmh":8:8.."./Binding_error.hmh":8:10): Cannot bind to empty token variant: t:T +hocc: At ["./Binding_error.hmh":8:8.."./Binding_error.hmh":8:10): Cannot bind to empty symbol variant: t:T diff --git a/bootstrap/test/hocc/Example_ml.expected.ml b/bootstrap/test/hocc/Example_ml.expected.ml index 4eebe7d18..549444773 100644 --- a/bootstrap/test/hocc/Example_ml.expected.ml +++ b/bootstrap/test/hocc/Example_ml.expected.ml @@ -1569,7 +1569,7 @@ let calculate s = | Accept _ | Reject _ -> true | _ -> not_reached () - in + in parser', is_done ) in match status with diff --git a/doc/tools/hocc.md b/doc/tools/hocc.md index 2f10a0dd1..99f7284d1 100644 --- a/doc/tools/hocc.md +++ b/doc/tools/hocc.md @@ -71,12 +71,12 @@ Example invocations: ## Parser specification The `hocc` specification grammar is layered onto Hemlock's grammar via the addition of several -keywords: +keywords and one operator: - Parser: `hocc` - Symbols: + [Tokens](#tokens): `token` - + [Non-terminals](#non-terminals): `nonterm`, `start` + + [Non-terminals](#non-terminals): `nonterm`, `start`, `::=` + [Productions](#productions): `epsilon` - [Precedence](#precedence): `neutral`, `left`, `right`, `prec`