Merge branch 'master' into allocations_logement

.github/workflows/update-flake-lock.yml

@@ -16,6 +16,9 @@ jobs:
       - name: update flake.lock
         run: |
           nix flake update
+      - name: check it builds
+        run: |
+          nix build
       - name: commit changes
         uses: EndBug/add-and-commit@v9
         with:

.nix/catala.nix

@@ -3,7 +3,7 @@
 , fetchFromGitHub
 , buildDunePackage
 , ansiterminal
-, sedlex_2
+, sedlex
 , menhir
 , unionfind
 , bindlib
@@ -32,13 +32,13 @@ buildDunePackage rec {
 
   minimumOCamlVersion = "4.11";
 
-  src = ./.;
+  src = ../.;
 
   useDune2 = true;
 
   propagatedBuildInputs = [
     ansiterminal
-    sedlex_2
+    sedlex
     menhir
     menhirLib
     cmdliner_1_1_0
@@ -56,6 +56,7 @@ buildDunePackage rec {
     cppo
     z3
 
+
     pkgs.z3
 
     ppx_deriving

.nix/clerk.nix

@@ -0,0 +1,40 @@
+{ lib
+, buildDunePackage
+, odoc
+, re
+, ansiterminal
+, cmdliner_1_1_0
+, ninja_utils
+, alcotest
+, catala
+}:
+
+buildDunePackage rec {
+  pname = "clerk";
+  version = "0.6.0"; # TODO parse `catala.opam` with opam2json
+
+  minimumOCamlVersion = "4.11";
+
+  src = ../.;
+
+  useDune2 = true;
+
+  propagatedBuildInputs = [
+    odoc
+    re
+    ansiterminal
+    cmdliner_1_1_0
+    ninja_utils
+    alcotest
+    catala
+  ];
+  doCheck = false;
+
+  meta = with lib; {
+    homepage = "https://github.com/CatalaLang/catala";
+    description =
+      "Build system for Catala, a specification language for tax and social benefits computation rules";
+    license = licenses.asl20;
+    maintainers = with maintainers; [ ];
+  };
+}

.nix/ninja_utils.nix

@@ -0,0 +1,30 @@
+{ lib
+, buildDunePackage
+, odoc
+, re
+}:
+
+buildDunePackage rec {
+  pname = "ninja_utils";
+  version = "0.6.0"; # TODO parse `catala.opam` with opam2json
+
+  minimumOCamlVersion = "4.11";
+
+  src = ../.;
+
+  useDune2 = true;
+
+  propagatedBuildInputs = [
+    odoc
+    re
+  ];
+  doCheck = true;
+
+  meta = with lib; {
+    homepage = "https://catala-lang.org";
+    description =
+      "A collection of utility functions used to generate Ninja build files";
+    license = licenses.asl20;
+    maintainers = with maintainers; [ ];
+  };
+}

.nix/packages.nix

@@ -13,7 +13,10 @@ ocamlPackages.overrideScope' (self: super: {
   }).overrideAttrs (_: {
     doCheck = false;
   });
-  bindlib = ocamlPackages.callPackage ./bindlib.nix { };
-  unionfind = ocamlPackages.callPackage ./unionfind.nix { };
-  ppx_yojson_conv = ocamlPackages.callPackage ./ppx_yojson_conv.nix { };
+  catala = self.callPackage ./catala.nix { };
+  bindlib = self.callPackage ./bindlib.nix { };
+  unionfind = self.callPackage ./unionfind.nix { };
+  ninja_utils = self.callPackage ./ninja_utils.nix { };
+  clerk = self.callPackage ./clerk.nix { };
+  ppx_yojson_conv = self.callPackage ./ppx_yojson_conv.nix { };
 })

Makefile

@@ -140,12 +140,17 @@ vscode: vscode_fr vscode_en
 
 EXAMPLES_DIR=examples
 ALLOCATIONS_FAMILIALES_DIR=$(EXAMPLES_DIR)/allocations_familiales
+AIDES_LOGEMENT_DIR=$(EXAMPLES_DIR)/aides_logement
 CODE_GENERAL_IMPOTS_DIR=$(EXAMPLES_DIR)/code_general_impots
 US_TAX_CODE_DIR=$(EXAMPLES_DIR)/us_tax_code
 TUTORIAL_EN_DIR=$(EXAMPLES_DIR)/tutorial_en
 TUTORIEL_FR_DIR=$(EXAMPLES_DIR)/tutoriel_fr
 POLISH_TAXES_DIR=$(EXAMPLES_DIR)/polish_taxes
 
