Information about variable I/O in log events

Dockerfile

@@ -2,8 +2,14 @@
 # (only depends on the opam files)
 FROM ocamlpro/ocaml:4.14-2023-04-02 AS dev-build-context
 
-# pandoc is not in alpine stable yet, install it manually with an explicit repository
+# pandoc and ninja are not in alpine stable yet, install it manually with an explicit repository
 RUN sudo apk add pandoc --repository=http://dl-cdn.alpinelinux.org/alpine/edge/community/
+# In order to compiler rescript for `npm install` in french_law/js we need
+# the following dependencies (according to https://github.com/GlancingMind/rescript-alpine-docker)
+RUN sudo apk add python3
+RUN sudo ln -s /usr/bin/python3 /usr/bin/python
+RUN sudo apk add g++
+RUN sudo apk add make
 
 RUN mkdir catala
 WORKDIR catala
@@ -16,7 +22,8 @@ ENV OPAMVAR_cataladevmode=1
 ENV OPAMVAR_catalaz3mode=1
 
 # Get a switch with all the dependencies installed
-RUN opam --cli=2.1 switch create catala ocaml-system && \
+RUN opam --cli=2.1 update && \
+    opam --cli=2.1 switch create catala ocaml-system && \
     opam --cli=2.1 pin . --no-action && \
     opam --cli=2.1 install . --with-test --with-doc --depext-only && \
     opam --cli=2.1 install . --with-test --with-doc --deps-only && \

compiler/dcalc/from_scopelang.ml

@@ -25,7 +25,7 @@ type scope_var_ctx = {
 
 type scope_input_var_ctx = {
   scope_input_name : StructField.t;
-  scope_input_io : Desugared.Ast.io_input Mark.pos;
+  scope_input_io : Runtime.io_input Mark.pos;
   scope_input_typ : naked_typ;
 }
 
@@ -191,9 +191,9 @@ let thunk_scope_arg ~is_func io_in e =
   let silent_var = Var.make "_" in
   let pos = Mark.get io_in in
   match Mark.remove io_in with
-  | Desugared.Ast.NoInput -> invalid_arg "thunk_scope_arg"
-  | Desugared.Ast.OnlyInput -> Expr.eerroronempty e (Mark.get e)
-  | Desugared.Ast.Reentrant ->
+  | Runtime.NoInput -> invalid_arg "thunk_scope_arg"
+  | Runtime.OnlyInput -> Expr.eerroronempty e (Mark.get e)
+  | Runtime.Reentrant ->
     (* we don't need to thunk expressions that are already functions *)
     if is_func then e
     else Expr.make_abs [| silent_var |] e [TLit TUnit, pos] pos
@@ -256,7 +256,7 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
         (fun var_name (str_field : scope_input_var_ctx option) expr ->
           let expr =
             match str_field, expr with
-            | Some { scope_input_io = Desugared.Ast.Reentrant, _; _ }, None ->
+            | Some { scope_input_io = Reentrant, _; _ }, None ->
               Some (Expr.unbox (Expr.eemptyerror (mark_tany m pos)))
             | _ -> expr
           in
@@ -307,7 +307,12 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
     in
     let single_arg =
       tag_with_log_entry arg_struct
-        (VarDef (TStruct sc_sig.scope_sig_input_struct))
+        (VarDef
+           {
+             log_typ = TStruct sc_sig.scope_sig_input_struct;
+             log_io_output = false;
+             log_io_input = OnlyInput;
+           })
         [
           ScopeName.get_info scope;
           Mark.add (Expr.pos e) "direct";
@@ -377,14 +382,24 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
                              ~f:(fun i (param_var, t_in) ->
                                tag_with_log_entry
                                  (Expr.make_var param_var (Expr.with_ty m t_in))
-                                 (VarDef (Mark.remove t_in))
+                                 (VarDef
+                                    {
+                                      log_typ = Mark.remove t_in;
+                                      log_io_output = false;
+                                      log_io_input = OnlyInput;
+                                    })
                                  (f_markings
                                  @ [
                                      Mark.add (Expr.pos e)
                                        ("input" ^ string_of_int i);
                                    ])))
                           (Expr.with_ty m t_out))
-                       (VarDef (Mark.remove t_out))
+                       (VarDef
+                          {
+                            log_typ = Mark.remove t_out;
+                            log_io_output = true;
+                            log_io_input = NoInput;
+                          })
                        (f_markings @ [Mark.add (Expr.pos e) "output"]))
                     EndCall f_markings)
                  ts_in (Expr.pos e)
