Assets and formatting

compiler/dcalc/ast.ml

@@ -40,13 +40,12 @@ type enum_name = EnumName.t
 
 type typ =
   | TLit of typ_lit
-  | TTuple of typ Pos.marked list * (struct_name) option
+  | TTuple of typ Pos.marked list * struct_name option
-  | TEnum of typ Pos.marked list * (enum_name)
+  | TEnum of typ Pos.marked list * enum_name
   | TArrow of typ Pos.marked * typ Pos.marked
   | TArray of typ Pos.marked
   | TAny
 
-
 type date = Runtime.date
 
 type duration = Runtime.duration
@@ -94,25 +93,24 @@ type log_entry = VarDef of typ | BeginCall | EndCall | PosRecordIfTrueBool
 type unop =
   | Not
   | Minus of op_kind
-  | Log of log_entry * (Utils.Uid.MarkedString.info list)
+  | Log of log_entry * Utils.Uid.MarkedString.info list
   | Length
   | IntToRat
   | GetDay
   | GetMonth
   | GetYear
 
-
 type operator = Ternop of ternop | Binop of binop | Unop of unop
 
 type expr =
-  | EVar of (expr Bindlib.var) Pos.marked
+  | EVar of expr Bindlib.var Pos.marked
-  | ETuple of expr Pos.marked list * (struct_name) option
+  | ETuple of expr Pos.marked list * struct_name option
-  | ETupleAccess of expr Pos.marked * int * (struct_name) option * typ Pos.marked list
+  | ETupleAccess of expr Pos.marked * int * struct_name option * typ Pos.marked list
-  | EInj of expr Pos.marked * int * (enum_name) * typ Pos.marked list
+  | EInj of expr Pos.marked * int * enum_name * typ Pos.marked list
-  | EMatch of expr Pos.marked * expr Pos.marked list * (enum_name)
+  | EMatch of expr Pos.marked * expr Pos.marked list * enum_name
   | EArray of expr Pos.marked list
-  | ELit of (lit)
+  | ELit of lit
-  | EAbs of ((expr, expr Pos.marked) Bindlib.mbinder) Pos.marked * typ Pos.marked list
+  | EAbs of (expr, expr Pos.marked) Bindlib.mbinder Pos.marked * typ Pos.marked list
   | EApp of expr Pos.marked * expr Pos.marked list
   | EAssert of expr Pos.marked
   | EOp of operator
@@ -120,7 +118,6 @@ type expr =
   | EIfThenElse of expr Pos.marked * expr Pos.marked * expr Pos.marked
   | ErrorOnEmpty of expr Pos.marked
 
-
 type struct_ctx = (StructFieldName.t * typ Pos.marked) list StructMap.t
 
 type enum_ctx = (EnumConstructor.t * typ Pos.marked) list EnumMap.t

compiler/dcalc/ast.mli

@@ -42,7 +42,6 @@ type typ =
   | TArray of typ Pos.marked
   | TAny
 
-
 type date = Runtime.date
 
 type duration = Runtime.duration
@@ -126,7 +125,6 @@ type expr =
   | EIfThenElse of expr Pos.marked * expr Pos.marked * expr Pos.marked
   | ErrorOnEmpty of expr Pos.marked
 
-
 type struct_ctx = (StructFieldName.t * typ Pos.marked) list StructMap.t
 
 type enum_ctx = (EnumConstructor.t * typ Pos.marked) list EnumMap.t

compiler/lcalc/ast.ml

@@ -38,8 +38,7 @@ type expr =
       (** The [MarkedString.info] is the former enum case name *)
   | EArray of expr Pos.marked list
   | ELit of lit
-  | EAbs of
+  | EAbs of (expr, expr Pos.marked) Bindlib.mbinder Pos.marked * D.typ Pos.marked list
-      (expr, expr Pos.marked) Bindlib.mbinder Pos.marked * D.typ Pos.marked list
   | EApp of expr Pos.marked * expr Pos.marked list
   | EAssert of expr Pos.marked
   | EOp of D.operator
@@ -47,7 +46,6 @@ type expr =
   | ERaise of except
   | ECatch of expr Pos.marked * except * expr Pos.marked
 
-
 module Var = struct
   type t = expr Bindlib.var
 
@@ -110,8 +108,9 @@ let make_some' (e : expr Pos.marked) : expr = EInj (e, 1, option_enum, [])
 (** [make_matchopt_with_abs_arms arg e_none e_some] build an expression
     [match arg with |None -> e_none | Some -> e_some] and requires e_some and e_none to be in the
     form [EAbs ...].*)
