Simplify

bootstrap/bin/hocc/aplr.ml

@@ -1,13 +1,8 @@
 open Basis
 open! Basis.Rudiments
 
-(* Pairwise state nubs comprising the (reversed) path from frontiers to roots. Spines are tracked in
- * case a `Distinct` pair is discovered, in which case the spines are passed to
- * `Remergeables.distinct`. *)
-type spines = (StateNub.t * StateNub.t) list
-
 type remergeable =
-  | NotRemergeable of spines (* Spines' state nubs are pairwise distinct. *)
+  | NotRemergeable of Remergeables.spines (* Spines' state nubs are pairwise distinct. *)
   | Remergeable
 
 let bool_of_remergeable remergeable =
@@ -219,101 +214,65 @@ let remergeable_statenubs states remergeables statenub0 statenub1 =
   inner states remergeables ~frontiers_next:[] ~frontiers_current
 
 let remergeable_search io isocores states =
-  let remergeables = Remergeables.empty in
-  (* Initialize the work list with indices of all states in non-singleton isocore sets. *)
-  let worklst, worklst_length, max_mergeable =
-    Isocores.fold_isocore_sets ~init:([], 0L, 0L)
-      ~f:(fun (worklst, worklst_length, max_mergeable) isocore_set ->
-        match Ordset.length isocore_set with
-        | 0L -> not_reached ()
-        | 1L -> worklst, worklst_length, max_mergeable
-        | _ -> begin
-            let worklst =
-              Ordset.fold ~init:worklst ~f:(fun worklst index -> index :: worklst) isocore_set in
-            let isocore_set_length = Ordset.length isocore_set in
-            let worklst_length = worklst_length + isocore_set_length in
-            let max_mergeable = max_mergeable + (pred isocore_set_length) in
-            worklst, worklst_length, max_mergeable
-          end
-      ) isocores
-  in
   let io =
     io.log
-    |> Fmt.fmt "hocc: Searching for remergeable state subgraphs (mergeable/max[worklst]) 0/"
-    |> Uns.pp max_mergeable
-    |> Fmt.fmt "[" |> Uns.pp worklst_length |> Fmt.fmt "]"
+    |> Fmt.fmt "hocc: Searching for remergeable states"
     |> Io.with_log io
   in
-  let io, nmergeable, remergeables =
-    worklst
-    (* Reverse the work list so that remerging tends to follow the same order as splits occurred. *)
-    |> List.rev
-    |> List.foldi_until ~init:(io, 0L, remergeables)
-      ~f:(fun i (io, nmergeable, remergeables) statenub0 ->
-        let io = match i <> 0L && (worklst_length - i) % 1000L = 0L with
-          | false -> io
-          | true -> begin
-              let io =
-                io.log
-                |> Fmt.fmt " "
-                |> Uns.pp nmergeable |> Fmt.fmt "/" |> Uns.pp max_mergeable
-                |> Fmt.fmt "[" |> Uns.pp (worklst_length - i) |> Fmt.fmt "]"
-                |> Io.with_log io
-              in
-              io
-            end
-        in
-        let StateNub.{isocore_set_sn=issn0; _} = statenub0 in
-        let core = Lr1Itemset.core StateNub.(statenub0.lr1itemsetclosure).kernel in
-        let isocore_set = Isocores.get_isocore_set_hlt core isocores in
-        let nmergeable, remergeables = Ordset.fold_until ~init:(nmergeable, remergeables)
-          ~f:(fun (nmergeable, remergeables) statenub1 ->
-            let StateNub.{isocore_set_sn=issn1; _} = statenub1 in
-            (* Eliminate redundant/self pairs via `>`. Furthermore, use issn for comparison rather
-             * than state index so that the order of merge attempts follows the same order as splits
-             * occurred. For example, given a set {0,1,2,3,4}, the order of compatibility tests
-             * during splitting was:
-             *
-             *   (1,0)
-             *   (2,0), (2,1)
-             *   (3,0), (3,1), (3,2)
-             *   (4,0), (4,1), (4,2), (4,3) *)
-            match issn0 > issn1 with
-            | false -> (nmergeable, remergeables), true
-            | true -> begin
-                let nmergeable, remergeables =
-                  match Remergeables.rel statenub0 statenub1 remergeables with
-                  | Distinct
-                  | Mergeable -> nmergeable, remergeables
-                  | Unknown -> begin
-                      let remergeables, remergeable =
-                        remergeable_statenubs states remergeables statenub0 statenub1 in
-                      let subgraph_size = Remergeables.subgraph_size remergeables in
-                      match remergeable with
-                      | NotRemergeable spines ->
-                        nmergeable, Remergeables.distinct spines remergeables
-                      | Remergeable ->
-                        nmergeable + subgraph_size, Remergeables.mergeable remergeables
-                    end
-                in
-                (nmergeable, remergeables), false
-              end
-          ) isocore_set in
-        (io, nmergeable, remergeables), nmergeable = max_mergeable
-      )
-  in
+  (* Fold over all non-singleton isocoric state nub sets in `isocores` to search for remergeable
+   * pairs within each set. Process sets in order of increasing cardinality based on the heuristic
+   * that smaller sets will be involved in less complex splits. Determining the remergeability of
+   * small subgraphs early on reduces the search complexity for large adjacent/containing subgraphs
+   * later on, whereas the converse — searching large subgraphs first — is of negligible benefit
+   * to later searches of small subgraphs. *)
+  let nmergeable, max_mergeable, remergeables =
+    Isocores.fold_non_singleton_isocore_sets ~init:(0L, 0L, Remergeables.empty)
+      ~f:(fun (nmergeable, max_mergeable, remergeables) isocore_set0 ->
+        let isocore_set_length = Ordset.length isocore_set0 in
+        match isocore_set_length with
+        | 0L -> not_reached ()
+        | 1L -> nmergeable, max_mergeable, remergeables
+        | _ -> begin
+            let max_mergeable = max_mergeable + (pred isocore_set_length) in
+            (* Test all n-choose-2 pairings for remergeability. *)
+            let nmergeable, remergeables, _isocore_set1 =
+              Ordset.fold ~init:(nmergeable, remergeables, isocore_set0)
+                ~f:(fun (nmergeable, remergeables, isocore_set1) statenub0 ->
+                  let isocore_set1 = Ordset.remove statenub0 isocore_set1 in
+                  let nmergeable, remergeables =
+                    Ordset.fold ~init:(nmergeable, remergeables)
+                      ~f:(fun (nmergeable, remergeables) statenub1 ->
+                        let nmergeable, remergeables =
+                          (* `Distinct`/`Mergeable` indicates that an earlier search starting at
+                           * predecessors transitively determined this pair's relationship. *)
+                          match Remergeables.rel statenub0 statenub1 remergeables with
+                          | Distinct
+                          | Mergeable -> nmergeable, remergeables
+                          | Unknown -> begin
+                              let remergeables, remergeable =
+                                remergeable_statenubs states remergeables statenub0 statenub1 in
+                              match remergeable with
+                              | NotRemergeable spines ->
+                                nmergeable, Remergeables.distinct spines remergeables
+                              | Remergeable -> begin
+                                  let subgraph_size = Remergeables.subgraph_size remergeables in
+                                  nmergeable + subgraph_size, Remergeables.mergeable remergeables
+                                end
+                            end
+                        in
+                        nmergeable, remergeables
+                      ) isocore_set1
+                  in
+                  nmergeable, remergeables, isocore_set1
+                ) isocore_set0
+            in
+            nmergeable, max_mergeable, remergeables
+          end
+      ) isocores in
   let io =
     io.log
-    |> (fun formatter ->
-      match worklst_length = 0L with
-      | true -> formatter
-      | false -> begin
-          formatter
-          |> Fmt.fmt " "
-          |> Uns.pp nmergeable |> Fmt.fmt "/" |> Uns.pp max_mergeable
-          |> Fmt.fmt "[0]"
-        end
-    )
+    |> Fmt.fmt ": "
+    |> Uns.pp nmergeable |> Fmt.fmt "/" |> Uns.pp max_mergeable
     |> Fmt.fmt "\n"
     |> Io.with_log io
   in

bootstrap/bin/hocc/aplr.mli

@@ -1,9 +1,9 @@
-(** APLR(1) state subgraph remerging functionality. This functionality can also be used as a final
-    compaction step for IELR(1) and PGM LR(1), with the caveat that merged IELR(1) conflict
-    contributions can be difficult to interpret.
+(** APLR(1) state subgraph remerging functionality. Remerging can also be used as a final compaction
+    step for IELR(1) and PGM LR(1), with the caveat that merged IELR(1) conflict contributions can
+    be difficult to interpret.
 
-    Although this module drives LR(1) -> APLR(1) transformation the implementation relies on
-    facilities distributed across other modules, especially:
+    This module drives LR(1) -> APLR(1) transformation using facilities distributed across other
+    modules, especially:
 
     - {!module:Remeargeables} maintains state nub remergeability metadata, fed by paired subgraph
       searches.

bootstrap/bin/hocc/isocores.ml

@@ -178,7 +178,22 @@ let fold ~init ~f {statenubs_map; _} =
     f accum statenub
   ) statenubs_map
 
-let fold_isocore_sets ~init ~f {isocores; _} =
-  Map.fold ~init:[] ~f:(fun accum (_k, v) -> v :: accum ) isocores
-  |> List.sort ~cmp:(fun {isocores_sn=isn0; _} {isocores_sn=isn1; _} -> Uns.cmp isn0 isn1)
+let fold_non_singleton_isocore_sets ~init ~f {isocores; _} =
+  let vs, nvs =
+    isocores
+    |> Map.fold ~init:([], 0L) ~f:(fun (vs, nvs) (_k, ({isocore_set; _} as v)) ->
+      match Ordset.length isocore_set with
+      | 0L -> not_reached ()
+      | 1L -> vs, nvs
+      | _ -> v :: vs, succ nvs
+    )
+  in
+  vs
+  |> List.sort ~length:nvs
+    ~cmp:(fun {isocore_set=set0; isocores_sn=sn0} {isocore_set=set1; isocores_sn=sn1} ->
+      match Uns.cmp (Ordset.length set0) (Ordset.length set1) with
+      | Lt -> Lt
+      | Eq -> Uns.cmp sn0 sn1
+      | Gt -> Gt
+    )
   |> List.fold ~init ~f:(fun accum {isocore_set; _} -> f accum isocore_set)

bootstrap/bin/hocc/isocores.mli

@@ -75,7 +75,8 @@ val fold: init:'accum -> f:('accum -> StateNub.t -> 'accum) -> t -> 'accum
 (** [fold ~init ~f t] iteratively applies [f] to the state nubs in [t], in increasing state nub
     index order. *)
 
-val fold_isocore_sets: init:'accum
+val fold_non_singleton_isocore_sets: init:'accum
   -> f:('accum -> (StateNub.t, StateNub.cmper_witness) Ordset.t -> 'accum) -> t -> 'accum
-(** [fold_isocore_sets ~init ~f t] iteratively applies [f] to the isocore sets in [t], in increasing
+(** [fold_non_singleton_isocore_sets ~init ~f t] iteratively applies [f] to the non-singleton
+    isocore sets in [t], ordered primarily by increasing set cardinality, secondarily by stable
     isocore sequence number order. *)

bootstrap/bin/hocc/remergeables.ml

@@ -6,6 +6,8 @@ type rel =
   | Distinct
   | Mergeable
 
+type spines = (StateNub.t * StateNub.t) list
+
 type core_rels = {
   (* Sets of `Mergeable` states, where each bitset index is an isocore set serial number (issn).
    * Mergeability is transitive, so each issn is a member of at most one set. *)

bootstrap/bin/hocc/remergeables.mli

@@ -10,6 +10,11 @@ type rel =
   | Distinct (* Distinct subgraph features prevent remerging. *)
   | Mergeable (* Remergeable. *)
 
+(** Pairwise state nubs comprising the (reversed) path from [frontiers..roots]. Spines are tracked
+    in case a `Distinct` pair is discovered, in which case the spines are passed to `distinct` to
+    be recorded as pairwise distinct. *)
+type spines = (StateNub.t * StateNub.t) list
+
 type t
 
 val fmt: ?alt:bool -> ?width:uns -> t -> (module Fmt.Formatter) -> (module Fmt.Formatter)
@@ -33,7 +38,7 @@ val expand: StateNub.t -> StateNub.t -> t -> t
 (** [expand statenub0 statenub1] expands the subgraphs being explored by tentatively recording a
     [Remergeable] relationship between [statenub0] and [statenub1]. *)
 
-val distinct: (StateNub.t * StateNub.t) list -> t -> t
+val distinct: spines -> t -> t
 (** [distinct spines t] concludes subgraph exploration with a determination that the subgraphs are
     distinct, and therefore the spines (i.e. paths from exploration roots to distinct state pair)
     are distinct. The spines' relationships transition to [Distinct] and all other tentative

bootstrap/bin/hocc/spec.ml

@@ -1040,9 +1040,18 @@ and log_conflicts io ~resolve states =
     )
     |> Fmt.fmt " conflict"
     |> (fun formatter -> match conflicts with 1L -> formatter | _ -> formatter |> Fmt.fmt "s")
-    |> Fmt.fmt " in " |> Uns.pp conflict_states
-    |> Fmt.fmt " state"
-    |> (fun formatter -> match conflict_states with 1L -> formatter | _ -> formatter |> Fmt.fmt "s")
+    |> (fun formatter ->
+      match conflicts with
+      | 0L -> formatter
+      | _ -> begin
+          formatter
+          |> Fmt.fmt " in " |> Uns.pp conflict_states
+          |> Fmt.fmt " state"
+          |> (fun formatter ->
+            match conflict_states with 1L -> formatter | _ -> formatter |> Fmt.fmt "s"
+          )
+        end
+    )
     |> (fun formatter -> match conflicts = 0L with
       | true -> formatter
       | false -> begin

bootstrap/test/hocc/Example.expected

@@ -7,9 +7,9 @@ hocc: Generating LR(1) item set closures (workq/total) 0/14
 hocc: Generating 14 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+.+.+.++
 hocc: 0 unreachable states
-hocc: Searching for remergeable state subgraphs (mergeable/max[worklst]) 0/0[0]
+hocc: Searching for remergeable states: 0/0
 hocc: 0 remergeable states
-hocc: 0 unresolvable conflicts in 0 states
+hocc: 0 unresolvable conflicts
 hocc: Generating text report
 hocc: Writing "./hocc/Example.txt"
 hocc: Writing "./Example.hmi"

bootstrap/test/hocc/Example_b.expected

@@ -7,8 +7,8 @@ hocc: Generating LR(1) item set closures (workq/total) 0/14
 hocc: Generating 14 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+.+.+.++
 hocc: 0 unreachable states
-hocc: Searching for remergeable state subgraphs (mergeable/max[worklst]) 0/0[0]
+hocc: Searching for remergeable states: 0/0
 hocc: 0 remergeable states
-hocc: 0 unresolvable conflicts in 0 states
+hocc: 0 unresolvable conflicts
 hocc: Writing "./Example_b.hmi"
 hocc: Writing "./Example_b.hm"

bootstrap/test/hocc/Example_c.expected

@@ -7,8 +7,8 @@ hocc: Generating LR(1) item set closures (workq/total) 0/14
 hocc: Generating 14 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+.+.+.++
 hocc: 0 unreachable states
-hocc: Searching for remergeable state subgraphs (mergeable/max[worklst]) 0/0[0]
+hocc: Searching for remergeable states: 0/0
 hocc: 0 remergeable states
-hocc: 0 unresolvable conflicts in 0 states
+hocc: 0 unresolvable conflicts
 hocc: Writing "./Example_c.hmi"
 hocc: Writing "./Example_c.hm"

bootstrap/test/hocc/Gawk_aielr_myes.expected

@@ -13,7 +13,7 @@ hocc: Generating 616 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+.+....+..+.....+.....+.+.....+.....+.++.+.++++++
 hocc: 4 unreachable states
 hocc: Reindexing 612 LR(1) states
-hocc: Searching for remergeable state subgraphs (mergeable/max[worklst]) 0/292[423] 245/292[0]
+hocc: Searching for remergeable states: 245/292
 hocc: Remerging 245 LR(1) states
 hocc: Reindexing 367 LR(1) states
 hocc: 104 unresolvable conflicts in 66 states (38 ⊥, 66 shift-reduce, 0 reduce-reduce)

bootstrap/test/hocc/Gpic_aaplr.expected

@@ -7,7 +7,7 @@ hocc: Generating 4_871 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+.+......+....+.....+....+..+..+..+.+++
 hocc: 37 unreachable states
 hocc: Reindexing 4_834 LR(1) states
-hocc: Searching for remergeable state subgraphs (mergeable/max[worklst]) 0/4_411[4_810] 3_411/4_411[4_000] 3_954/4_411[3_000] 4_262/4_411[2_000] 4_404/4_411[1_000] 4_406/4_411[0]
+hocc: Searching for remergeable states: 4_406/4_411
 hocc: Remerging 4_406 LR(1) states
 hocc: Reindexing 428 LR(1) states
 hocc: 239 unresolvable conflicts in 239 states (239 ⊥, 0 shift-reduce, 0 reduce-reduce)

bootstrap/test/hocc/Gpic_aielr_myes.expected

@@ -13,7 +13,7 @@ hocc: Generating 450 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+.+....+....+..+.+.+.+++
 hocc: 3 unreachable states
 hocc: Reindexing 447 LR(1) states
-hocc: Searching for remergeable state subgraphs (mergeable/max[worklst]) 0/24[38] 19/24[0]
+hocc: Searching for remergeable states: 19/24
 hocc: Remerging 19 LR(1) states
 hocc: Reindexing 428 LR(1) states
 hocc: 239 unresolvable conflicts in 239 states (239 ⊥, 0 shift-reduce, 0 reduce-reduce)

bootstrap/test/hocc/Hocc.expected

@@ -7,10 +7,10 @@ hocc: Generating 860 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+.+.....+...+....+..+..+....+..+..+..+.+...+.++.+.+.++
 hocc: 1 unreachable state
 hocc: Reindexing 859 LR(1) states
-hocc: Searching for remergeable state subgraphs (mergeable/max[worklst]) 0/601[785] 601/601[0]
+hocc: Searching for remergeable states: 601/601
 hocc: Remerging 601 LR(1) states
 hocc: Reindexing 258 LR(1) states
-hocc: 0 unresolvable conflicts in 0 states
+hocc: 0 unresolvable conflicts
 hocc: Generating text report
 hocc: Generating hocc report
 hocc: Writing "./hocc/Hocc.txt"

bootstrap/test/hocc/IelrFig1.expected

@@ -12,7 +12,7 @@ hocc: Generating LR(1) item set closures (workq/total) 0/12
 hocc: Generating 12 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+...+.+.+
 hocc: 0 unreachable states
-hocc: 0 unresolvable conflicts in 0 states
+hocc: 0 unresolvable conflicts
 hocc: Generating text report
 hocc: Generating hocc report
 hocc: Writing "./hocc/IelrFig1.txt"

bootstrap/test/hocc/IelrFig2.expected

@@ -13,7 +13,7 @@ hocc: Generating 21 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+...+.+.+
 hocc: 2 unreachable states
 hocc: Reindexing 19 LR(1) states
-hocc: 0 unresolvable conflicts in 0 states
+hocc: 0 unresolvable conflicts
 hocc: 1 unused production:
 hocc:    S ::= Tb C Ta
 hocc: Generating text report

bootstrap/test/hocc/IelrFig3.expected

@@ -13,7 +13,7 @@ hocc: Generating 21 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+...+.+.+
 hocc: 6 unreachable states
 hocc: Reindexing 15 LR(1) states
-hocc: 0 unresolvable conflicts in 0 states
+hocc: 0 unresolvable conflicts
 hocc: 1 unused precedence:
 hocc:    neutral p3 < p2
 hocc: 1 unused non-terminal:

bootstrap/test/hocc/IelrFig3_apgm.expected

@@ -7,7 +7,7 @@ hocc: Generating 19 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+...+.+.+
 hocc: 8 unreachable states
 hocc: Reindexing 11 LR(1) states
-hocc: 0 unresolvable conflicts in 0 states
+hocc: 0 unresolvable conflicts
 hocc: 2 unused precedences:
 hocc:    neutral p2 < p1
 hocc:    neutral p3 < p2

bootstrap/test/hocc/IelrFig5.expected

@@ -12,7 +12,7 @@ hocc: Generating LR(1) item set closures (workq/total) 0/22
 hocc: Generating 22 LR(1) states
 hocc: Tracing automaton (.+=actions[+gotos])+...+++.++.+.+.+
 hocc: 0 unreachable states
-hocc: 0 unresolvable conflicts in 0 states
+hocc: 0 unresolvable conflicts
 hocc: Generating text report
 hocc: Generating hocc report
 hocc: Writing "./hocc/IelrFig5.txt"