Formatting + CI + etc

compiler/catala_web.ml

@@ -8,7 +8,7 @@ let _ =
            (language : Js.js_string Js.t) (trace : bool) =
          driver
            (Contents (Js.to_string contents))
-           false false false "Interpret"
+           false false false false "Interpret"
            (Some (Js.to_string language))
            None trace false
            (Some (Js.to_string scope))

compiler/lcalc/ast.ml

@@ -44,8 +44,7 @@ type expr =
   | EOp of D.operator
   | EIfThenElse of expr Pos.marked * expr Pos.marked * expr Pos.marked
   | ERaise of except
-  | ECatch of expr Pos.marked * except * expr Pos.marked 
-
+  | ECatch of expr Pos.marked * except * expr Pos.marked
 
 module Var = struct
   type t = expr Bindlib.var
@@ -75,73 +74,51 @@ let make_app (e : expr Pos.marked Bindlib.box) (u : expr Pos.marked Bindlib.box
 
 let make_let_in (x : Var.t) (tau : D.typ Pos.marked) (e1 : expr Pos.marked Bindlib.box)
     (e2 : expr Pos.marked Bindlib.box) : expr Pos.marked Bindlib.box =
-
   let pos = Pos.get_position (Bindlib.unbox e2) in
   make_app (make_abs (Array.of_list [ x ]) e2 pos [ tau ] pos) [ e1 ] pos
 
-
 let ( let+ ) x f = Bindlib.box_apply f x
 
 let ( and+ ) x y = Bindlib.box_pair x y
 
+let option_enum : D.EnumName.t = D.EnumName.fresh ("eoption", Pos.no_pos)
 
+let none_constr : D.EnumConstructor.t = D.EnumConstructor.fresh ("ENone", Pos.no_pos)
 
-let option_enum: D.EnumName.t = D.EnumName.fresh ("eoption", Pos.no_pos)
+let some_constr : D.EnumConstructor.t = D.EnumConstructor.fresh ("ESome", Pos.no_pos)
 
-let none_constr: D.EnumConstructor.t = D.EnumConstructor.fresh ("ENone", Pos.no_pos)
-let some_constr: D.EnumConstructor.t = D.EnumConstructor.fresh ("ESome", Pos.no_pos)
+let option_enum_config : (D.EnumConstructor.t * D.typ Pos.marked) list =
+  [ (none_constr, (D.TLit D.TUnit, Pos.no_pos)); (some_constr, (D.TAny, Pos.no_pos)) ]
 
-
-let option_enum_config: (D.EnumConstructor.t * D.typ Pos.marked) list =
-  [
-    none_constr, (D.TLit D.TUnit, Pos.no_pos);
-    some_constr, (D.TAny, Pos.no_pos);
-  ]
-
-let make_none (pos: Pos.t) =
+let make_none (pos : Pos.t) =
   (* Hack: type is not printed in to_ocaml, so I ignore it. *)
-
   let mark : 'a -> 'a Pos.marked = Pos.mark pos in
   Bindlib.box @@ mark @@ EInj (mark @@ ELit LUnit, 0, option_enum, [])
 
-let make_some (e: expr Pos.marked Bindlib.box): expr Pos.marked Bindlib.box =
-
+let make_some (e : expr Pos.marked Bindlib.box) : expr Pos.marked Bindlib.box =
   let pos = Pos.get_position @@ Bindlib.unbox e in
-  let mark: 'a -> 'a Pos.marked = Pos.mark pos in
+  let mark : 'a -> 'a Pos.marked = Pos.mark pos in
 
   let+ e = e in
   mark @@ EInj (e, 1, option_enum, [])
 
-let make_some' (e: expr Pos.marked): expr =
-
-    EInj (e, 1, option_enum, [])
-
-let make_matchopt
-  (e: 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 make_some' (e : expr Pos.marked) : expr = EInj (e, 1, option_enum, [])
 
+let make_matchopt (e : 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 e in
-  let mark: 'a -> 'a Pos.marked = Pos.mark pos in
+  let mark : 'a -> 'a Pos.marked = Pos.mark pos in
 
-  let+ e = e
-  and+ e_none = e_none
-  and+ e_some = e_some in
+  let+ e = e and+ e_none = e_none and+ e_some = e_some in
 
-  mark @@ EMatch (e, [e_none; e_some], option_enum)
+  mark @@ EMatch (e, [ e_none; e_some ], option_enum)
 
-
-
-let make_letopt_in
-  (x : Var.t)
-  (tau : D.typ Pos.marked)
-  (e1 : expr Pos.marked Bindlib.box)
-  (e2 : expr Pos.marked Bindlib.box) : expr Pos.marked Bindlib.box =
+let make_letopt_in (x : Var.t) (tau : D.typ Pos.marked) (e1 : expr Pos.marked Bindlib.box)
+    (e2 : expr Pos.marked Bindlib.box) : expr Pos.marked Bindlib.box =
   (* let%opt x: tau = e1 in e2 == matchopt e1 with | None -> None | Some x -> e2 *)
   let pos = Pos.get_position (Bindlib.unbox e2) in
 
-  make_matchopt
-    e1
+  make_matchopt e1
     (make_abs (Array.of_list [ x ]) (make_none pos) pos [ tau ] pos)
     (make_abs (Array.of_list [ x ]) e2 pos [ tau ] pos)
 

compiler/lcalc/ast.mli

@@ -97,24 +97,21 @@ val make_letopt_in :
   expr Pos.marked Bindlib.box ->
   expr Pos.marked Bindlib.box
 
+val option_enum : Dcalc.Ast.EnumName.t
 
-val option_enum: Dcalc.Ast.EnumName.t
-val none_constr: Dcalc.Ast.EnumConstructor.t
-val some_constr: Dcalc.Ast.EnumConstructor.t
-val option_enum_config: (Dcalc.Ast.EnumConstructor.t * Dcalc.Ast.typ Pos.marked) list
+val none_constr : Dcalc.Ast.EnumConstructor.t
 
-val make_none :
-  Pos.t -> expr Pos.marked Bindlib.box
+val some_constr : Dcalc.Ast.EnumConstructor.t
 
-val make_some :
-  expr Pos.marked Bindlib.box ->
-  expr Pos.marked Bindlib.box
+val option_enum_config : (Dcalc.Ast.EnumConstructor.t * Dcalc.Ast.typ Pos.marked) list
 
-val make_some' :
-  expr Pos.marked ->
-  expr
+val make_none : Pos.t -> expr Pos.marked Bindlib.box
 
-val make_matchopt:
+val make_some : expr Pos.marked Bindlib.box -> expr Pos.marked Bindlib.box
+
+val make_some' : expr Pos.marked -> expr
+
+val make_matchopt :
   expr Pos.marked Bindlib.box ->
   expr Pos.marked Bindlib.box ->
   expr Pos.marked Bindlib.box ->

compiler/lcalc/compile_without_exceptions.ml

@@ -19,7 +19,9 @@ module A = Ast
 type ctx = A.expr Pos.marked Bindlib.box D.VarMap.t
 
 let translate_lit (l : D.lit) : A.expr =
-  let build lit = fst @@ Bindlib.unbox @@ A.make_some (Bindlib.box (Pos.mark Pos.no_pos (A.ELit lit))) in
+  let build lit =
+    fst @@ Bindlib.unbox @@ A.make_some (Bindlib.box (Pos.mark Pos.no_pos (A.ELit lit)))
+  in
   match l with
   | D.LBool l -> build (A.LBool l)
   | D.LInt i -> build (A.LInt i)
@@ -131,19 +133,11 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl
 
       A.make_letopt_in x tau e1 e2
   | D.EArray es ->
+      let+ es = es |> List.map (translate_expr ctx) |> Bindlib.box_list in
 
-    let+ es = es
-      |> List.map (translate_expr ctx)
-      |> Bindlib.box_list
-    in
-
-    same_pos @@ A.make_some' (same_pos @@ A.EArray es)
-
-  | D.ELit l ->
-    Bindlib.box @@ same_pos @@ translate_lit l
-  | D.EOp op -> 
-
-    Bindlib.box @@ same_pos @@ A.make_some' (same_pos @@ A.EOp op)
+      same_pos @@ A.make_some' (same_pos @@ A.EArray es)
+  | D.ELit l -> Bindlib.box @@ same_pos @@ translate_lit l
+  | D.EOp op -> Bindlib.box @@ same_pos @@ A.make_some' (same_pos @@ A.EOp op)
   | D.EIfThenElse (e1, e2, e3) ->
       let e1 = translate_expr ctx e1 in
       let pos = Pos.get_position (Bindlib.unbox e1) in
@@ -173,7 +167,6 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl
                same_pos @@ A.EAssert (e1, pos) in
 
       A.make_letopt_in x tau e1 e2
-
   | D.ErrorOnEmpty arg ->
       let pos = Pos.get_position arg in
       let x = A.Var.make ("e1", pos) in
@@ -187,21 +180,17 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl
           (Bindlib.box @@ same_pos @@ A.EVar (x, pos))
           pos [ tau ] pos
       and e1 = arg
-      and e2 = 
+      and e2 =
         A.make_abs
           (Array.of_list [ x ])
           (Bindlib.box @@ same_pos @@ A.ERaise A.NoValueProvided)
           pos [ tau ] pos
-    in
-
-      A.make_matchopt
-        e1
-        e2
-        e3
+      in
 
+      A.make_matchopt e1 e2 e3
   | D.EApp ((D.EOp op, pos), args) ->
-    let+ args = Bindlib.box_list (List.map (translate_expr ctx) args) in
-    same_pos @@ A.EApp ((A.EOp op, pos), args)
+      let+ args = Bindlib.box_list (List.map (translate_expr ctx) args) in
+      same_pos @@ A.EApp ((A.EOp op, pos), args)
   | D.EApp (e1, args) ->
       let e1 = translate_expr ctx e1 in
       let pos = Pos.get_position (Bindlib.unbox e1) in
@@ -229,7 +218,8 @@ and translate_expr (ctx : ctx) (e : D.expr Pos.marked) : A.expr Pos.marked Bindl
       let lc_vars = Array.of_list lc_vars in
       let new_body = translate_expr ctx body in
       let+ new_binder = Bindlib.bind_mvar lc_vars new_body in
-      same_pos @@ A.make_some' (same_pos @@ A.EAbs ((new_binder, pos_binder), List.map translate_typ ts))
+      same_pos
+      @@ A.make_some' (same_pos @@ A.EAbs ((new_binder, pos_binder), List.map translate_typ ts))
   | D.EDefault (exceptions, just, cons) ->
       translate_default ctx exceptions just cons (Pos.get_position e)
 
@@ -251,9 +241,9 @@ let translate_program (prgm : D.program) : A.program =
            ([], D.VarMap.empty) prgm.scopes
        in
        List.rev acc);
-    decl_ctx = {
-      ctx_enums = prgm.decl_ctx.ctx_enums
-      |> D.EnumMap.add A.option_enum A.option_enum_config;
-      ctx_structs = prgm.decl_ctx.ctx_structs;
-    }
+    decl_ctx =
+      {
+        ctx_enums = prgm.decl_ctx.ctx_enums |> D.EnumMap.add A.option_enum A.option_enum_config;
+        ctx_structs = prgm.decl_ctx.ctx_structs;
+      };
   }

compiler/lcalc/optimizations.ml

@@ -15,118 +15,78 @@ open Utils
 open Ast
 
 let ( let+ ) x f = Bindlib.box_apply f x
+
 let ( and+ ) x y = Bindlib.box_pair x y
 
-let transform
-  (t: 'a -> 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 transform (t : 'a -> 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.mark (Pos.get_position e) e' in
   match Pos.unmark e with
   | EVar (v, pos) ->
-    let+ v = Bindlib.box_var v in
-    (v, pos)
-
+      let+ v = Bindlib.box_var v in
+      (v, pos)
   | ETuple (args, n) ->
-    let+ args = args 
-      |> List.map (t ctx)
-      |> Bindlib.box_list
-    in
-    default_mark @@ ETuple (args, n)
-
+      let+ args = args |> List.map (t ctx) |> Bindlib.box_list in
+      default_mark @@ ETuple (args, n)
   | ETupleAccess (e1, i, n, ts) ->
-    let+ e1 = t ctx e1 in
-    default_mark @@ ETupleAccess (e1, i, n, ts)
-
+      let+ e1 = t ctx e1 in
+      default_mark @@ ETupleAccess (e1, i, n, ts)
   | EInj (e1, i, n, ts) ->
-    let+ e1 = t ctx e1 in
-    default_mark @@ EInj (e1, i, n, ts)
-
+      let+ e1 = t ctx e1 in
+      default_mark @@ EInj (e1, i, n, ts)
   | EMatch (arg, cases, n) ->
-    let+ arg = t ctx arg
-    and+ cases = cases
-      |> List.map (t ctx)
-      |> Bindlib.box_list
-    in
-    default_mark @@ EMatch (arg, cases, n)
-
+      let+ arg = t ctx arg and+ cases = cases |> List.map (t ctx) |> Bindlib.box_list in
+      default_mark @@ EMatch (arg, cases, n)
   | EArray args ->
-    let+ args = args
-      |> List.map (t ctx)
-      |> Bindlib.box_list
-    in
-    default_mark @@ EArray args
-
+      let+ args = args |> List.map (t ctx) |> Bindlib.box_list in
+      default_mark @@ EArray args
   | EAbs ((binder, pos_binder), ts) ->
-    let vars, body = Bindlib.unmbind binder in
-    let body = t ctx body in
-    let+ binder = Bindlib.bind_mvar vars body in
-    default_mark @@ EAbs ((binder, pos_binder), ts)
-  
+      let vars, body = Bindlib.unmbind binder in
+      let body = t ctx body in
+      let+ binder = Bindlib.bind_mvar vars body in
+      default_mark @@ EAbs ((binder, pos_binder), ts)
   | EApp (e1, args) ->
-    let+ e1 = t ctx e1
-    and+ args = args
-      |> List.map (t ctx)
-      |> Bindlib.box_list
-    in
-    default_mark @@ EApp (e1, args)
-  
+      let+ e1 = t ctx e1 and+ args = args |> List.map (t ctx) |> Bindlib.box_list in
+      default_mark @@ EApp (e1, args)
   | EAssert e1 ->
-    let+ e1 = t ctx e1 in
-    default_mark @@ EAssert e1
-  
+      let+ e1 = t ctx e1 in
+      default_mark @@ EAssert e1
   | EIfThenElse (e1, e2, e3) ->
-    let+ e1 = t ctx e1
-    and+ e2 = t ctx e2
-    and+ e3 = t ctx e3 in
-    default_mark @@ EIfThenElse (e1, e2, e3)
-
+      let+ e1 = t ctx e1 and+ e2 = t ctx e2 and+ e3 = t ctx e3 in
+      default_mark @@ EIfThenElse (e1, e2, e3)
   | ECatch (e1, exn, e2) ->
-    let+ e1 = t ctx e1
-    and+ e2 = t ctx e2 in
-    default_mark @@ ECatch (e1, exn, e2)
-
+      let+ e1 = t ctx e1 and+ e2 = t ctx e2 in
+      default_mark @@ ECatch (e1, exn, e2)
   | ERaise _ | ELit _ | EOp _ -> Bindlib.box e
 
-
-let rec iota_expr (_: unit) (e: expr Pos.marked) : expr Pos.marked Bindlib.box =
+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 = transform iota_expr () e1
-    and+ case = transform iota_expr () (List.nth cases i) in
-    default_mark @@ EApp (case, [e1])
-
+  | EMatch ((EInj (e1, i, n', _ts), _), cases, n) when Dcalc.Ast.EnumName.compare n n' = 0 ->
+      let+ e1 = transform iota_expr () e1 and+ case = transform iota_expr () (List.nth cases i) in
+      default_mark @@ EApp (case, [ e1 ])
   | _ -> transform iota_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 rec peephole_expr (_: unit) (e : expr Pos.marked) : expr Pos.marked Bindlib.box =
-
+let rec peephole_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
-  | EIfThenElse (e1, e2, e3) ->
-    let+ e1 = transform peephole_expr () e1
-    and+ e2 = transform peephole_expr () e2
-    and+ e3 = transform peephole_expr () e3 in
-      begin match Pos.unmark e1 with
-      | ELit (LBool true) | EApp ((EOp (Unop (Log _)), _), [ (ELit (LBool true), _)]) -> e2
-      | ELit (LBool false) | EApp ((EOp (Unop (Log _)), _), [ (ELit (LBool false), _)]) -> e3
-      | _ -> default_mark @@ EIfThenElse (e1, e2, e3)
-    end
+  | EIfThenElse (e1, e2, e3) -> (
+      let+ e1 = transform peephole_expr () e1
+      and+ e2 = transform peephole_expr () e2
+      and+ e3 = transform peephole_expr () e3 in
+      match Pos.unmark e1 with
+      | ELit (LBool true) | EApp ((EOp (Unop (Log _)), _), [ (ELit (LBool true), _) ]) -> e2
+      | ELit (LBool false) | EApp ((EOp (Unop (Log _)), _), [ (ELit (LBool false), _) ]) -> e3
+      | _ -> default_mark @@ EIfThenElse (e1, e2, e3))
   | _ -> transform peephole_expr () e
 
 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 =
-  p
-  |> iota_optimizations
-  |> peephole_optimizations
+let optimize_program (p : program) : program = p |> iota_optimizations |> peephole_optimizations

compiler/runtime.ml

@@ -31,9 +31,7 @@ type source_position = {
   law_headings : string list;
 }
 
-type 'a eoption =
-  | ENone of unit
-  | ESome of 'a
+type 'a eoption = ENone of unit | ESome of 'a
 
 exception EmptyError
 

compiler/runtime.mli

@@ -33,9 +33,7 @@ type source_position = {
   law_headings : string list;
 }
 
-type 'a eoption =
-  | ENone of unit
-  | ESome of 'a
+type 'a eoption = ENone of unit | ESome of 'a
 
 (** {1 Exceptions} *)
 

compiler/utils/pos.mli

@@ -64,7 +64,7 @@ type 'a marked = 'a * t
 val no_pos : t
 (** Placeholder position *)
 
-val mark: t -> 'a -> 'a marked
+val mark : t -> 'a -> 'a marked
 
 val unmark : 'a marked -> 'a
 

french_law/ocaml/law_source/allocations_familiales.ml

@@ -1183,19 +1183,20 @@ let prestations_familiales (prestations_familiales_in : prestations_familiales_i
                            "Code de la sécurité sociale";
                          ];
                      }
-                     ((match param_.obligation_scolaire with
-                      | Avant _ -> true
+                     (((match param_.obligation_scolaire with
+                       | Avant _ -> true
+                       | Pendant _ -> false
+                       | Apres _ -> false)
+                      || (match param_.obligation_scolaire with
+                         | Avant _ -> false
+                         | Pendant _ -> true
+                         | Apres _ -> false)
+                      ||
+                      match param_.obligation_scolaire with
+                      | Avant _ -> false
                       | Pendant _ -> false
-                      | Apres _ -> false)
-                     || (match param_.obligation_scolaire with
-                        | Avant _ -> false
-                        | Pendant _ -> true
-                        | Apres _ -> false)
-                     || (match param_.obligation_scolaire with
-                        | Avant _ -> false
-                        | Pendant _ -> false
-                        | Apres _ -> true)
-                        && param_.remuneration_mensuelle <=$ plafond_l512_3_2_)
+                      | Apres _ -> true)
+                     && param_.remuneration_mensuelle <=$ plafond_l512_3_2_)
                  then true
                  else raise EmptyError
                with EmptyError -> false