@@ -422,7 +437,12 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
          result_eta_expanded
          (tag_with_log_entry
             (tag_with_log_entry if_then_else_returned
-               (VarDef (TStruct sc_sig.scope_sig_output_struct))
+               (VarDef
+                  {
+                    log_typ = TStruct sc_sig.scope_sig_output_struct;
+                    log_io_output = true;
+                    log_io_input = NoInput;
+                  })
                direct_output_info)
             EndCall
             [ScopeName.get_info scope; Mark.add (Expr.pos e) "direct"])
@@ -486,7 +506,13 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
         ~f:(fun i (new_arg, input_typ) ->
           match markings with
           | _ :: _ as m ->
-            tag_with_log_entry new_arg (VarDef input_typ)
+            tag_with_log_entry new_arg
+              (VarDef
+                 {
+                   log_typ = input_typ;
+                   log_io_output = false;
+                   log_io_input = OnlyInput;
+                 })
               (m @ [Mark.add (Expr.pos e) ("input" ^ string_of_int i)])
           | _ -> new_arg)
     in
@@ -497,7 +523,13 @@ let rec translate_expr (ctx : 'm ctx) (e : 'm Scopelang.Ast.expr) :
       | [] -> new_e
       | m ->
         tag_with_log_entry
-          (tag_with_log_entry new_e (VarDef output_typ)
+          (tag_with_log_entry new_e
+             (VarDef
+                {
+                  log_typ = output_typ;
+                  log_io_output = true;
+                  log_io_input = NoInput;
+                })
              (m @ [Mark.add (Expr.pos e) "output"]))
           EndCall m
     in
@@ -591,7 +623,12 @@ let translate_rule
     in
     let merged_expr =
       tag_with_log_entry merged_expr
-        (VarDef (Mark.remove tau))
+        (VarDef
+           {
+             log_typ = Mark.remove tau;
+             log_io_output = Mark.remove a_io.io_output;
+             log_io_input = Mark.remove a_io.io_input;
+           })
         [sigma_name, pos_sigma; a_name]
     in
     ( (fun next ->
@@ -628,7 +665,12 @@ let translate_rule
     let a_var = Var.make (Mark.remove a_name) in
     let new_e =
       tag_with_log_entry (translate_expr ctx e)
-        (VarDef (Mark.remove tau))
+        (VarDef
+           {
+             log_typ = Mark.remove tau;
+             log_io_output = false;
+             log_io_input = Mark.remove a_io.Desugared.Ast.io_input;
+           })
         [sigma_name, pos_sigma; a_name]
     in
     let is_func = match Mark.remove tau with TArrow _ -> true | _ -> false in

compiler/desugared/ast.ml

@@ -91,8 +91,7 @@ module ExprMap = Map.Make (struct
   let compare = Expr.compare
 end)
 
-type io_input = NoInput | OnlyInput | Reentrant
-type io = { io_output : bool Mark.pos; io_input : io_input Mark.pos }
+type io = { io_output : bool Mark.pos; io_input : Runtime.io_input Mark.pos }
 
 type exception_situation =
   | BaseCase

compiler/desugared/ast.mli

@@ -84,24 +84,10 @@ type meta_assertion =
   | FixedBy of reference_typ Mark.pos
   | VariesWith of unit * variation_typ Mark.pos option
 
-(** This type characterizes the three levels of visibility for a given scope
-    variable with regards to the scope's input and possible redefinitions inside
-    the scope.. *)
-type io_input =
-  | NoInput
-      (** For an internal variable defined only in the scope, and does not
-          appear in the input. *)
-  | OnlyInput
-      (** For variables that should not be redefined in the scope, because they
-          appear in the input. *)
-  | Reentrant
-      (** For variables defined in the scope that can also be redefined by the
-          caller as they appear in the input. *)
-
 type io = {
   io_output : bool Mark.pos;
       (** [true] is present in the output of the scope. *)
-  io_input : io_input Mark.pos;
+  io_input : Runtime.io_input Mark.pos;
 }
 (** Characterization of the input/output status of a scope variable. *)
 

compiler/desugared/from_surface.ml

@@ -1286,9 +1286,9 @@ let attribute_to_io (attr : Surface.Ast.scope_decl_context_io) : Ast.io =
       Mark.map
         (fun io ->
           match io with
-          | Surface.Ast.Input -> Ast.OnlyInput
-          | Surface.Ast.Internal -> Ast.NoInput
-          | Surface.Ast.Context -> Ast.Reentrant)
+          | Surface.Ast.Input -> Runtime.OnlyInput
+          | Surface.Ast.Internal -> Runtime.NoInput
+          | Surface.Ast.Context -> Runtime.Reentrant)
         attr.scope_decl_context_io_input;
   }
 
@@ -1333,7 +1333,7 @@ let init_scope_defs
                     (let original_io = attribute_to_io v_sig.var_sig_io in
                      let io_input =
                        if i = 0 then original_io.io_input
-                       else Ast.NoInput, Mark.get (StateName.get_info state)
+                       else NoInput, Mark.get (StateName.get_info state)
                      in
                      let io_output =
                        if i = List.length states - 1 then original_io.io_output

compiler/desugared/linting.ml

@@ -30,7 +30,7 @@ let detect_empty_definitions (p : program) : unit =
             && (not scope_def.scope_def_is_condition)
             &&
             match Mark.remove scope_def.scope_def_io.io_input with
-            | Ast.NoInput -> true
+            | NoInput -> true
             | _ -> false
           then
             Errors.format_spanned_warning

compiler/lcalc/to_ocaml.ml

@@ -315,10 +315,19 @@ let rec format_expr (ctx : decl_ctx) (fmt : Format.formatter) (e : 'm expr) :
     when !Cli.trace_flag ->
     Format.fprintf fmt "(log_begin_call@ %a@ %a)@ %a" format_uid_list info
       format_with_parens f format_with_parens arg
-  | EApp { f = EOp { op = Log (VarDef tau, info); _ }, _; args = [arg1] }
+  | EApp
+      { f = EOp { op = Log (VarDef var_def_info, info); _ }, _; args = [arg1] }
     when !Cli.trace_flag ->
-    Format.fprintf fmt "(log_variable_definition@ %a@ (%a)@ %a)" format_uid_list
-      info typ_embedding_name (tau, Pos.no_pos) format_with_parens arg1
+    Format.fprintf fmt
+      "(log_variable_definition@ %a@ {io_input=%s;@ io_output=%b}@ (%a)@ %a)"
+      format_uid_list info
+      (match var_def_info.log_io_input with
+      | NoInput -> "NoInput"
+      | OnlyInput -> "OnlyInput"
+      | Reentrant -> "Reentrant")
+      var_def_info.log_io_output typ_embedding_name
+      (var_def_info.log_typ, Pos.no_pos)
+      format_with_parens arg1
   | EApp { f = EOp { op = Log (PosRecordIfTrueBool, _); _ }, m; args = [arg1] }
     when !Cli.trace_flag ->
     let pos = Expr.mark_pos m in

compiler/scalc/to_python.ml

@@ -13,7 +13,6 @@
    WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
    License for the specific language governing permissions and limitations under
    the License. *)
-[@@@warning "-32-27"]
 
 open Catala_utils
 open Shared_ast
@@ -42,16 +41,9 @@ let format_lit (fmt : Format.formatter) (l : lit Mark.pos) : unit =
     let years, months, days = Runtime.duration_to_years_months_days d in
     Format.fprintf fmt "duration_of_numbers(%d,%d,%d)" years months days
 
-let format_log_entry (fmt : Format.formatter) (entry : log_entry) : unit =
-  match entry with
-  | VarDef _ -> Format.pp_print_string fmt ":="
-  | BeginCall -> Format.pp_print_string fmt "→ "
-  | EndCall -> Format.fprintf fmt "%s" "← "
-  | PosRecordIfTrueBool -> Format.pp_print_string fmt "☛ "
-
 let format_op (fmt : Format.formatter) (op : operator Mark.pos) : unit =
   match Mark.remove op with
-  | Log (entry, infos) -> assert false
+  | Log (_entry, _infos) -> assert false
   | Minus_int | Minus_rat | Minus_mon | Minus_dur ->
     Format.pp_print_string fmt "-"
   (* Todo: use the names from [Operator.name] *)
@@ -247,14 +239,6 @@ let format_func_name (fmt : Format.formatter) (v : FuncName.t) : unit =
   let v_str = Mark.remove (FuncName.get_info v) in
   format_name_cleaned fmt v_str
 
-let format_var_name (fmt : Format.formatter) (v : VarName.t) : unit =
-  Format.fprintf fmt "%a_%s" VarName.format_t v (string_of_int (VarName.hash v))
-
-let needs_parens (e : expr) : bool =
-  match Mark.remove e with
-  | ELit (LBool _ | LUnit) | EVar _ | EOp _ -> false
-  | _ -> true
-
 let format_exception (fmt : Format.formatter) (exc : except Mark.pos) : unit =
   let pos = Mark.get exc in
   match Mark.remove exc with
@@ -325,9 +309,16 @@ let rec format_expression (ctx : decl_ctx) (fmt : Format.formatter) (e : expr) :
     when !Cli.trace_flag ->
     Format.fprintf fmt "log_begin_call(%a,@ %a,@ %a)" format_uid_list info
       (format_expression ctx) f (format_expression ctx) arg
-  | EApp ((EOp (Log (VarDef tau, info)), _), [arg1]) when !Cli.trace_flag ->
-    Format.fprintf fmt "log_variable_definition(%a,@ %a)" format_uid_list info
-      (format_expression ctx) arg1
+  | EApp ((EOp (Log (VarDef var_def_info, info)), _), [arg1])
+    when !Cli.trace_flag ->
+    Format.fprintf fmt
+      "log_variable_definition(%a,@ LogIO(io_input=%s,@ io_output=%b),@ %a)"
+      format_uid_list info
+      (match var_def_info.log_io_input with
+      | Runtime.NoInput -> "NoInput"
+      | Runtime.OnlyInput -> "OnlyInput"
+      | Runtime.Reentrant -> "Reentrant")
+      var_def_info.log_io_output (format_expression ctx) arg1
   | EApp ((EOp (Log (PosRecordIfTrueBool, _)), pos), [arg1])
     when !Cli.trace_flag ->
     Format.fprintf fmt
@@ -556,7 +547,7 @@ let format_ctx
         format_enum_name enum_name
         (Format.pp_print_list
            ~pp_sep:(fun fmt () -> Format.fprintf fmt "@\n")
-           (fun fmt (i, enum_cons, enum_cons_type) ->
+           (fun fmt (i, enum_cons, _enum_cons_type) ->
              Format.fprintf fmt "%a = %d" format_enum_cons_name enum_cons i))
         (List.mapi
            (fun i (x, y) -> i, x, y)

compiler/scopelang/from_desugared.ml

@@ -225,7 +225,7 @@ let rule_to_exception_graph (scope : Desugared.Ast.scope) = function
                  ((match
                      Mark.remove scope_def.Desugared.Ast.scope_def_io.io_input
                    with
-                  | Desugared.Ast.NoInput -> true
+                  | NoInput -> true
                   | _ -> false)
                  && RuleName.Map.is_empty scope_def.scope_def_rules))
         scope.scope_defs
@@ -244,7 +244,7 @@ let rule_to_exception_graph (scope : Desugared.Ast.scope) = function
             (match
                Mark.remove scope_def.Desugared.Ast.scope_def_io.io_input
              with
-            | Desugared.Ast.NoInput ->
+            | NoInput ->
               Errors.raise_multispanned_error
                 (( Some "Incriminated subscope:",
                    Mark.get (SubScopeName.get_info sscope) )
@@ -627,7 +627,7 @@ let translate_rule
                  ((match
                      Mark.remove scope_def.Desugared.Ast.scope_def_io.io_input
                    with
-                  | Desugared.Ast.NoInput -> true
+                  | NoInput -> true
                   | _ -> false)
                  && RuleName.Map.is_empty scope_def.scope_def_rules))
         scope.scope_defs
@@ -647,7 +647,7 @@ let translate_rule
             (match
                Mark.remove scope_def.Desugared.Ast.scope_def_io.io_input
              with
-            | Desugared.Ast.NoInput -> assert false (* error already raised *)
+            | NoInput -> assert false (* error already raised *)
             | OnlyInput when RuleName.Map.is_empty def && not is_cond ->
               assert false (* error already raised *)
             | _ -> ());

compiler/shared_ast/definitions.ml

@@ -156,10 +156,16 @@ type date = Runtime.date
 type date_rounding = Runtime.date_rounding
 type duration = Runtime.duration
 
+type var_def_log = {
+  log_typ : naked_typ;
+  log_io_input : Runtime.io_input;
+  log_io_output : bool;
+}
+
 type log_entry =
-  | VarDef of naked_typ
+  | VarDef of var_def_log
       (** During code generation, we need to know the type of the variable being
-          logged for embedding *)
+          logged for embedding as well as its I/O properties. *)
   | BeginCall
   | EndCall
   | PosRecordIfTrueBool