Begin implementing hocc

- Add hocc syntax highlighting for kakoune.
  There's probably a way to avoid the near-complete duplication with the Hemlock
  syntax highlighting configuration, but it may involve shell evaluation of all
  highlighter additions.
- Add `Os.argv`. Command line parameters may not be UTF-8-encoded, so it's not
  safe to use OCaml's `Sys.argv`.

bootstrap/bin/hmc.ml → bootstrap/bin/hmc/hmc.ml

@@ -36,10 +36,9 @@ let scan_file path =
   ()
 
 let _ =
-  match Array.length Sys.argv with
+  match Array.length Os.argv with
   | 0L | 1L -> halt "hmc usage: hmc <path>"
   | _ -> begin
-      let path_str = Array.get 1L Sys.argv in
-      let path = Path.of_string path_str in
+      let path = Path.of_bytes (Bytes.Slice.init (Array.get 1L Os.argv)) in
       scan_file path
     end

bootstrap/bin/hocc/conf.ml

@@ -0,0 +1,187 @@
+open! Basis
+include Basis.Rudiments
+
+type algorithm =
+  | LR1Compact
+  | LR1Canonical
+
+let pp_algorithm algorithm formatter =
+  formatter |> Fmt.fmt (match algorithm with
+    | LR1Compact -> "LR1Compact"
+    | LR1Canonical -> "LR1Canonical"
+  )
+
+type language =
+  | Hemlock
+  | OCaml
+
+let pp_language language formatter =
+  formatter |> Fmt.fmt (match language with
+    | Hemlock -> "Hemlock"
+    | OCaml -> "OCaml"
+  )
+
+type t = {
+  verbose: bool;
+  report: bool;
+  graph: bool;
+  algorithm: algorithm;
+  language: language;
+  srcdir_opt: Path.t option;
+  module_opt: Path.Segment.t option;
+  dstdir_opt: Path.t option;
+}
+
+let pp {verbose; report; graph; algorithm; language; srcdir_opt; module_opt; dstdir_opt} formatter =
+  formatter
+  |> Fmt.fmt "{verbose=" |> Bool.pp verbose
+  |> Fmt.fmt "; report=" |> Bool.pp report
+  |> Fmt.fmt "; graph=" |> Bool.pp graph
+  |> Fmt.fmt "; algorithm=" |> pp_algorithm algorithm
+  |> Fmt.fmt "; language=" |> pp_language language
+  |> Fmt.fmt "; srcdir_opt=" |> (Option.pp Path.pp) srcdir_opt
+  |> Fmt.fmt "; module_opt=" |> (Option.pp Path.Segment.pp) module_opt
+  |> Fmt.fmt "; dstdir_opt=" |> (Option.pp Path.pp) dstdir_opt
+  |> Fmt.fmt "}"
+
+let default = {
+  verbose=false;
+  report=false;
+  graph=false;
+  algorithm=LR1Compact;
+  language=Hemlock;
+  srcdir_opt=None;
+  module_opt=None;
+  dstdir_opt=None;
+}
+
+let usage error =
+  let exit_code, formatter = match error with
+    | false -> 0, File.Fmt.stdout
+    | true -> 1, File.Fmt.stderr
+  in
+  formatter
+  |> Fmt.fmt "\
+hocc usage: hocc <options>
+
+Options:
+           -h[elp] : Print command usage and exit.
+        -v[erbose] : Print verbose progress information during parser
+                     generation.
+         -r[eport] : Write a detailed automoton description to
+                     <outdir>/<basename>.report .
+          -g[raph] : Write a graph of the precedence relationships in Graphviz
+                     dot format to <outdir>/<basename>.dot .
+      -c[anonical] : Generate a canonical LR(1) parser rather than a compact
+                     LR(1) parser.
+            -ocaml : Generate OCaml output rather than Hemlock output. This is
+                     brittle functionality intended only for Hemlock
+                     bootstrapping.
+      -s[rc] <src> : Path and module name of input source, where inputs match
+                     <src>.hmh[i] and <src> comprises the source directory and
+                     module name, [<srcdir>/]<module> .
+-d[stdir] <dstdir> : Path to directory in which to place generated output, such
+                     that output file paths match
+                     <dstdir>/<module>.{hm,hmi,report,dot,ml,mli} . Defaults to
+                     <srcdir> .
+"
+  |> ignore;
+  Stdlib.exit exit_code
+
+let of_argv argv =
+  let arg_arg argv i = begin
+    let i' = succ i in
+    match i' < Array.length argv with
+    | false -> begin
+        let arg = Bytes.to_string_replace (Array.get i argv) in
+        File.Fmt.stderr |> Fmt.fmt "hocc: " |> Fmt.fmt arg |> Fmt.fmt " argument missing\n"
+        |> ignore;
+        usage true
+      end
+    | true -> Array.get i' argv
+  end in
+  let rec f t argv i = begin
+    match i < Array.length argv with
+    | false -> t
+    | true -> begin
+        let arg_bytes = Array.get i argv in
+        let arg_string = Bytes.to_string_replace arg_bytes in
+        match arg_string with
+        | "-help" | "-h" -> usage false
+        | "-verbose" | "-v" -> f {t with verbose=true} argv (succ i)
+        | "-report" | "-r" -> f {t with report=true} argv (succ i)
+        | "-graph" | "-g" -> f {t with graph=true} argv (succ i)
+        | "-canonical" | "-c" -> f {t with algorithm=LR1Canonical} argv (succ i)
+        | "-ocaml" -> f {t with language=OCaml} argv (succ i)
+        | "-src" | "-s" -> begin
+            let path = Path.of_bytes (Bytes.Slice.init (arg_arg argv i)) in
+            let dirname, basename_opt = Path.split path in
+            let srcdir_opt = match Path.is_empty dirname with
+              | true -> None
+              | false -> Some dirname
+            in
+            let module_opt = match basename_opt with
+              | None -> begin
+                  File.Fmt.stderr
+                  |> Fmt.fmt "hocc: Invalid source: "
+                  |> Path.pp path
+                  |> Fmt.fmt "\n"
+                  |> ignore;
+                  usage true
+                end
+              | Some m -> Some m
+            in
+            f {t with srcdir_opt; module_opt} argv (i + 2L)
+          end
+        | "-dstdir" | "-d" -> begin
+            let dstdir = Path.of_bytes (Bytes.Slice.init (arg_arg argv i)) in
+            f {t with dstdir_opt=Some dstdir} argv (i + 2L)
+          end
+        | _ -> begin
+            File.Fmt.stderr
+            |> Fmt.fmt "hocc: Invalid command line parameter: "
+            |> String.pp arg_string
+            |> Fmt.fmt "\n"
+            |> ignore;
+            usage true
+          end
+      end
+  end in
+  let t = f default argv 1L in
+  (* XXX Verify that module name is cident. *)
+  match t.module_opt with
+  | None -> begin
+      File.Fmt.stderr |> Fmt.fmt "hocc: Source not specified\n" |> ignore;
+      usage true
+    end
+  | Some _ -> t
+
+let verbose {verbose; _} =
+  verbose
+
+let report {report; _} =
+  report
+
+let graph {graph; _} =
+  graph
+
+let algorithm {algorithm; _} =
+  algorithm
+
+let language {language; _} =
+  language
+
+let srcdir {srcdir_opt; _} =
+  match srcdir_opt with
+  | None -> Path.of_string "."
+  | Some srcdir -> srcdir
+
+let module_ {module_opt; _} =
+  match module_opt with
+  | None -> not_reached ()
+  | Some m -> m
+
+let dstdir {dstdir_opt; _} =
+  match dstdir_opt with
+  | None -> Path.of_string "."
+  | Some dstdir -> dstdir