-let make_matchopt_with_abs_arms (arg : expr Pos.marked Bindlib.box) (e_none : expr Pos.marked Bindlib.box)
+let make_matchopt_with_abs_arms (arg : expr Pos.marked Bindlib.box)
-    (e_some : expr Pos.marked Bindlib.box) : expr Pos.marked Bindlib.box =
+    (e_none : expr Pos.marked Bindlib.box) (e_some : expr Pos.marked Bindlib.box) :
+    expr Pos.marked Bindlib.box =
   let pos = Pos.get_position @@ Bindlib.unbox arg in
   let mark : 'a -> 'a Pos.marked = Pos.mark pos in
 

compiler/lcalc/ast.mli

@@ -45,8 +45,7 @@ type expr =
       (** The [MarkedString.info] is the former enum case name *)
   | EArray of expr Pos.marked list
   | ELit of lit
-  | EAbs of
+  | EAbs of (expr, expr Pos.marked) Bindlib.mbinder Pos.marked * Dcalc.Ast.typ Pos.marked list
-      (expr, expr Pos.marked) Bindlib.mbinder Pos.marked * Dcalc.Ast.typ Pos.marked list
   | EApp of expr Pos.marked * expr Pos.marked list
   | EAssert of expr Pos.marked
   | EOp of Dcalc.Ast.operator
@@ -122,8 +121,8 @@ val make_matchopt :
 (** [e' = make_matchopt'' pos v e e_none e_some] Builds the term corresponding to
     [match e with | None -> fun () -> e_none |Some -> fun v -> e_some]. *)
 
-
 val handle_default : Var.t
+
 val handle_default_opt : Var.t
 
 type binder = (expr, expr Pos.marked) Bindlib.binder

compiler/lcalc/compile_without_exceptions.ml

@@ -27,7 +27,8 @@ type cuts = D.expr Pos.marked A.VarMap.t
 
 type info = { expr : A.expr Pos.marked Bindlib.box; var : A.expr Bindlib.var; is_pure : bool }
 (** information about the Dcalc variable : what is the corresponding LCalc variable; an expression
-    build correctly using Bindlib, and a boolean `is_pure` indicating whenever the variable can be an EmptyError and hence should be matched (false) or if it never can be EmptyError (true). *)
+    build correctly using Bindlib, and a boolean `is_pure` indicating whenever the variable can be
+    an EmptyError and hence should be matched (false) or if it never can be EmptyError (true). *)
 
 type ctx = info D.VarMap.t
 (** information context about variables in the current scope *)
@@ -45,10 +46,10 @@ let pp_ctx (fmt : Format.formatter) (ctx : ctx) =
   Format.fprintf fmt "@[<2>[%a]@]" pp_bindings (D.VarMap.bindings ctx)
 
 (** [find ~info n ctx] is a warpper to ocaml's Map.find that handle errors in a slightly better way. *)
-let find ?(info: string = "none") (n: D.Var.t) (ctx: ctx) : info =
+let find ?(info : string = "none") (n : D.Var.t) (ctx : ctx) : info =
   let _ =
-    Format.asprintf "Searching for variable %a inside context %a"
+    Format.asprintf "Searching for variable %a inside context %a" Dcalc.Print.format_var n pp_ctx
-      Dcalc.Print.format_var n pp_ctx ctx
+      ctx
     |> Cli.debug_print
   in
   try D.VarMap.find n ctx
@@ -60,13 +61,12 @@ let find ?(info: string = "none") (n: D.Var.t) (ctx: ctx) : info =
          Dcalc.Print.format_var n info)
       Pos.no_pos
 
-let add_var (pos: Pos.t) (var: D.Var.t) (is_pure: bool) (ctx: ctx) : ctx =
+let add_var (pos : Pos.t) (var : D.Var.t) (is_pure : bool) (ctx : ctx) : ctx =
   let new_var = A.Var.make (Bindlib.name_of var, pos) in
   let expr = A.make_var (new_var, pos) in
 
-  Cli.debug_print @@ Format.asprintf "D.%a |-> A.%a"
+  Cli.debug_print
-    Dcalc.Print.format_var var
+  @@ Format.asprintf "D.%a |-> A.%a" Dcalc.Print.format_var var Print.format_var new_var;
-    Print.format_var new_var;
 
   D.VarMap.update var (fun _ -> Some { expr; var = new_var; is_pure }) ctx
 
