Implement various modules on which Spec depends

bootstrap/bin/hocc/nonterm.ml

@@ -0,0 +1,32 @@
+open Basis
+open Basis.Rudiments
+
+module T = struct
+  type t = {
+    index: uns;
+    name: string;
+    start: bool;
+    prec: Prec.t option;
+    prods: (Prod.t, Prod.cmper_witness) Ordset.t;
+  }
+
+  let hash_fold {index; _} state =
+    Uns.hash_fold index state
+
+  let cmp {index=index0; _} {index=index1; _} =
+    Uns.cmp index0 index1
+
+  let pp {index; name; start; prec; prods} formatter =
+    formatter
+    |> Fmt.fmt "{index=" |> Uns.pp index
+    |> Fmt.fmt "; name=" |> String.pp name
+    |> Fmt.fmt "; start=" |> Bool.pp start
+    |> Fmt.fmt "; prec=" |> (Option.pp Prec.pp) prec
+    |> Fmt.fmt "; prods=" |> (List.pp Prod.pp) (Ordset.to_list prods)
+    |> Fmt.fmt "}"
+end
+include T
+include Identifiable.Make(T)
+
+let init ~index ~name ~start ~prec ~prods =
+  {index; name; start; prec; prods}

bootstrap/bin/hocc/nonterm.mli

@@ -0,0 +1,15 @@
+open Basis
+open Basis.Rudiments
+
+type t = {
+  index: uns;
+  name: string;
+  start: bool;
+  prec: Prec.t option;
+  prods: (Prod.t, Prod.cmper_witness) Ordset.t;
+}
+
+include IdentifiableIntf.S with type t := t
+
+val init: index:uns -> name:string -> start:bool -> prec:Prec.t option
+  -> prods:(Prod.t, Prod.cmper_witness) Ordset.t -> t

bootstrap/bin/hocc/prod.ml

@@ -0,0 +1,30 @@
+open Basis
+open Basis.Rudiments
+
+module T = struct
+  type t = {
+    index: uns;
+    lhs_index: uns;
+    rhs_indexes: uns array;
+    prec: Prec.t option;
+  }
+
+  let hash_fold {index; _} state =
+    Uns.hash_fold index state
+
+  let cmp {index=index0; _} {index=index1; _} =
+    Uns.cmp index0 index1
+
+  let pp {index; lhs_index; rhs_indexes; prec} formatter =
+    formatter
+    |> Fmt.fmt "{index=" |> Uns.pp index
+    |> Fmt.fmt "; lhs_index=" |> Uns.pp lhs_index
+    |> Fmt.fmt "; rhs_indexes=" |> (Array.pp Uns.pp) rhs_indexes
+    |> Fmt.fmt "; prec=" |> (Option.pp Prec.pp) prec
+    |> Fmt.fmt "}"
+end
+include T
+include Identifiable.Make(T)
+
+let init ~index ~lhs_index ~rhs_indexes ~prec =
+  {index; lhs_index; rhs_indexes; prec}

bootstrap/bin/hocc/prod.mli

@@ -0,0 +1,13 @@
+open Basis
+open Basis.Rudiments
+
+type t = {
+  index: uns;
+  lhs_index: uns;
+  rhs_indexes: uns array;
+  prec: Prec.t option;
+}
+
+include IdentifiableIntf.S with type t := t
+
+val init: index:uns -> lhs_index:uns -> rhs_indexes:uns array -> prec:Prec.t option -> t

bootstrap/bin/hocc/spec.ml

@@ -3,12 +3,13 @@ open! Basis.Rudiments
 
 type t = {
   precs: Prec.t array;
+  symbols: Symbol.t array;
 }
 
 let string_of_token token =
   Hmc.Source.Slice.to_string (Scan.Token.source token)
 
-let fold_hmh io ~precs_map hmh =
+let precs_init io hmh =
   let rec fold_precs_tl io ~precs_map rels doms precs_tl = begin
     match precs_tl with
     | Parse.PrecsTlCommaUident {uident=Uident {uident}; precs_tl; _} -> begin
@@ -111,19 +112,34 @@ let fold_hmh io ~precs_map hmh =
         fold_stmts_tl io ~precs_map stmts_tl
       end
   end in
-  match hmh with Parse.Hmh {hocc=Hocc {stmts; _}; _} -> fold_stmts io ~precs_map stmts
-
-let init io hmh =
-  let io = io.log |> Fmt.fmt "hocc: Generating specification\n" |> Io.with_log io in
-  let io, precs_map = fold_hmh io ~precs_map:(Map.empty (module String)) hmh in
+  let io, precs_map = match hmh with Parse.Hmh {hocc=Hocc {stmts; _}; _} ->
+    fold_stmts io ~precs_map:(Map.empty (module String)) stmts
+  in
   let precs_kvpairs =
     Map.to_array precs_map
     |> Array.sort ~cmp:(fun (_, Prec.{index=a; _}) (_, {index=b; _}) -> Uns.cmp a b) in
   let precs = Array.init (Array.range precs_kvpairs) ~f:(fun i ->
     match Array.get i precs_kvpairs with
     | (_, prec) -> prec
   ) in
