Push some fixes suggested by @altgr

compiler/catala_utils/pos.mli

@@ -47,7 +47,11 @@ val to_string : t -> string
 val to_string_short : t -> string
 (** Formats a position like this:
 
-    {v <file>;<start_line>:<start_col>--<end_line>:<end_col> v} *)
+    {v <file>;<start_line>:<start_col>--<end_line>:<end_col> v}
+
+    This function is compliant with the
+    {{:https://www.gnu.org/prep/standards/standards.html#Errors} GNU coding
+    standards}. *)
 
 val retrieve_loc_text : t -> string
 (** Open the file corresponding to the position and retrieves the text concerned

compiler/desugared/ast.ml

@@ -119,28 +119,46 @@ module Rule = struct
   let compare r1 r2 =
     match r1.rule_parameter, r2.rule_parameter with
     | None, None -> (
-      let j1 = Expr.unbox r1.rule_just in
-      let j2 = Expr.unbox r2.rule_just in
-      match Expr.compare j1 j2 with
+      let j1, j1m = r1.rule_just in
+      let j2, j2m = r2.rule_just in
+      match
+        Bindlib.unbox
+          (Bindlib.box_apply2
+             (fun j1 j2 -> Expr.compare (j1, j1m) (j2, j2m))
+             j1 j2)
+      with
       | 0 ->
-        let c1 = Expr.unbox r1.rule_cons in
-        let c2 = Expr.unbox r2.rule_cons in
-        Expr.compare c1 c2
+        let c1, c1m = r1.rule_cons in
+        let c2, c2m = r2.rule_cons in
+        Bindlib.unbox
+          (Bindlib.box_apply2
+             (fun c1 c2 -> Expr.compare (c1, c1m) (c2, c2m))
+             c1 c2)
       | n -> n)
     | Some (l1, _), Some (l2, _) ->
       ListLabels.compare l1 l2 ~cmp:(fun ((v1, _), t1) ((v2, _), t2) ->
           match Type.compare t1 t2 with
           | 0 -> (
             let open Bindlib in
-            let b1 = unbox (bind_var v1 (Expr.Box.lift r1.rule_just)) in
-            let b2 = unbox (bind_var v2 (Expr.Box.lift r2.rule_just)) in
-            let _, j1, j2 = unbind2 b1 b2 in
-            match Expr.compare j1 j2 with
+            let b1 = bind_var v1 (Expr.Box.lift r1.rule_just) in
+            let b2 = bind_var v2 (Expr.Box.lift r2.rule_just) in
+            match
+              Bindlib.unbox
+                (Bindlib.box_apply2
+                   (fun b1 b2 ->
+                     let _, j1, j2 = unbind2 b1 b2 in
+                     Expr.compare j1 j2)
+                   b1 b2)
+            with
             | 0 ->
-              let b1 = unbox (bind_var v1 (Expr.Box.lift r1.rule_cons)) in
-              let b2 = unbox (bind_var v2 (Expr.Box.lift r2.rule_cons)) in
-              let _, c1, c2 = unbind2 b1 b2 in
-              Expr.compare c1 c2
+              let b1 = bind_var v1 (Expr.Box.lift r1.rule_cons) in
+              let b2 = bind_var v2 (Expr.Box.lift r2.rule_cons) in
+              Bindlib.unbox
+                (Bindlib.box_apply2
+                   (fun b1 b2 ->
+                     let _, c1, c2 = unbind2 b1 b2 in
+                     Expr.compare c1 c2)
+                   b1 b2)
             | n -> n)
           | n -> n)
     | None, Some _ -> -1

compiler/desugared/dependency.ml

@@ -66,7 +66,7 @@ module Vertex = struct
       ScopeVar.equal x y && Option.equal StateName.equal sx sy
     | SubScope x, SubScope y -> SubScopeName.equal x y
     | Assertion a, Assertion b -> Ast.AssertionName.equal a b
-    | _, _ -> false
+    | (Var _ | SubScope _ | Assertion _), _ -> false
 
   let format_t (fmt : Format.formatter) (x : t) : unit =
     match x with

compiler/driver.ml

@@ -567,13 +567,11 @@ let driver source_file (options : Cli.options) : int =
                     prgm type_ordering)))))));
     0
   with
-  | Errors.StructuredError (msg, pos) -> (
+  | Errors.StructuredError (msg, pos) ->
     let bt = Printexc.get_raw_backtrace () in
     Cli.error_print "%s" (Errors.print_structured_error msg pos);
     if Printexc.backtrace_status () then Printexc.print_raw_backtrace stderr bt;
-    match options.message_format with
-    | Human -> -1
-    | EditorParsable -> 0 (* editors don't suffer a non-zero return code *))
+    -1
   | Sys_error msg ->
     let bt = Printexc.get_raw_backtrace () in
     Cli.error_print "System error: %s" msg;

compiler/shared_ast/print.ml

@@ -460,7 +460,9 @@ let rec expr_aux :
       Cli.format_with_style [List.hd colors] fmt ")")
     else expr colors fmt e1
   in
-  let default_punct color fmt s = Cli.format_with_style [color] fmt s in
+  let default_punct color fmt s =
+    Format.pp_print_as fmt 1 (Cli.with_style [color] "%s" s)
+  in
   let lhs ?(colors = colors) ex = paren ~colors ~rhs:false ex in
   let rhs ex = paren ~rhs:true ex in
   match Marked.unmark e with