Add an explain plugin

Based on the lazy_interp plugin, this new plugin generates a `dot` graph
retracing a given computation from source definitions to the results.

compiler/catala_utils/mark.ml

@@ -20,7 +20,8 @@ type 'a pos = ('a, Pos.t) ed
 
 let add m e = e, m
 let remove (x, _) = x
-let get (_, x) = x
+let get (_, m) = m
+let set m (x, _) = x, m
 let map f (x, m) = f x, m
 let map_mark f (a, m) = a, f m
 let copy (_, m) x = x, m

compiler/catala_utils/mark.mli

@@ -28,6 +28,7 @@ type 'a pos = ('a, Pos.t) ed
 val add : 'm -> 'a -> ('a, 'm) ed
 val remove : ('a, 'm) ed -> 'a
 val get : ('a, 'm) ed -> 'm
+val set : 'm -> ('a, _) ed -> ('a, 'm) ed
 val map : ('a -> 'b) -> ('a, 'm) ed -> ('b, 'm) ed
 val map_mark : ('m1 -> 'm2) -> ('a, 'm1) ed -> ('a, 'm2) ed
 val copy : ('b, 'm) ed -> 'a -> ('a, 'm) ed

compiler/dune

@@ -46,11 +46,12 @@
  (modes native js)
  (flags
   (:standard
-   (:include custom_linking.sexp)))
+   (:include custom_linking.sexp)
+   -linkall))
  (package catala)
  (modules catala)
  (public_name catala)
- (libraries catala.driver))
+ (libraries catala.driver ocamlgraph))
 
 (documentation
  (package catala)

compiler/plugins/dune

@@ -26,7 +26,17 @@
  (synopsis
   "Catala plugin that implements a different, experimental interpreter, featuring lazy and partial evaluation")
  (modules lazy_interp)
- (libraries shared_ast catala.driver))
+ (flags (-linkall))
+ (libraries shared_ast catala.driver ocamlgraph))
+
+(library
+ (name explain)
+ (public_name catala.plugins.explain)
+ (synopsis
+  "Experiments for the explanation of computations: generates a graph of the formulas that are used for a given execution of a scope")
+ (modules explain)
+ (flags (-linkall))
+ (libraries shared_ast catala.driver ocamlgraph))
 
 (library
  (name modules)

compiler/shared_ast/interpreter.ml

@@ -176,8 +176,11 @@ let rec evaluate_operator
                    (Print.expr ()) arg),
               Expr.pos arg ))
           args)
-      "Operator applied to the wrong arguments\n\
-       (should not happen if the term was well-typed)"
+      "Operator %a applied to the wrong arguments\n\
+       (should not happen if the term was well-typed)%a"
+      (Print.operator ~debug:true)
+      op Expr.format
+      (EApp { f = EOp { op; tys = [] }, m; args }, m)
   in
   propagate_empty_error_list args
   @@ fun args ->

compiler/shared_ast/print.ml

@@ -502,7 +502,7 @@ let rec expr_aux :
       (pp_color_string (List.hd colors))
       ")"
   | EArray es ->
-    Format.fprintf fmt "@[<hv 2>%a %a@] %a" punctuation "["
+    Format.fprintf fmt "@[<hov 2>%a %a@] %a" punctuation "["
       (Format.pp_print_list
          ~pp_sep:(fun fmt () -> Format.fprintf fmt ";@ ")
          (fun fmt e -> lhs exprc fmt e))

compiler/shared_ast/var.ml

@@ -26,7 +26,8 @@ type 'e vars = ('a, 't) naked_gexpr Bindlib.mvar constraint 'e = ('a, 't) gexpr
 
 let make (name : string) : 'e t = Bindlib.new_var (fun x -> EVar x) name
 let compare = Bindlib.compare_vars
-let eq = Bindlib.eq_vars
+let equal = Bindlib.eq_vars
+let hash = Bindlib.hash_var
 
 let translate (v : 'e1 t) : 'e2 t =
   Bindlib.copy_var v (fun x -> EVar x) (Bindlib.name_of v)
@@ -76,6 +77,7 @@ module Set = struct
   let of_list l = of_list (List.map t l)
   let elements s = elements s |> List.map get
   let diff s1 s2 = diff s1 s2
+  let iter f s = iter (fun x -> f (get x)) s
 
   (* Add more as needed *)
 end

compiler/shared_ast/var.mli

@@ -26,7 +26,8 @@ type 'e vars = ('a, 't) naked_gexpr Bindlib.mvar constraint 'e = ('a, 't) gexpr
 
 val make : string -> 'e t
 val compare : 'e t -> 'e t -> int
-val eq : 'e t -> 'e t -> bool
+val equal : 'e t -> 'e t -> bool
+val hash : 'e t -> int
 
 val translate : 'e1 t -> 'e2 t
 (** Needed when converting from one AST type to another. See the note of caution
@@ -49,6 +50,7 @@ module Set : sig
   val of_list : 'e var list -> 'e t
   val elements : 'e t -> 'e var list
   val diff : 'e t -> 'e t -> 'e t
+  val iter : ('e var -> unit) -> 'e t -> unit
 end
 
 (** Wrapper over [Map.S] but with a type variable for the AST type parameters.

compiler/verification/conditions.ml

@@ -122,7 +122,7 @@ let match_and_ignore_outer_reentrant_default (ctx : ctx) (e : typed expr) :
             cons;
           },
         _ )
-    when List.exists (fun x' -> Var.eq x x') ctx.input_vars ->
+    when List.exists (fun x' -> Var.equal x x') ctx.input_vars ->
     (* scope variables*)
     cons
   | EAbs { binder; tys = [(TLit TUnit, _)] } ->