@@ -104,15 +104,18 @@ let rec translate_and_cut (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marke
     =
   let pos = Pos.get_position e in
   match Pos.unmark e with
-  (* empty-producing/using terms. We cut those. (D.EVar in some cases, EApp(D.EVar _, [ELit LUnit]), EDefault _, ELit LEmptyDefault) I'm unsure about assert. *)
+  (* empty-producing/using terms. We cut those. (D.EVar in some cases, EApp(D.EVar _, [ELit LUnit]),
+     EDefault _, ELit LEmptyDefault) I'm unsure about assert. *)
   | D.EVar v ->
-      (* todo: for now, every unpure (such that [is_pure] is [false] in the current context) is thunked, hence matched in the next case. This assumption can change in the future, and this case is here for this reason. *)
+      (* todo: for now, every unpure (such that [is_pure] is [false] in the current context) is
+         thunked, hence matched in the next case. This assumption can change in the future, and this
+         case is here for this reason. *)
       let v, pos_v = v in
       if not (find ~info:"search for a variable" v ctx).is_pure then begin
         let v' = A.Var.make (Bindlib.name_of v, pos_v) in
         Cli.debug_print
-        @@ Format.asprintf "Found an unpure variable %a, created a variable %a to replace it" Dcalc.Print.format_var
+        @@ Format.asprintf "Found an unpure variable %a, created a variable %a to replace it"
-             v Print.format_var v';
+             Dcalc.Print.format_var v Print.format_var v';
         (A.make_var (v', pos), A.VarMap.singleton v' e)
       end
       else ((find ~info:"should never happend" v ctx).expr, A.VarMap.empty)
@@ -120,8 +123,8 @@ let rec translate_and_cut (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marke
       if not (find ~info:"search for a variable" v ctx).is_pure then begin
         let v' = A.Var.make (Bindlib.name_of v, pos_v) in
         Cli.debug_print
-        @@ Format.asprintf "Found an unpure variable %a, created a variable %a to replace it" Dcalc.Print.format_var
+        @@ Format.asprintf "Found an unpure variable %a, created a variable %a to replace it"
-             v Print.format_var v';
+             Dcalc.Print.format_var v Print.format_var v';
         (A.make_var (v', pos), A.VarMap.singleton v' (D.EVar (v, pos_v), p))
       end
       else
@@ -134,16 +137,14 @@ let rec translate_and_cut (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marke
       let v' = A.Var.make ("empty_litteral", pos) in
       (A.make_var (v', pos), A.VarMap.singleton v' e)
   | D.EAssert _ ->
-      (* as discuted, if the value in an assertion is empty, an error should the raised. This beavior is different from the ICFP paper. *)
+      (* as discuted, if the value in an assertion is empty, an error should the raised. This
+         beavior is different from the ICFP paper. *)
       let v' = A.Var.make ("assertion_value", pos) in
       (A.make_var (v', pos), A.VarMap.singleton v' e)
-  (* This one is a very special case. It transform an unpure expression environement to a pure expression. *)
+  (* This one is a very special case. It transform an unpure expression environement to a pure
+     expression. *)
   | ErrorOnEmpty arg ->
-      (* [
+      (* [ match arg with | None -> raise NoValueProvided | Some v -> {{ v }} ] *)
-           match arg with
-           | None -> raise NoValueProvided
-           | Some v -> {{ v }}
-         ] *)
       let silent_var = A.Var.make ("_", pos) in
       let x = A.Var.make ("non_empty_argument", pos) in
 
@@ -166,27 +167,26 @@ let rec translate_and_cut (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marke
         Bindlib.box_apply3 (fun e1' e2' e3' -> (A.EIfThenElse (e1', e2', e3'), pos)) e1' e2' e3'
       in
 
-      (*(* equivalent code : *)
+      (*(* equivalent code : *) let e' = let+ e1' = e1' and+ e2' = e2' and+ e3' = e3' in
-        let e' =
+        (A.EIfThenElse (e1', e2', e3'), pos) in *)
-          let+ e1' = e1' and+ e2' = e2' and+ e3' = e3' in
-          (A.EIfThenElse (e1', e2', e3'), pos)
-        in
-      *)
       (e', disjoint_union_maps pos [ c1; c2; c3 ])
   | D.EAbs ((binder, pos_binder), ts) ->
       let vars, body = Bindlib.unmbind binder in
       let ctx, lc_vars =
         ArrayLabels.fold_right vars ~init:(ctx, []) ~f:(fun var (ctx, lc_vars) ->
-            (* we suppose the invariant that when applying a function, its arguments cannot be of the type "option".
+            (* we suppose the invariant that when applying a function, its arguments cannot be of
+               the type "option".
 
-               The code should behave correctly in the without this assumption if we put here an is_pure=false, but the types are more compilcated. (unimplemented for now) *)
+               The code should behave correctly in the without this assumption if we put here an
+               is_pure=false, but the types are more compilcated. (unimplemented for now) *)
             let ctx = add_var pos var true ctx in
             let lc_var = (find var ctx).var in
             (ctx, lc_var :: lc_vars))
       in
       let lc_vars = Array.of_list lc_vars in
 
-      (* here we take the guess that if we cannot build the closure because one of the variable is empty, then we cannot build the function. *)
+      (* here we take the guess that if we cannot build the closure because one of the variable is
+         empty, then we cannot build the function. *)
       let new_body, cuts = translate_and_cut ctx body in
       let new_binder = Bindlib.bind_mvar lc_vars new_body in
 
@@ -244,7 +244,9 @@ and translate_expr ?(append_esome = true) (ctx : ctx) (e : D.expr Pos.marked) :
 
   (* build the cuts *)
   Cli.debug_print
-  @@ Format.asprintf "cut for the expression: [%a]" (Format.pp_print_list Print.format_var) (List.map fst cs);
+  @@ Format.asprintf "cut for the expression: [%a]"
+       (Format.pp_print_list Print.format_var)
+       (List.map fst cs);
 
   ListLabels.fold_left cs
     ~init:(if append_esome then A.make_some e' else e')
@@ -253,7 +255,8 @@ and translate_expr ?(append_esome = true) (ctx : ctx) (e : D.expr Pos.marked) :
 
       let c' : A.expr Pos.marked Bindlib.box =
         match c with
-        (* Here we have to handle only the cases appearing in cuts, as defined the [translate_and_cut] function. *)
+        (* Here we have to handle only the cases appearing in cuts, as defined the
+           [translate_and_cut] function. *)
         | D.EVar v -> (find ~info:"should never happend" (Pos.unmark v) ctx).expr
         | D.EDefault (excep, just, cons) ->
             let excep' = List.map (translate_expr ctx) excep in
@@ -272,11 +275,7 @@ and translate_expr ?(append_esome = true) (ctx : ctx) (e : D.expr Pos.marked) :
         | D.EAssert arg ->
             let arg' = translate_expr ctx arg in
 
-            (* [
+            (* [ match arg with | None -> raise NoValueProvided | Some v -> assert {{ v }} ] *)
-                 match arg with
-                 | None -> raise NoValueProvided
-                 | Some v -> assert {{ v }}
-               ] *)
             let silent_var = A.Var.make ("_", pos_c) in
             let x = A.Var.make ("assertion_argument", pos_c) in
 
@@ -292,12 +291,7 @@ and translate_expr ?(append_esome = true) (ctx : ctx) (e : D.expr Pos.marked) :
               "Internal Error: An term was found in a position where it should not be" pos_c
       in
 
-      (* [
+      (* [ match {{ c' }} with | None -> None | Some {{ v }} -> {{ acc }} end ] *)
-           match {{ c' }} with
-           | None -> None
-           | Some {{ v }} -> {{ acc }}
-           end
-         ] *)
       Cli.debug_print @@ Format.asprintf "build matchopt using %a" Print.format_var v;
       A.make_matchopt pos_c v (D.TAny, pos_c) c' (A.make_none pos_c) acc)
 
@@ -337,14 +331,16 @@ let translate_and_bind_lets (acc : scope_lets Bindlib.box) (scope_let : D.scope_
   let pos = snd scope_let.D.scope_let_var in
 
   Cli.debug_print
-  @@ Format.asprintf "binding let %a. Variable occurs = %b" Dcalc.Print.format_var (fst scope_let.D.scope_let_var)
+  @@ Format.asprintf "binding let %a. Variable occurs = %b" Dcalc.Print.format_var
+       (fst scope_let.D.scope_let_var)
        (Bindlib.occur (fst scope_let.D.scope_let_var) acc);
 
   let binder = Bindlib.bind_var (fst scope_let.D.scope_let_var) acc in
   Bindlib.box_apply2
     (fun expr binder ->
       Cli.debug_print
-      @@ Format.asprintf "free variables in expression: %a" (Format.pp_print_list Dcalc.Print.format_var)
+      @@ Format.asprintf "free variables in expression: %a"
+           (Format.pp_print_list Dcalc.Print.format_var)
            (D.free_vars expr);
       ScopeLet
         {
@@ -435,7 +431,8 @@ let translate_program (prgm : D.program) : A.program =
            let scope_body = Bindlib.unbox (translate_and_bind scope_body) in
 
            Cli.debug_print
-           @@ Format.asprintf "global free variable : %a" (Format.pp_print_list Dcalc.Print.format_var)
+           @@ Format.asprintf "global free variable : %a"
+                (Format.pp_print_list Dcalc.Print.format_var)
                 (free_vars_scope_body scope_body);
            let new_ctx = add_var Pos.no_pos n true ctx in
 

compiler/lcalc/compile_without_exceptions.mli

@@ -1,6 +1,6 @@
 (* This file is part of the Catala compiler, a specification language for tax and social benefits
    computation rules. Copyright (C) 2020 Inria, contributor: Alain Delaët-Tixeuil
-   <alain.delaet--tixeuil@inria.fr> 
+   <alain.delaet--tixeuil@inria.fr>
 
    Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except
    in compliance with the License. You may obtain a copy of the License at

compiler/lcalc/optimizations.ml

@@ -18,10 +18,8 @@ let ( let+ ) x f = Bindlib.box_apply f x
 
 let ( and+ ) x y = Bindlib.box_pair x y
 
-let visitor_map
+let visitor_map (t : 'a -> expr Pos.marked -> expr Pos.marked Bindlib.box) (ctx : 'a)
-  (t : 'a -> expr Pos.marked -> expr Pos.marked Bindlib.box)
+    (e : expr Pos.marked) : expr Pos.marked Bindlib.box =
-  (ctx : 'a)
-  (e : expr Pos.marked) : expr Pos.marked Bindlib.box =
   (* calls [t ctx] on every direct childs of [e], then rebuild an abstract syntax tree modified.
      Used in other transformations. *)
   let default_mark e' = Pos.same_pos_as e' e in
@@ -67,43 +65,39 @@ let rec iota_expr (_ : unit) (e : expr Pos.marked) : expr Pos.marked Bindlib.box
   let default_mark e' = Pos.mark (Pos.get_position e) e' in
   match Pos.unmark e with
   | EMatch ((EInj (e1, i, n', _ts), _), cases, n) when Dcalc.Ast.EnumName.compare n n' = 0 ->
-      let+ e1 = visitor_map iota_expr () e1 and+ case = visitor_map iota_expr () (List.nth cases i) in
+      let+ e1 = visitor_map iota_expr () e1
+      and+ case = visitor_map iota_expr () (List.nth cases i) in
       default_mark @@ EApp (case, [ e1 ])
-
+  | EMatch (e', cases, n)
-  | EMatch (e', cases, n) when begin
+    when begin
-      cases
+           cases
-      |> List.mapi (fun i (case, _pos) ->
+           |> List.mapi (fun i (case, _pos) ->
-        match case with
+                  match case with
-        | EInj (_ei, i', n', _ts') ->
+                  | EInj (_ei, i', n', _ts') ->
-          i = i' && (* n = n' *) (Dcalc.Ast.EnumName.compare n n' = 0)
+                      i = i' && (* n = n' *) Dcalc.Ast.EnumName.compare n n' = 0
-        | _ -> false
+                  | _ -> false)
-      )
+           |> List.for_all Fun.id
-      |> List.for_all Fun.id
+         end ->
-    end ->
+      visitor_map iota_expr () e'
-    visitor_map iota_expr () e'
-
   | _ -> visitor_map iota_expr () e
 
-
+let rec beta_expr (_ : unit) (e : expr Pos.marked) : expr Pos.marked Bindlib.box =
-let rec beta_expr (_: unit) (e: expr Pos.marked): expr Pos.marked Bindlib.box = 
   let default_mark e' = Pos.same_pos_as e' e in
   match Pos.unmark e with
-  | EApp (e1, args) ->
+  | EApp (e1, args) -> (
-    let+ e1 = visitor_map beta_expr () e1 
+      let+ e1 = visitor_map beta_expr () e1
-    and+ args = List.map (visitor_map beta_expr ()) args |> Bindlib.box_list in
+      and+ args = List.map (visitor_map beta_expr ()) args |> Bindlib.box_list in
-    begin match Pos.unmark e1 with
+      match Pos.unmark e1 with
-    | EAbs ((binder, _pos_binder), _ts) ->
+      | EAbs ((binder, _pos_binder), _ts) ->
-      let _ : (_, _) Bindlib.mbinder = binder in
+          let (_ : (_, _) Bindlib.mbinder) = binder in
-      Bindlib.msubst binder (List.map fst args |> Array.of_list) 
+          Bindlib.msubst binder (List.map fst args |> Array.of_list)
-    | _ ->
+      | _ -> default_mark @@ EApp (e1, args))
-      default_mark @@ EApp (e1, args)
-    end
   | _ -> visitor_map beta_expr () e
 
 let iota_optimizations (p : program) : program =
   { p with scopes = List.map (fun (var, e) -> (var, Bindlib.unbox (iota_expr () e))) p.scopes }
 
-let _beta_optimizations (p: program): program = 
+let _beta_optimizations (p : program) : program =
   { p with scopes = List.map (fun (var, e) -> (var, Bindlib.unbox (beta_expr () e))) p.scopes }
 
 let rec peephole_expr (_ : unit) (e : expr Pos.marked) : expr Pos.marked Bindlib.box =
@@ -123,7 +117,4 @@ let rec peephole_expr (_ : unit) (e : expr Pos.marked) : expr Pos.marked Bindlib
 let peephole_optimizations (p : program) : program =
   { p with scopes = List.map (fun (var, e) -> (var, Bindlib.unbox (peephole_expr () e))) p.scopes }
 
-let optimize_program (p : program) : program =
+let optimize_program (p : program) : program = p |> iota_optimizations |> peephole_optimizations
-  p
-  |> iota_optimizations
-  |> peephole_optimizations

compiler/lcalc/to_ocaml.ml

@@ -22,7 +22,8 @@ let find_struct s ctx =
   with Not_found ->
     let s_name, pos = D.StructName.get_info s in
     Errors.raise_spanned_error
-      (Format.asprintf "Internal Error: Structure %s was not found in the current environment." s_name)
+      (Format.asprintf "Internal Error: Structure %s was not found in the current environment."
+         s_name)
       pos
 
 let find_enum en ctx =

compiler/runtime.ml

@@ -215,7 +215,8 @@ let handle_default : 'a. (unit -> 'a) array -> (unit -> bool) -> (unit -> 'a) ->
   in
   match except with Some x -> x | None -> if just () then cons () else raise EmptyError
 
-let handle_default_opt (exceptions: 'a eoption array) (just: bool eoption) (cons: 'a eoption): 'a eoption =
+let handle_default_opt (exceptions : 'a eoption array) (just : bool eoption) (cons : 'a eoption) :
+    'a eoption =
   let except =
     Array.fold_left
       (fun acc except ->

compiler/utils/dune

@@ -2,7 +2,8 @@
  (name utils)
  (public_name catala.utils)
  (libraries cmdliner ANSITerminal re)
- (preprocess (pps ppx_deriving.show)))
+ (preprocess
+  (pps ppx_deriving.show)))
 
 (documentation
  (package catala)

compiler/utils/pos.ml

@@ -12,7 +12,7 @@
    or implied. See the License for the specific language governing permissions and limitations under
    the License. *)
 
-type t = { code_pos : Lexing.position * Lexing.position [@opaque]; law_pos : string list }
+type t = { code_pos : Lexing.position * Lexing.position; [@opaque] law_pos : string list }
 [@@deriving show]
 
 let from_lpos (p : Lexing.position * Lexing.position) : t = { code_pos = p; law_pos = [] }
@@ -168,8 +168,7 @@ let retrieve_loc_text (pos : t) : string =
              else Cli.print_with_style blue_style "%*s+-+ " (spaces + (2 * i) - 1) ""))
   with Sys_error _ -> "Location:" ^ to_string pos
 
-type 'a marked = 'a * t
+type 'a marked = 'a * t [@@deriving show]
-[@@deriving show]
 
 let no_pos : t =
   let zero_pos =

compiler/utils/pos.mli

@@ -14,8 +14,7 @@
 
 (** Source code position *)
 
-type t
+type t [@@deriving show]
-[@@deriving show]
 (** A position in the source code is a file, as well as begin and end location of the form col:line *)
 
 (** Custom visitor for the [Pos.marked] type *)
@@ -59,8 +58,7 @@ val retrieve_loc_text : t -> string
 
 (**{2 AST markings}*)
 
-type 'a marked = 'a * t
+type 'a marked = 'a * t [@@deriving show]
-[@@deriving show]
 (** Everything related to the source code should keep its position stored, to improve error messages *)
 
 val no_pos : t