bootstrap/bin/hocc/conf.mli

@@ -0,0 +1,28 @@
+open Basis
+
+type algorithm =
+  | LR1Compact
+  | LR1Canonical
+
+val pp_algorithm: algorithm -> (module Fmt.Formatter) -> (module Fmt.Formatter)
+
+type language =
+  | Hemlock
+  | OCaml
+
+val pp_language : language -> (module Fmt.Formatter) -> (module Fmt.Formatter)
+
+type t
+
+include FormattableIntf.SMono with type t := t
+
+val of_argv: Bytes.t array -> t
+
+val verbose: t -> bool
+val report: t -> bool
+val graph: t -> bool
+val algorithm: t -> algorithm
+val language: t -> language
+val srcdir: t -> Path.t
+val module_: t -> Path.Segment.t
+val dstdir: t -> Path.t

bootstrap/bin/hocc/dune

@@ -0,0 +1,7 @@
+(executables
+ (names hocc)
+ (libraries Basis Hmc))
+
+(install
+ (section bin)
+  (files (hocc.exe as hocc)))

bootstrap/bin/hocc/hocc.ml

@@ -0,0 +1,49 @@
+open Basis
+include Basis.Rudiments
+open Hmc
+
+let scan_file path =
+  let rec fn scanner = begin
+    let scanner', ctok = Scan.next scanner in
+    let atok = Scan.ConcreteToken.atok ctok in
+    let source = Scan.ConcreteToken.source ctok in
+    File.Fmt.stdout
+    |> Fmt.fmt "  "
+    |> Source.Slice.pp source
+    |> Fmt.fmt " : "
+    |> Scan.AbstractToken.pp atok
+    |> Fmt.fmt "\n"
+    |> ignore;
+    match atok with
+    | Scan.AbstractToken.Tok_end_of_input -> ()
+    | _ -> fn scanner'
+  end in
+  let () = match File.of_path path with
+    | Ok f -> begin
+        let stream = File.Stream.of_file f in
+        let text = Text.of_bytes_stream ~path stream in
+        let scanner = Scan.init text in
+        fn scanner
+      end
+    | Error err -> halt (
+      String.Fmt.empty
+      |> Fmt.fmt "File.of_path error: "
+      |> Fmt.fmt (File.Error.to_string err)
+      |> Fmt.fmt "\n"
+      |> Fmt.to_string
+    )
+  in
+  ()
+
+let _ =
+  let conf = Conf.of_argv Os.argv in
+  File.Fmt.stdout |> Fmt.fmt "XXX hocc: conf=" |> Conf.pp conf |> Fmt.fmt "\n" |> ignore;
+  let path = Path.join [
+    (Conf.srcdir conf);
+    Path.of_string "/";
+    Path.of_segment (Path.Segment.join [
+      (Conf.module_ conf);
+      Option.value_hlt Path.(basename (of_string ".hmh"))
+    ]);
+  ] in
+  scan_file path