-  io, {precs}
+  io, precs
+
+let tokens_init io _precs _hmh =
+  io, [|(*XXX*)|]
+
+let symbol_map_init io _precs _tokens _hmh =
+  io, Map.empty (module String)
+
+let symbols_init io _precs tokens _symbol_map _hmh =
+  io, tokens (* XXX *)
+
+let init io hmh =
+  let io = io.log |> Fmt.fmt "hocc: Generating specification\n" |> Io.with_log io in
+  let io, precs = precs_init io hmh in
+  let io, tokens = tokens_init io precs hmh in
+  let io, symbol_map = symbol_map_init io precs tokens hmh in
+  let io, symbols = symbols_init io precs tokens symbol_map hmh in
+  io, {precs; symbols}
 
 let to_txt conf io t =
   let io = io.log |> Fmt.fmt "hocc: Generating text report\n" |> Io.with_log io in

bootstrap/bin/hocc/spec.mli

@@ -3,6 +3,7 @@ open! Basis.Rudiments
 
 type t = {
   precs: Prec.t array;
+  symbols: Symbol.t array;
 }
 
 val init: Io.t -> Parse.hmh -> Io.t * t

bootstrap/bin/hocc/symbol.ml

@@ -0,0 +1,33 @@
+open Basis
+open! Basis.Rudiments
+
+module T = struct
+  type t =
+    | Token of Token.t
+    | Nonterm of Nonterm.t
+
+  let hash_fold t state =
+    match t with
+    | Token token -> Token.hash_fold token state
+    | Nonterm nonterm -> Nonterm.hash_fold nonterm state
+
+  let cmp t0 t1 =
+    match t0, t1 with
+    | Token token0, Token token1 -> Token.cmp token0 token1
+    | Token _, Nonterm _ -> Cmp.Lt
+    | Nonterm _, Token _ -> Cmp.Gt
+    | Nonterm nonterm0, Nonterm nonterm1 -> Nonterm.cmp nonterm0 nonterm1
+
+  let pp t formatter =
+    match t with
+    | Token token -> formatter |> Fmt.fmt "Token " |> Token.pp token
+    | Nonterm nonterm -> formatter |> Fmt.fmt "Nonterm " |> Nonterm.pp nonterm
+end
+include T
+include Identifiable.Make(T)
+
+let of_token token =
+  Token token
+
+let of_nonterm nonterm =
+  Nonterm nonterm

bootstrap/bin/hocc/symbol.mli

@@ -0,0 +1,11 @@
+open Basis
+open! Basis.Rudiments
+
+type t =
+  | Token of Token.t
+  | Nonterm of Nonterm.t
+
+include IdentifiableIntf.S with type t := t
+
+val of_token: Token.t -> t
+val of_nonterm: Nonterm.t -> t

bootstrap/bin/hocc/token.ml

@@ -0,0 +1,30 @@
+open Basis
+open Basis.Rudiments
+
+module T = struct
+  type t = {
+    index: uns;
+    name: string;
+    alias: string option;
+    prec: Prec.t option;
+  }
+
+  let hash_fold {index; _} state =
+    Uns.hash_fold index state
+
+  let cmp {index=index0; _} {index=index1; _} =
+    Uns.cmp index0 index1
+
+  let pp {index; name; alias; prec} formatter =
+    formatter
+    |> Fmt.fmt "{index=" |> Uns.pp index
+    |> Fmt.fmt "; name=" |> String.pp name
+    |> Fmt.fmt "; alias=" |> (Option.pp String.pp) alias
+    |> Fmt.fmt "; prec=" |> (Option.pp Prec.pp) prec
+    |> Fmt.fmt "}"
+end
+include T
+include Identifiable.Make(T)
+
+let init ~index ~name ~alias ~prec =
+  {index; name; alias; prec}

bootstrap/bin/hocc/token.mli

@@ -0,0 +1,13 @@
+open Basis
+open Basis.Rudiments
+
+type t = {
+  index: uns;
+  name: string;
+  alias: string option;
+  prec: Prec.t option;
+}
+
+include IdentifiableIntf.S with type t := t
+
+val init: index:uns -> name:string -> alias:string option -> prec:Prec.t option -> t

doc/tools/hocc.md

@@ -89,7 +89,7 @@ parser states can be used as persistent reusable snapshots.
                 index: uns # Index in `precs` array.
                 name: string
                 assoc: option Assoc.t
-                doms: Set.t uns # Indices in `precs` array of dominator precedences.
+                doms: Ordset.t uns # Indices in `precs` array of dominator precedences.
               }
 
             pp >e: t -> Fmt.Formatter e >e-> Fmt.Formatter e
@@ -114,7 +114,7 @@ parser states can be used as persistent reusable snapshots.
 
         Prod = {
             type t: t = {
-                index: uns # Index in `reductions` array.
+                index: uns # Index of corresponding reduction function in `reductions` array.
                 lhs_index: uns
                 rhs_indexes: array uns
                 prec: option Prec.t
@@ -131,7 +131,7 @@ parser states can be used as persistent reusable snapshots.
                 name: string
                 start: bool
                 prec: option Prec.t
-                prods: Set.t Prod.t
+                prods: Ordset.t Prod.t
               }
 
             hash_map: t -> Hash.State.t -> Hash.State.t
@@ -157,7 +157,7 @@ parser states can be used as persistent reusable snapshots.
             type t: t = {
                 prod: Prod.t
                 dot_pos: uns
-                lookahead: Set.t Token.t
+                lookahead: Ordset.t Token.t
               }
 
             hash_map: t -> Hash.State.t -> Hash.State.t
@@ -167,8 +167,8 @@ parser states can be used as persistent reusable snapshots.
 
         ItemSet = {
             type t: t = {
-                kernel: Set.t Item.t
-                added: Set.t Item.t
+                kernel: Ordset.t Item.t
+                added: Ordset.t Item.t
               }
 
             hash_map: t -> Hash.State.t -> Hash.State.t