+literate_aides_logement: build
+	$(MAKE) -C $(AIDES_LOGEMENT_DIR) aides_logement.tex
+	$(MAKE) -C $(AIDES_LOGEMENT_DIR) aides_logement.html
+
 literate_allocations_familiales: build
 	$(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.tex
 	$(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.html
@@ -172,7 +177,8 @@ literate_polish_taxes: build
 
 #> literate_examples			: Builds the .tex and .html versions of the examples code. Needs pygments to be installed and patched with Catala.
 literate_examples: literate_allocations_familiales literate_code_general_impots \
-	literate_us_tax_code literate_tutorial_en literate_tutoriel_fr literate_polish_taxes
+	literate_us_tax_code literate_tutorial_en literate_tutoriel_fr \
+	literate_polish_taxes literate_aides_logement
 
 ##########################################
 # French law library
@@ -185,11 +191,11 @@ literate_examples: literate_allocations_familiales literate_code_general_impots
 FRENCH_LAW_OCAML_LIB_DIR=french_law/ocaml
 
 $(FRENCH_LAW_OCAML_LIB_DIR)/law_source/allocations_familiales.ml:
-	CATALA_OPTS="$(CATALA_OPTS) -O -t" $(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.ml
+	CATALA_OPTS="$(CATALA_OPTS) -t" $(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) allocations_familiales.ml
 	cp -f $(ALLOCATIONS_FAMILIALES_DIR)/allocations_familiales.ml $@
 
 $(FRENCH_LAW_OCAML_LIB_DIR)/law_source/unit_tests/tests_allocations_familiales.ml:
-	CATALA_OPTS="$(CATALA_OPTS) -O -t" $(MAKE) -s -C $(ALLOCATIONS_FAMILIALES_DIR) tests/tests_allocations_familiales.ml
+	CATALA_OPTS="$(CATALA_OPTS) -t" $(MAKE) -C $(ALLOCATIONS_FAMILIALES_DIR) tests/tests_allocations_familiales.ml
 	cp -f $(ALLOCATIONS_FAMILIALES_DIR)/tests/tests_allocations_familiales.ml $@
 
 #> generate_french_law_library_ocaml	: Generates the French law library OCaml sources from Catala

compiler/desugared/desugared_to_scope.ml

@@ -361,7 +361,7 @@ let translate_def
   let top_list = def_map_to_tree def_info def in
   let top_value =
     (if is_cond then Ast.always_false_rule else Ast.empty_rule)
-      Pos.no_pos is_def_func_param_typ
+      (Pos.get_position typ) is_def_func_param_typ
   in
   if
     Ast.RuleMap.cardinal def = 0

compiler/index.mld

@@ -72,7 +72,7 @@ v}
 
 {1 List of top-level modules }
 
-Each of those intermediate representation is bundled into its own `dune` bundle
+Each of those intermediate representation is bundled into its own [dune] bundle
 module. Click on the items below if you want to dive straight into the signatures.
 
 {!modules: Surface Desugared Scopelang Dcalc Lcalc Scalc }
@@ -106,6 +106,10 @@ Two more modules contain additional features for the compiler:
 {li {{: utils.html} Compiler utilities}}
 }
 
+The Catala runtime documentation is available here:
+
+{!modules: Runtime}
+
 Last, it is possible to customize the backend to the compiler using a plugin
 mechanism. The API is defined inside the following module:
 

compiler/lcalc/to_ocaml.ml

@@ -357,7 +357,7 @@ let rec format_expr
       format_binop (op, Pos.no_pos) format_with_parens arg2
   | EApp ((EApp ((EOp (Unop (D.Log (D.BeginCall, info))), _), [f]), _), [arg])
     when !Cli.trace_flag ->
-    Format.fprintf fmt "(log_begin_call@ %a@ %a@ %a)" format_uid_list info
+    Format.fprintf fmt "(log_begin_call@ %a@ %a)@ %a" format_uid_list info
       format_with_parens f format_with_parens arg
   | EApp ((EOp (Unop (D.Log (D.VarDef tau, info))), _), [arg1])
     when !Cli.trace_flag ->

compiler/literate/html.ml

@@ -141,7 +141,7 @@ let pygmentize_code (c : string Pos.marked) (language : C.backend_lang) : string
       "style=colorful,anchorlinenos=True,lineanchors=\""
       ^ Pos.get_file (Pos.get_position c)
       ^ "\",linenos=table,linenostart="
-      ^ string_of_int (Pos.get_start_line (Pos.get_position c));
+      ^ string_of_int (Pos.get_start_line (Pos.get_position c) - 1);
       "-o";
       temp_file_out;
       temp_file_in;

compiler/runtime.ml

@@ -29,6 +29,7 @@ type source_position = {
   end_column : int;
   law_headings : string list;
 }
+[@@deriving yojson_of]
 
 exception EmptyError
 exception AssertionFailed
@@ -172,19 +173,45 @@ let embed_date x = Date x
 let embed_duration x = Duration x
 let embed_array f x = Array (Array.map f x)
 
-type event =
-  | BeginCall of string list
-  | EndCall of string list
-  | VariableDefinition of string list * runtime_value
+type information = string list [@@deriving yojson_of]
+
+type raw_event =
+  | BeginCall of information
+  | EndCall of information
+  | VariableDefinition of information * runtime_value
   | DecisionTaken of source_position
 
-let log_ref : event list ref = ref []
+type event =
+  | VarComputation of var_def
+  | FunCall of fun_call
+  | SubScopeCall of {
+      name : information;
+      inputs : var_def list;
+      body : event list;
+    }
+[@@deriving yojson_of]
+
+and var_def = {
+  pos : source_position option;
+  name : information;
+  value : runtime_value;
+  fun_calls : fun_call list option;
+}
+
+and fun_call = {
+  fun_name : information;
+  input : var_def;
+  body : event list;
+  output : var_def;
+}
+
+let log_ref : raw_event list ref = ref []
 let reset_log () = log_ref := []
 let retrieve_log () = List.rev !log_ref
 
-let log_begin_call info f x =
+let log_begin_call info f =
   log_ref := BeginCall info :: !log_ref;
-  f x
+  f
 
 let log_end_call info x =
   log_ref := EndCall info :: !log_ref;
@@ -198,6 +225,271 @@ let log_decision_taken pos x =
   if x then log_ref := DecisionTaken pos :: !log_ref;
   x
 
+let rec pp_events ?(is_first_call = true) ppf events =
+  let rec format_var_def ppf var =
+    Format.fprintf ppf "@[<hov 2><var_def at %a>@ %s:@ %a@]" format_pos_opt
+      var.pos
+      (String.concat "." var.name)
+      format_value var.value
+  and format_pos_opt ppf = function
+    | None -> Format.fprintf ppf "no_pos"
+    | Some pos ->
+      Format.fprintf ppf "%s line %d to %d" pos.filename pos.start_line
+        pos.end_line
+  and format_var_defs ppf =
+    Format.pp_print_list
+      ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ ")
+      format_var_def ppf
+  and format_var_def_with_fun_calls ppf var_with_fun =
+    match var_with_fun.fun_calls with
+    | None | Some [] -> format_var_def ppf var_with_fun
+    | Some fun_calls ->
+      Format.fprintf ppf
+        "@[<hov 2><var_def_with_fun>@ %s: %a@ computed from@ :@ @[<hv 2>[@ %a@;\
+         <1 -2>]@] @]"
+        (String.concat "." var_with_fun.name)
+        format_value var_with_fun.value
+        (Format.pp_print_list
+           ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
+           (fun ppf fun_call -> format_event ppf (FunCall fun_call)))
+        fun_calls
+  and format_value ppf = function
+    | Unembeddable -> Format.fprintf ppf "fun"
+    | Unit -> Format.fprintf ppf "()"
+    | Bool x -> Format.fprintf ppf "%b" x
+    | Money x -> Format.fprintf ppf "%s€" (money_to_string x)
+    | Integer x -> Format.fprintf ppf "%d" (integer_to_int x)
+    | Decimal x ->
+      Format.fprintf ppf "%s" (decimal_to_string ~max_prec_digits:10 x)
+    | Date x -> Format.fprintf ppf "%s" (date_to_string x)
+    | Duration x -> Format.fprintf ppf "%s" (duration_to_string x)
+    | Enum (_, (name, _)) -> Format.fprintf ppf "%s" name
+    | Struct (name, attrs) ->
+      Format.fprintf ppf "@[<hv 2>%s = {@ %a@;<1 -2>}@]"
+        (String.concat "." name)
+        (Format.pp_print_list
+           ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@,")
+           (fun fmt (name, value) ->
+             Format.fprintf fmt "%s: %a" name format_value value))
+        attrs
+    | Array elts ->
+      Format.fprintf ppf "@[<hv 2>[@ %a@;<1 -2>]@]"
+        (Format.pp_print_list
+           ~pp_sep:(fun ppf () -> Format.fprintf ppf ";@ ")
+           format_value)
+        (elts |> Array.to_list)
+  and format_event ppf = function
+    | VarComputation var_def_with_fun
+      when Option.is_some var_def_with_fun.fun_calls ->
+      Format.fprintf ppf "%a" format_var_def_with_fun_calls var_def_with_fun
+    | VarComputation var_def -> Format.fprintf ppf "%a" format_var_def var_def
+    | FunCall { fun_name; input; body; output } ->
+      Format.fprintf ppf
+        "@[<hov 1><function_call>@ %s :=@ {@[<hv 1>@ input:@ %a,@ output:@ \
+         %a,@ body:@ [@,\
+         %a]@]@,\
+         @]@,\
+         }"
+        (String.concat "." fun_name)
+        format_var_def input format_var_def_with_fun_calls output
+        (pp_events ~is_first_call:false)
+        body
+    | SubScopeCall { name; inputs; body } ->
+      Format.fprintf ppf
+        "@[<hv 2><subscope_call>@ %s :=@ {@[<hv 1>@,\
+         inputs:@ @[<hv 2>[@,\
+         %a@]],@,\
+         body:@ @[<hv 2>[@ %a@ ]@]@]@]@,\
+         }"
+        (String.concat "." name) format_var_defs inputs
+        (pp_events ~is_first_call:false)
+        body
+  in
+  Format.fprintf ppf
+    ("@[<hv 1>%a@]" ^^ if is_first_call then "@." else "")
+    (Format.pp_print_list
+       ~pp_sep:(fun ppf () -> Format.fprintf ppf "@ ")
+       format_event)
+    events
+
+module EventParser = struct
+  module VarDefMap = struct
+    module StringMap = Map.Make (String)
+
+    type t = var_def list StringMap.t
+
+    let add (name : string) (v : var_def) (map : t) : t =
+      match StringMap.find_opt name map with
+      | Some ls -> StringMap.add name (v :: ls) map
+      | None -> StringMap.add name [v] map
+
+    (** [get name map] returns the list of definitions if there is a
+        corresponding entry, otherwise, returns an empty array. *)
+    let get (name : string) (map : t) : var_def list =
+      match StringMap.find_opt name map with Some ls -> ls | None -> []
+
+    let empty : t = StringMap.empty
+  end
+
+  type context = {
+    (* Keeps tracks of the subscope input variable definitions. *)
+    vars : VarDefMap.t;
+    (* Current parsed events. *)
+    events : event list;
+    rest : raw_event list;
+  }
+
+  let empty_ctx = { vars = VarDefMap.empty; events = []; rest = [] }
+
+  let raw_event_to_string = function
+    | BeginCall name ->
+      Printf.sprintf "BeginCall([ " ^ String.concat ", " name ^ " ])"
+    | EndCall name ->
+      Printf.sprintf "EndCall([ " ^ String.concat ", " name ^ " ])"
+    | VariableDefinition (name, value) ->
+      Printf.sprintf "VariableDefinition([ %s ], %s)" (String.concat ", " name)
+        (yojson_of_runtime_value value |> Yojson.Safe.to_string)
+    | DecisionTaken _ -> Printf.sprintf "DecisionTaken(_)"
+
+  let parse_raw_events raw_events =
+    let nb_raw_events = List.length raw_events
+    and is_function_call infos = 2 = List.length infos
+    and is_subscope_call infos = 3 = List.length infos
+    and is_var_def name = 2 = List.length name
+    and is_output_var_def name =
+      3 = List.length name && "output" = List.nth name 2
+    and is_input_var_def name =
+      3 = List.length name && "input" = List.nth name 2
+    and is_subscope_input_var_def name =
+      2 = List.length name && String.contains (List.nth name 1) '.'
+    in
+
+    let rec parse_events (ctx : context) : context =
+      match ctx.rest with
+      | [] -> { ctx with events = ctx.events |> List.rev }
+      | VariableDefinition (name, _) :: rest when is_var_def name ->
+        (* VariableDefinition without position corresponds to a function
+           definition which are ignored for now in structured events. *)
+        parse_events { ctx with rest }
+      | DecisionTaken pos :: VariableDefinition (name, value) :: rest
+        when is_subscope_input_var_def name -> (
+        match name with
+        | [_; var_dot_subscope_var_name] ->
+          let var_name =
+            List.nth (String.split_on_char '.' var_dot_subscope_var_name) 0
+          in
+          parse_events
+            {
+              ctx with
+              vars =
+                ctx.vars
+                |> VarDefMap.add var_name
+                     { pos = Some pos; name; value; fun_calls = None };
+              rest;
+            }
+        | _ ->
+          failwith "unreachable due to the [is_subscope_input_var_def] test")
+      | DecisionTaken pos :: VariableDefinition (name, value) :: rest
+        when is_var_def name || is_output_var_def name ->
+        parse_events
+          {
+            ctx with
+            events =
+              VarComputation { pos = Some pos; name; value; fun_calls = None }
+              :: ctx.events;
+            rest;
+          }
+      | DecisionTaken pos :: VariableDefinition _ :: BeginCall infos :: _
+        when is_function_call infos ->
+        (* Variable definition with function calls. *)
+        let rec parse_fun_calls fun_calls raw_events =
+          match raw_events with
+          | VariableDefinition _ :: BeginCall infos :: _
+            when is_function_call infos ->
+            let rest, fun_call = parse_fun_call raw_events in
+            parse_fun_calls (fun_call :: fun_calls) rest
+          | rest -> rest, fun_calls |> List.rev
+        in
+        let rest, var_comp =
+          let rest, fun_calls = parse_fun_calls [] (List.tl ctx.rest) in
+          match rest with
+          | VariableDefinition (name, value) :: rest ->
+            ( rest,
+              VarComputation
+                { pos = Some pos; name; value; fun_calls = Some fun_calls } )
+          | event :: _ ->
+            failwith
+              ("Invalid function call ([ " ^ String.concat ", " infos
+             ^ " ]): expected variable definition (function output), found: "
+             ^ raw_event_to_string event ^ "["
+              ^ (nb_raw_events - List.length rest + 1 |> string_of_int)
+              ^ "]")
+          | [] ->
+            failwith
+              ("Invalid function call ([ " ^ String.concat ", " infos
+             ^ " ]): expected variable definition (function output), found: \
+                end of tokens")
+        in
+
+        parse_events { ctx with events = var_comp :: ctx.events; rest }
+      | VariableDefinition _ :: BeginCall infos :: _ when is_function_call infos
+        ->
+        let rest, fun_call = parse_fun_call ctx.rest in
+
+        parse_events { ctx with events = FunCall fun_call :: ctx.events; rest }
+      | BeginCall infos :: rest when is_subscope_call infos -> (
+        match infos with
+        | [_; var_name; _] ->
+          let body_ctx = parse_events { empty_ctx with rest } in
+          let inputs = VarDefMap.get var_name ctx.vars in
+          parse_events
+            {
+              ctx with
+              events =
+                SubScopeCall { name = infos; inputs; body = body_ctx.events }
+                :: ctx.events;
+              rest = body_ctx.rest;
+            }
+        | _ -> failwith "unreachable due to the [is_subscope_call] test")
+      | EndCall _ :: rest -> { ctx with events = ctx.events |> List.rev; rest }
+      | event :: _ -> failwith ("Unexpected event: " ^ raw_event_to_string event)
+    and parse_fun_call events =
+      match events with
+      | VariableDefinition (name, value) :: BeginCall infos :: rest
+        when is_function_call infos && is_input_var_def name ->
+        let rest, body, output =
+          let body_ctx =
+            parse_events { vars = VarDefMap.empty; events = []; rest }
+          in
+          let body_rev = List.rev body_ctx.events in
+          body_ctx.rest, body_rev |> List.tl |> List.rev, body_rev |> List.hd
+        in
+        let output =
+          match output with
+          | VarComputation var_def -> var_def
+          | _ -> failwith "Missing function output variable definition."
+        in
+
+        ( rest,
+          {
+            fun_name = infos;
+            input = { pos = None; name; value; fun_calls = None };
+            body;
+            output;
+          } )
+      | _ -> failwith "Invalid start of function call."
+    in
+
+    let ctx =
+      try parse_events { empty_ctx with rest = raw_events }
+      with Failure msg ->
+        (* TODO: discuss what should be done. *)
+        Printf.eprintf "An error occurred while parsing raw events: %s\n" msg;
+        empty_ctx
+    in
+    ctx.events
+end
+
 let handle_default :
       'a. (unit -> 'a) array -> (unit -> bool) -> (unit -> 'a) -> 'a =
  fun exceptions just cons ->

compiler/runtime.mli

@@ -31,6 +31,7 @@ type source_position = {
   end_column : int;
   law_headings : string list;
 }
+[@@deriving yojson_of]
 
 type 'a eoption = ENone of unit | ESome of 'a
 
@@ -72,19 +73,136 @@ val embed_array : ('a -> runtime_value) -> 'a Array.t -> runtime_value
 
 (** {1 Logging} *)
 
+(** {2 Global process} *)
+
+(** The logging is constituted of two phases:
+
+    - The first one consists of collecting {i raw} events (see
+      {!type:raw_event}) during the program execution (see {!val:retrieve_log})
+      throught {!instruments}.
+    - The second one consists in parsing the collected raw events into
+      {i structured} ones (see {!type: event}). *)
+
+(** {2 Data structures} *)
+
+type information = string list [@@deriving yojson_of]
+(** Represents information about a name in the code -- i.e. variable name,
+    subscope name, etc...
+
+    It's a list of strings with a length varying from 2 to 3, where:
+
+    - the first string is the name of the current scope -- starting with a
+      capitalized letter [Scope_name],
+    - the second string is either: the name of a scope variable or, the name of
+      a subscope input variable -- [a_subscope_var.input_var]
+    - the third string is either: a subscope name (starting with a capitalized
+      letter [Subscope_name] or, the [input] (resp. [output]) string -- which
+      corresponds to the input (resp. the output) of a function. *)
+
+(** {3 The raw events} *)
+
+type raw_event =
+  | BeginCall of information  (** Subscope or function call. *)
+  | EndCall of information  (** End of a subscope or a function call. *)
+  | VariableDefinition of information * runtime_value
+      (** Definition of a variable or a function argument. *)
+  | DecisionTaken of source_position  (** Source code position of an event. *)
+
+(** {3 The structured events} *)
+
+(** The corresponding grammar of the {!type: event} type, is the following:
+
+    {v
+<event> := <fun_call>
+         | <subscope_call>
+         | <var_def>
+         | <var_def_with_fun>
+         | VariableDefinition
+
+<fun_call> :=
+    VariableDefinition                      (function input)
+    <fun_call_beg>
+        <event>*
+        (<var_def> | <var_def_with_fun>)    (function output)
+    EndCall
+
+<var_def_with_fun> :=
+       /-- DecisionTaken
+pos of |   <fun_call>+                      (function calls needed to compute the variable value)
+       \-> VariableDefinition
+
+<subscope_call> :=
+    <sub_var_def>*          (sub-scope attributes def)
+    <sub_call_beg>
+        <event>+
+    EndCall
+
+<var_def> := DecisionTaken VariableDefinition(info, _)
+  (when info.length = 2 && info[1] == "id")
+
+<sub_var_def> := DecisionTaken VariableDefinition(info, _)
+  (when info.length = 3)
+
+<fun_call_beg> := BeginCall(info)
+  (when info.length = 2)
+
+<sub_call_beg> := BeginCall(info)
+  (when info.length = 2 and '.' in info[1])
+    v} *)
+
 type event =
-  | BeginCall of string list
-  | EndCall of string list
-  | VariableDefinition of string list * runtime_value
-  | DecisionTaken of source_position
+  | VarComputation of var_def
+  | FunCall of fun_call
+  | SubScopeCall of {
+      name : information;
+      inputs : var_def list;
+      body : event list;
+    }
+[@@deriving yojson_of]
+
+and var_def = {
+  pos : source_position option;
+  name : information;
+  value : runtime_value;
+  fun_calls : fun_call list option;
+}
+
+and fun_call = {
+  fun_name : information;
+  input : var_def;
+  body : event list;
+  output : var_def;
+}
+
+(** {2 Parsing} *)
+
+val retrieve_log : unit -> raw_event list
+(** [retrieve_log ()] returns the current list of collected [raw_event].*)
+
+module EventParser : sig
+  val parse_raw_events : raw_event list -> event list
+  (** [parse_raw_events raw_events] parses raw events into {i structured} ones. *)
+end
+
+(** {2 Helping functions} *)
+
+(** {3:instruments Logging instruments} *)
 
 val reset_log : unit -> unit
-val retrieve_log : unit -> event list
-val log_begin_call : string list -> ('a -> 'b) -> 'a -> 'b
+val log_begin_call : string list -> 'a -> 'a
 val log_end_call : string list -> 'a -> 'a
 val log_variable_definition : string list -> ('a -> runtime_value) -> 'a -> 'a
 val log_decision_taken : source_position -> bool -> bool
 
+(** {3 Pretty printers} *)
+
+val pp_events : ?is_first_call:bool -> Format.formatter -> event list -> unit
+(** [pp_events ~is_first_call ppf events] pretty prints in [ppf] the string
+    representation of [events].
+
+    If [is_first_call] is set to true, the formatter will be flush at the end.
+    By default, [is_first_call] is set to false. *)
+
 (**{1 Constructors and conversions} *)
 
 (**{2 Money}*)

compiler/scopelang/scope_to_dcalc.ml

@@ -276,11 +276,32 @@ let rec translate_expr (ctx : ctx) (e : Ast.expr Pos.marked) :
         | _ -> e1_func
       in
       let new_args = List.map (translate_expr ctx) args in
+      let input_typ, output_typ =
+        (* NOTE: this is a temporary solution, it works because it's assume that
+           all function calls are from scope variable. However, this will change
+           -- for more information see
+           https://github.com/CatalaLang/catala/pull/280#discussion_r898851693. *)
+        let retrieve_in_and_out_typ_or_any var vars =
+          let _, typ, _ = Ast.ScopeVarMap.find (Pos.unmark var) vars in
+          match typ with
+          | Dcalc.Ast.TArrow (marked_input_typ, marked_output_typ) ->
+            Pos.unmark marked_input_typ, Pos.unmark marked_output_typ
+          | _ -> Dcalc.Ast.TAny, Dcalc.Ast.TAny
+        in
+        match Pos.unmark e1 with
+        | ELocation (ScopeVar var) ->
+          retrieve_in_and_out_typ_or_any var ctx.scope_vars
+        | ELocation (SubScopeVar (_, sname, var)) ->
+          ctx.subscope_vars
+          |> Ast.SubScopeMap.find (Pos.unmark sname)
+          |> retrieve_in_and_out_typ_or_any var
+        | _ -> Dcalc.Ast.TAny, Dcalc.Ast.TAny
+      in
       let new_args =
         match Pos.unmark e1, new_args with
         | ELocation l, [new_arg] ->
           [
-            tag_with_log_entry new_arg (Dcalc.Ast.VarDef Dcalc.Ast.TAny)
+            tag_with_log_entry new_arg (Dcalc.Ast.VarDef input_typ)
               (markings l @ [Pos.same_pos_as "input" e]);
           ]
         | _ -> new_args
@@ -295,7 +316,7 @@ let rec translate_expr (ctx : ctx) (e : Ast.expr Pos.marked) :
         match Pos.unmark e1 with
         | ELocation l ->
           tag_with_log_entry
-            (tag_with_log_entry new_e (Dcalc.Ast.VarDef Dcalc.Ast.TAny)
+            (tag_with_log_entry new_e (Dcalc.Ast.VarDef output_typ)
                (markings l @ [Pos.same_pos_as "output" e]))
             Dcalc.Ast.EndCall (markings l)
         | _ -> new_e

dune

@@ -8,6 +8,7 @@
 
 (rule
  (alias runtest)
+ (package clerk)
  (deps
   (source_tree tests))
  (action
@@ -15,6 +16,7 @@
 
 (rule
  (alias runtest)
+ (package clerk)
  (deps
   (source_tree examples))
  (action

examples/aides_logement/prologue.catala_fr

@@ -1,7 +1,7 @@
-# Prologue : allocations logement
+# Prologue : aides au logement
 
 Avant de présenter les textes réglementaires qui régissent le calcul des
-allocations logement, il est nécessaire de définir les structures de données
+aides au logement, il est nécessaire de définir les structures de données
 informatiques qui modélisent la situation dont parlent ces textes législatifs.
 Vous pouvez passer cette section pour aller directement au textes législatifs
 dans les sections suivantes.
@@ -1094,7 +1094,7 @@ champ d'application CalculetteAidesAuLogement:
 
 ## Calculette avec garde alternée
 
-Afin de calculer l'impact de la garde alternée sur les allocations logement,
+Afin de calculer l'impact de la garde alternée sur les aides au logement,
 il est nécessaire de réaliser une double liquidation du calcul des aides
 au logement. Voir le code Catala attaché à la décision n°398563 du conseil
 d'État.

examples/allocations_familiales/epilogue.catala_fr

@@ -1,6 +1,6 @@
-## Épilogue
+# Épilogue
 
-### Règles diverses
+## Règles diverses
 
 Les textes législatifs et règlementaires contiennent toutes les informations
 kécessaires au calcul. Cependant, certaines règles de calcul sont implicites
@@ -52,7 +52,7 @@ champ d'application AllocationsFamiliales:
     sinon 0€
 ```
 
-### Interface du programme
+## Interface du programme
 
 Le calcul des allocations familiales nécessite un certain nombre d'informations
 sur les enfants à charge. Certaines de ces informations sont dépendantes les
@@ -102,9 +102,9 @@ champ d'application InterfaceAllocationsFamiliales:
   conséquence rempli
 ```
 
-#### Code de l'éducation
+### Code de l'éducation
 
-#### Article L131-1|LEGIARTI000038901859
+### Article L131-1|LEGIARTI000038901859
 
 L'instruction est obligatoire pour chaque enfant dès l'âge de trois ans et
 jusqu'à l'âge de seize ans.

flake.lock

@@ -2,11 +2,11 @@
   "nodes": {
     "flake-utils": {
       "locked": {
-        "lastModified": 1653893745,
-        "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=",
+        "lastModified": 1656065134,
+        "narHash": "sha256-oc6E6ByIw3oJaIyc67maaFcnjYOz1mMcOtHxbEf9NwQ=",
         "owner": "numtide",
         "repo": "flake-utils",
-        "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1",
+        "rev": "bee6a7250dd1b01844a2de7e02e4df7d8a0a206c",
         "type": "github"
       },
       "original": {
@@ -17,11 +17,11 @@
     },
     "nixpkgs": {
       "locked": {
-        "lastModified": 1653581809,
-        "narHash": "sha256-Uvka0V5MTGbeOfWte25+tfRL3moECDh1VwokWSZUdoY=",
+        "lastModified": 1656753965,
+        "narHash": "sha256-BCrB3l0qpJokOnIVc3g2lHiGhnjUi0MoXiw6t1o8H1E=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "83658b28fe638a170a19b8933aa008b30640fbd1",
+        "rev": "0ea7a8f1b939d74e5df8af9a8f7342097cdf69eb",
         "type": "github"
       },
       "original": {

flake.nix

@@ -14,7 +14,8 @@
       in
         rec {
           packages = {
-            catala = ocamlPackages.callPackage ./. {};
+            catala = ocamlPackages.catala;
+            clerk = ocamlPackages.clerk;
           };
           defaultPackage = packages.catala;
           devShell = pkgs.mkShell {

french_law/ocaml/api_web.ml

@@ -67,7 +67,7 @@ class type source_position =
     method lawHeadings : Js.js_string Js.t Js.js_array Js.t Js.prop
   end
 
-class type log_event =
+class type raw_event =
   object
     method eventType : Js.js_string Js.t Js.prop
     method information : Js.js_string Js.t Js.js_array Js.t Js.prop
@@ -75,13 +75,31 @@ class type log_event =
     method loggedValueJson : Js.js_string Js.t Js.prop
   end
 
+class type event =
+  object
+    method data : Js.js_string Js.t Js.prop
+  end
+
 let _ =
   Js.export_all
     (object%js
        method resetLog : (unit -> unit) Js.callback = Js.wrap_callback reset_log
 
-       method retrieveLog
-           : (unit -> log_event Js.t Js.js_array Js.t) Js.callback =
+       method retrieveEvents : (unit -> event Js.t Js.js_array Js.t) Js.callback
+           =
+         Js.wrap_callback (fun () ->
+             Js.array
+               (Array.of_list
+                  (retrieve_log () |> EventParser.parse_raw_events
+                  |> List.map (fun event ->
+                         object%js
+                           val mutable data =
+                             event |> Runtime.yojson_of_event
+                             |> Yojson.Safe.to_string |> Js.string
+                         end))))
+
+       method retrieveRawEvents
+           : (unit -> raw_event Js.t Js.js_array Js.t) Js.callback =
          Js.wrap_callback (fun () ->
              Js.array
                (Array.of_list

generate_website_assets.sh

@@ -9,6 +9,7 @@ fi
 
 rsync -a _build/default/_doc/_html/ $1/ocaml_docs/
 scp examples/allocations_familiales/allocations_familiales.html $1/
+scp examples/aides_logement/aides_logement.html $1/
 scp examples/us_tax_code/us_tax_code.html $1/
 scp examples/tutorial_en/tutorial_en.html $1/
 scp examples/tutoriel_fr/tutoriel_fr.html $1/