bootstrap/src/basis/entropy.ml

@@ -11,6 +11,6 @@ let get () =
   | _ -> halt "Entropy.get error: Entropy acquisition failure"
 
 let seed =
-  match Sys.getenv_opt "HEMLOCK_ENTROPY" with
+  match Stdlib.Sys.getenv_opt "HEMLOCK_ENTROPY" with
   | None -> get ()
   | Some hemlock_entropy -> u128_of_string hemlock_entropy

bootstrap/src/basis/os.ml

@@ -0,0 +1,2 @@
+let argv = Array.map Stdlib.Sys.argv ~f:(fun arg ->
+  Bytes.of_string_slice (String.C.Slice.of_string arg))

bootstrap/src/basis/os.mli

@@ -0,0 +1,5 @@
+(** Operating system interfaces. *)
+
+val argv: Bytes.t array
+(** [argv] comprises the command line arguments, where the first element is the path to the program
+    being executed. *)

bootstrap/test/basis/seed/test_seed0.ml

@@ -3,7 +3,7 @@ open Basis
 let () =
   File.Fmt.stdout
   |> Fmt.fmt "HEMLOCK_ENTROPY="
-  |> String.pp (Sys.getenv "HEMLOCK_ENTROPY")
+  |> String.pp (Stdlib.Sys.getenv "HEMLOCK_ENTROPY")
   |> Fmt.fmt " -> seed="
   |> Hash.State.pp Hash.State.seed
   |> Fmt.fmt "\n"

bootstrap/test/basis/seed/test_seed42.ml

@@ -3,7 +3,7 @@ open Basis
 let () =
   File.Fmt.stdout
   |> Fmt.fmt "HEMLOCK_ENTROPY="
-  |> String.pp (Sys.getenv "HEMLOCK_ENTROPY")
+  |> String.pp (Stdlib.Sys.getenv "HEMLOCK_ENTROPY")
   |> Fmt.fmt " -> seed="
   |> Hash.State.pp Hash.State.seed
   |> Fmt.fmt "\n"

doc/design/index.md

@@ -1,4 +1,4 @@
-# Hemlock
+# Hemlock Design
 
 [Hemlock](https://github.com/BranchTaken/Hemlock) is a systems programming language, but not all
 systems are alike. Hemlock is intentionally constrained to excel for a (large) subset of possible

doc/index.md

@@ -0,0 +1,5 @@
+# Hemlock Documentation
+
+- [Design](design/index.md)
+- Tools
+  + [`hocc`](tools/hocc.md)