Merge pull request #785 from herd/pre-commit-ocamlformat

This PR introduces:

1. A fix to asldoc to allow 80pt width code quotes
2. A run of ocamlformat, and its config to run only on `asllib`
3. A run of dune fmt
4. A pre-commit hook to check that ocaml format is well run
5. A CI tool to check that `dune fmt` is well run

.github/workflows/check-format.yml

@@ -0,0 +1,28 @@
+name: Check format with `dune fmt`
+
+on:
+  pull_request:
+  # push:
+  workflow_dispatch:
+  schedule:
+    # Prime the caches every Monday
+    - cron: 0 1 * * MON
+
+permissions: read-all
+
+jobs:
+  build:
+    runs-on: ubuntu-latest
+
+    steps:
+      - name: Checkout tree
+        uses: actions/checkout@v4
+
+      - name: Set-up OCaml
+        uses: ocaml/setup-ocaml@v2
+        with:
+          ocaml-compiler: 5.1
+
+      - run: opam install dune ocamlformat
+
+      - run: opam exec -- dune fmt

.ocamlformat

@@ -0,0 +1,2 @@
+version = 0.26.1
+disable = true

.pre-commit-config.yaml

@@ -44,6 +44,11 @@ repos:
             # Expected files should be left verbatim.
             \.expected(-failure)?$
           )
+- repo: https://github.com/arenadotio/pre-commit-ocamlformat
+  rev: 0439858f79b3bcb49e757278eb1312e212d7dd4f
+  hooks:
+  -     id: ocamlformat
+        types: [ocaml]
 
 -   repo: local
     hooks:

asllib/.ocamlformat

@@ -0,0 +1 @@
+disable = false

asllib/Interpreter.ml

@@ -199,11 +199,11 @@ module Make (B : Backend.S) (C : Config) = struct
                 | None, Some t -> base_value env t
               in
               let* () =
-(*
- * Those identifiers are initialised to their current value
- * before executing each instruction. Hence, we discard
- * the initial values from `.asl` files.
- *)
+                (*
+                 * Those identifiers are initialised to their current value
+                 * before executing each instruction. Hence, we discard
+                 * the initial values from `.asl` files.
+                 *)
                 match name with
                 | "RESADDR" | "_NZCV" -> return ()
                 | _ -> B.on_write_identifier name Scope_Global v
@@ -213,8 +213,7 @@ module Make (B : Backend.S) (C : Config) = struct
     in
     let fold = function
       | TopoSort.ASTFold.Single d -> process_one_decl d
-      | TopoSort.ASTFold.Recursive ds ->
-          List.fold_right process_one_decl ds
+      | TopoSort.ASTFold.Recursive ds -> List.fold_right process_one_decl ds
     in
     fun ast -> TopoSort.ASTFold.fold fold ast
 
@@ -846,8 +845,7 @@ module Make (B : Backend.S) (C : Config) = struct
         List.fold_left2 folder (return_normal env) ldis liv
         |: SemanticsRule.LDTuple
     (* End *)
-    | LDI_Var _, None
-    | LDI_Tuple _, None ->
+    | LDI_Var _, None | LDI_Tuple _, None ->
         (* Should not happen in V1 because of TypingRule.LDUninitialisedTuple *)
         fatal_from s Error.TypeInferenceNeeded
 
@@ -996,17 +994,14 @@ module Make (B : Backend.S) (C : Config) = struct
         let () =
           if debug then
             let open Format in
-            let pp_value fmt v =
-              B.debug_value v |> pp_print_string fmt
-            in
+            let pp_value fmt v = B.debug_value v |> pp_print_string fmt in
             eprintf "@[@<2>%a:@ @[%a@]@ ->@ %a@]@." PP.pp_pos s
               (pp_print_list ~pp_sep:pp_print_space PP.pp_expr)
               args
               (pp_print_list ~pp_sep:pp_print_space pp_value)
               vs
           else (
-            List.map B.debug_value vs
-            |> String.concat " " |> print_string;
+            List.map B.debug_value vs |> String.concat " " |> print_string;
             print_newline ())
         in
         return_continue env |: SemanticsRule.SDebug