Yacc

bootstrap/bin/hocc/aplr.ml

@@ -75,7 +75,10 @@ let remergeable_actions states remergeables frontiers spines =
         | None, Some (symbol_index, action_set)
           -> begin
               (* All states in the mergeable set must either have an empty action set or identical
-               * nonempty action set. *)
+               * nonempty action set. Note that these are post-conflict-resolution action sets; were
+               * they pre-conflict-resolution action sets, the equivalent remergeability test would
+               * require identical dominant actions (or identical [possibly unresolvable] action
+               * sets). *)
               match reduces_only action_set with
               | false -> remergeables, frontiers, NotRemergeable spines
               | true -> begin

bootstrap/bin/hocc/conf.ml

@@ -29,15 +29,12 @@ let pp_gc gc formatter =
     | No -> "No"
   )
 
-type remerge =
-  | Default of bool
-  | Explicit of bool
-
 type t = {
   verbose: bool;
   warn: bool;
   text: bool;
   hocc: bool;
+  yacc: bool;
   algorithm: algorithm;
   resolve_opt: bool option;
   remerge_opt: bool option;
@@ -49,13 +46,14 @@ type t = {
   dstdir_opt: Path.t option;
 }
 
-let pp {verbose; warn; text; hocc; algorithm; resolve_opt; remerge_opt; gc; hemlock; ocaml;
+let pp {verbose; warn; text; hocc; yacc; algorithm; resolve_opt; remerge_opt; gc; hemlock; ocaml;
   srcdir_opt; module_opt; dstdir_opt} formatter =
   formatter
   |> Fmt.fmt "{verbose=" |> Bool.pp verbose
   |> Fmt.fmt "; warn=" |> Bool.pp warn
   |> Fmt.fmt "; text=" |> Bool.pp text
   |> Fmt.fmt "; hocc=" |> Bool.pp hocc
+  |> Fmt.fmt "; yacc=" |> Bool.pp yacc
   |> Fmt.fmt "; algorithm=" |> pp_algorithm algorithm
   |> Fmt.fmt "; resolve_opt=" |> Option.pp Bool.pp resolve_opt
   |> Fmt.fmt "; remerge_opt=" |> Option.pp Bool.pp remerge_opt
@@ -72,6 +70,7 @@ let default = {
   warn=false;
   text=false;
   hocc=false;
+  yacc=false;
   algorithm=Aplr;
   resolve_opt=None;
   remerge_opt=None;
@@ -91,14 +90,15 @@ let resolve algorithm resolve_opt =
 
 let remerge algorithm remerge_opt =
   match algorithm, remerge_opt with
-  | _, Some remerge -> Explicit remerge
+  | _, Some remerge
+    -> remerge
   | Aplr, None
-    -> Default true
   | Ielr, None
-  | Lr, None
   | Pgm, None
+    -> true
+  | Lr, None
   | Lalr, None
-    -> Default false
+    -> false
 
 let usage error =
   let exit_code, formatter = match error with
@@ -115,8 +115,10 @@ Parameters:
               -w[arn] : Warn about unused grammar constructs.
          -txt | -text : Write a detailed automaton description in plain text
                         format to "<dstdir>/hocc/<module>.txt".
-         -hmh | -hocc : Write a complete grammar specification in hocc format to
+         -hmh | -hocc : Write a complete grammar specification in Hocc format to
                         "<dstdir>/hocc/<module>.hmh".
+              -y[acc] : Write a complete grammar specification in Yacc format to
+                        "<dstdir>/hocc/<module>.y".
    -a[lgorithm] <alg> : Use the specified <alg>orithm for generating an
                         automaton. Defaults to aplr.
                         - aplr: Adequacy Preservation LR(1)
@@ -127,7 +129,8 @@ Parameters:
   -r[esolve] (yes|no) : Control conflict resolution enablement. Defaults to yes
                         for aplr/ielr/lr algorithms, no for pgm/lalr algorithms.
 -[re]m[erge] (yes|no) : Control compatible state subgraph remerging enablement.
-                        Defaults to yes for aplr algorithm, no otherwise.
+                        Defaults to yes for aplr/ielr/pgm algorithms, no for
+                        lr/lalr algorithms.
   -g[c] (pre|post|no) : Control unreachable state garbage collection enablement
                         and ordering relative to remerging. Defaults to
                         post-remerging.
@@ -213,6 +216,7 @@ let of_argv argv =
         | "-w" | "-warn" -> f {t with warn=true} argv (succ i)
         | "-txt" | "-text" -> f {t with text=true} argv (succ i)
         | "-hmh" | "-hocc" -> f {t with hocc=true} argv (succ i)
+        | "-y" | "-yacc" -> f {t with yacc=true} argv (succ i)
         | "-a" | "-algorithm" -> begin
             let algorithm = match Bytes.to_string_replace (arg_arg argv i) with
               | "aplr" -> Aplr
@@ -329,6 +333,9 @@ let text {text; _} =
 let hocc {hocc; _} =
   hocc
 
+let yacc {yacc; _} =
+  yacc
+
 let algorithm {algorithm; _} =
   algorithm
 

bootstrap/bin/hocc/conf.mli

@@ -14,10 +14,6 @@ type gc =
   | PostRemerge (** Perform unreachable state garbage collection after potentially remerging. *)
   | No (** Do not perform unreachable state garbage collection. *)
 
-type remerge =
-  | Default of bool (** Default; no remerge parameter specified. *)
-  | Explicit of bool (** Explicit remerge parameter specified. *)
-
 val pp_algorithm: algorithm -> (module Fmt.Formatter) -> (module Fmt.Formatter)
 (** [pp_algorithm algorithm] formats [algorithm]. *)
 
@@ -39,7 +35,10 @@ val text: t -> bool
 (** [text t] returns true if a plain-text automaton description is to be generated. *)
 
 val hocc: t -> bool
-(** [hocc t] returns true if a hocc-format grammar specification is to be generated. *)
+(** [hocc t] returns true if a Hocc-format grammar specification is to be generated. *)
+
+val yacc: t -> bool
+(** [yacc t] returns true if a Yacc-format grammar specification is to be generated. *)
 
 val algorithm: t -> algorithm
 (** [algorithm t] returns the algorithm to be used when generating the automaton. *)
@@ -50,9 +49,8 @@ val resolve: t -> bool
 val gc: t -> gc
 (** [gc t] returns whether/when to perform unreachable state garbage collection. *)
 
-val remerge: t -> remerge
-(** [remerge t] returns a [Default]/[Explicit] remerging parameter, true if remerging of equivalent
-    split states is enabled. *)
+val remerge: t -> bool
+(** [remerge t] returns true if remerging of equivalent split states is enabled. *)
 
 val hemlock: t -> bool
 (** [hemlock t] returns true if a Hemlock-based parser is to be generated. *)

bootstrap/bin/hocc/description.ml

@@ -239,78 +239,70 @@ let generate_txt conf io Spec.{algorithm; precs; symbols; prods; states; _} =
   )
   |> Fmt.fmt "Tokens" |> Fmt.fmt "\n"
   |> (fun formatter ->
-    Symbols.symbols_fold ~init:formatter
-      ~f:(fun formatter (Symbol.{name; alias; stype; prec; first; follow; _} as symbol) ->
-        match Symbol.is_token symbol with
-        | false -> formatter
-        | true -> begin
-            formatter
-            |> Fmt.fmt "    " |> Fmt.fmt "token "
-            |> Fmt.fmt name
-            |> (fun formatter ->
-              match alias with
-              | None -> formatter
-              | Some alias -> formatter |> Fmt.fmt " " |> String.pp alias
-            )
-            |> (fun formatter ->
-              match SymbolType.is_explicit stype with
-              | false -> formatter
-              | true ->
-                formatter |> Fmt.fmt " of " |> Fmt.fmt (SymbolType.to_string stype)
-            )
-            |> (fun formatter ->
-              match prec with
-              | None -> formatter
-              | Some prec -> formatter |> Fmt.fmt " " |> pp_prec precs prec
-            )
-            |> Fmt.fmt "\n"
-            |> Fmt.fmt "        First: "
-            |> pp_symbol_set first
-            |> Fmt.fmt "\n"
-            |> Fmt.fmt "        Follow: "
-            |> pp_symbol_set follow
-            |> Fmt.fmt "\n"
-          end
+    Symbols.tokens_fold ~init:formatter
+      ~f:(fun formatter Symbol.{name; alias; stype; prec; first; follow; _} ->
+        formatter
+        |> Fmt.fmt "    " |> Fmt.fmt "token "
+        |> Fmt.fmt name
+        |> (fun formatter ->
+          match alias with
+          | None -> formatter
+          | Some alias -> formatter |> Fmt.fmt " " |> String.pp alias
+        )
+        |> (fun formatter ->
+          match SymbolType.is_explicit stype with
+          | false -> formatter
+          | true ->
+            formatter |> Fmt.fmt " of " |> Fmt.fmt (SymbolType.to_string stype)
+        )
+        |> (fun formatter ->
+          match prec with
+          | None -> formatter
+          | Some prec -> formatter |> Fmt.fmt " " |> pp_prec precs prec
+        )
+        |> Fmt.fmt "\n"
+        |> Fmt.fmt "        First: "
+        |> pp_symbol_set first
+        |> Fmt.fmt "\n"
+        |> Fmt.fmt "        Follow: "
+        |> pp_symbol_set follow
+        |> Fmt.fmt "\n"
       ) symbols
   )
   |> Fmt.fmt "Non-terminals" |> Fmt.fmt "\n"
   |> (fun formatter ->
-    Symbols.symbols_fold ~init:formatter
-      ~f:(fun formatter (Symbol.{name; start; stype; prods; first; follow; _} as symbol) ->
-        match Symbol.is_nonterm symbol with
-        | false -> formatter
-        | true -> begin
-            formatter
-            |> Fmt.fmt "    "
-            |> Fmt.fmt (match start with
-              | true -> "start "
-              | false -> "nonterm "
-            )
-            |> Fmt.fmt name
-            |> (fun formatter ->
-              match SymbolType.is_explicit stype with
-              | false -> formatter
-              | true ->
-                formatter |> Fmt.fmt " of " |> Fmt.fmt (SymbolType.to_string stype)
-            )
-            |> Fmt.fmt "\n"
-            |> Fmt.fmt "        First: "
-            |> pp_symbol_set first
-            |> Fmt.fmt "\n"
-            |> Fmt.fmt "        Follow: "
-            |> pp_symbol_set follow
-            |> Fmt.fmt "\n"
-            |> Fmt.fmt "        Productions\n"
-            |> (fun formatter ->
-              Array.fold ~init:formatter
-                ~f:(fun formatter prod ->
-                  formatter
-                  |> Fmt.fmt "            "
-                  |> pp_prod prod
-                  |> Fmt.fmt "\n"
-                ) prods
-            )
-          end
+    Symbols.nonterms_fold ~init:formatter
+      ~f:(fun formatter Symbol.{name; start; stype; prods; first; follow; _} ->
+        formatter
+        |> Fmt.fmt "    "
+        |> Fmt.fmt (match start with
+          | true -> "start "
+          | false -> "nonterm "
+        )
+        |> Fmt.fmt name
+        |> (fun formatter ->
+          match SymbolType.is_explicit stype with
+          | false -> formatter
+          | true ->
+            formatter |> Fmt.fmt " of " |> Fmt.fmt (SymbolType.to_string stype)
+        )
+        |> Fmt.fmt "\n"
+        |> Fmt.fmt "        First: "
+        |> pp_symbol_set first
+        |> Fmt.fmt "\n"
+        |> Fmt.fmt "        Follow: "
+        |> pp_symbol_set follow
+        |> Fmt.fmt "\n"
+        |> Fmt.fmt "        Productions\n"
+        |> (fun formatter ->
+          Array.fold ~init:formatter
+            ~f:(fun formatter prod ->
+              formatter
+              |> Fmt.fmt "            "
+              |> pp_prod prod
+              |> Fmt.fmt "\n"
+            ) prods
+        )
       ) symbols
   )
   |> Fmt.fmt states_algorithm |> Fmt.fmt " States"