Progress on linting, bugguy unused field detection

compiler/desugared/ast.ml

@@ -247,3 +247,28 @@ let free_variables (def : rule RuleName.Map.t) : Pos.t ScopeDefMap.t =
       in
       add_locs acc locs)
     def ScopeDefMap.empty
+
+let fold_exprs ~(f : 'a -> expr -> 'a) ~(init : 'a) (p : program) : 'a =
+  let acc =
+    ScopeName.Map.fold
+      (fun _ scope acc ->
+        let acc =
+          ScopeDefMap.fold
+            (fun _ scope_def acc ->
+              RuleName.Map.fold
+                (fun _ rule acc ->
+                  f
+                    (f acc (Expr.unbox rule.rule_just))
+                    (Expr.unbox rule.rule_cons))
+                scope_def.scope_def_rules acc)
+            scope.scope_defs acc
+        in
+        let acc =
+          List.fold_left
+            (fun acc assertion -> f acc (Expr.unbox assertion))
+            acc scope.scope_assertions
+        in
+        acc)
+      p.program_scopes init
+  in
+  TopdefName.Map.fold (fun _ (e, _) acc -> f acc e) p.program_topdefs acc

compiler/desugared/ast.mli

@@ -134,3 +134,9 @@ type program = {
 
 val locations_used : expr -> LocationSet.t
 val free_variables : rule RuleName.Map.t -> Pos.t ScopeDefMap.t
+
+val fold_exprs : f:('a -> expr -> 'a) -> init:'a -> program -> 'a
+(** Usage: [fold_exprs ~f ~init program] applies ~f to all the expressions
+    inside rules (justifications and consequences), expressions and top-level
+    definitions of the program. Note that there may be free variables in these
+    expressions. *)

compiler/desugared/linting.ml

@@ -19,31 +19,92 @@ open Ast
 open Catala_utils
 
 (** If the variable is not an input, then it should be defined somewhere. *)
-let detect_empty_definitions
-    (scope : ScopeName.t)
-    (def_info : ScopeDef.t)
-    (def : scope_def) : unit =
-  if
-    RuleName.Map.is_empty def.scope_def_rules
-    && (not def.scope_def_is_condition)
-    &&
-    match Marked.unmark def.scope_def_io.io_input with
-    | Ast.NoInput -> true
-    | _ -> false
-  then
-    Errors.format_spanned_warning
-      (ScopeDef.get_position def_info)
-      "The variable %a is declared but never defined in scope %a"
-      (Cli.format_with_style [ANSITerminal.yellow])
-      (Format.asprintf "\"%a\"" Ast.ScopeDef.format_t def_info)
-      (Cli.format_with_style [ANSITerminal.yellow])
-      (Format.asprintf "\"%a\"" ScopeName.format_t scope)
-
-let lint_program (p : program) : unit =
+let detect_empty_definitions (p : program) : unit =
   ScopeName.Map.iter
-    (fun scope_name scope ->
+    (fun (scope_name : ScopeName.t) scope ->
       ScopeDefMap.iter
         (fun scope_def_key scope_def ->
-          detect_empty_definitions scope_name scope_def_key scope_def)
+          if
+            (match scope_def_key with ScopeDef.Var _ -> true | _ -> false)
+            && RuleName.Map.is_empty scope_def.scope_def_rules
+            && (not scope_def.scope_def_is_condition)
+            &&
+            match Marked.unmark scope_def.scope_def_io.io_input with
+            | Ast.NoInput -> true
+            | _ -> false
+          then
+            Errors.format_spanned_warning
+              (ScopeDef.get_position scope_def_key)
+              "The variable %a is declared but never defined in scope %a; did \
+               you forget something?"
+              (Cli.format_with_style [ANSITerminal.yellow])
+              (Format.asprintf "\"%a\"" Ast.ScopeDef.format_t scope_def_key)
+              (Cli.format_with_style [ANSITerminal.yellow])
+              (Format.asprintf "\"%a\"" ScopeName.format_t scope_name))
         scope.scope_defs)
     p.program_scopes
+
+let detect_unused_struct_fields (p : program) : unit =
+  let struct_fields_used =
+    Ast.fold_exprs
+      ~f:(fun struct_fields_used e ->
+        let rec structs_fields_used_expr e struct_fields_used =
+          match Marked.unmark e with
+          | EDStructAccess { name_opt = Some name; e = e_struct; field } ->
+            let field =
+              try
+                StructName.Map.find name
+                  (IdentName.Map.find field p.program_ctx.ctx_struct_fields)
+              with Not_found ->
+                (* Should not happen after disambiguation *)
+                Errors.raise_spanned_error
+                  (Expr.mark_pos (Marked.get_mark e))
+                  "Field %a does not belong to structure %a"
+                  (Cli.format_with_style [ANSITerminal.yellow])
+                  field
+                  (Cli.format_with_style [ANSITerminal.yellow])
+                  (Format.asprintf "\"%a\"" StructName.format_t name)
+            in
+            StructField.Set.add field
+              (structs_fields_used_expr e_struct struct_fields_used)
+          | EStruct { name = _; fields } ->
+            StructField.Map.fold
+              (fun field e_field struct_fields_used ->
+                StructField.Set.add field
+                  (structs_fields_used_expr e_field struct_fields_used))
+              fields struct_fields_used
+          | _ ->
+            Expr.shallow_fold structs_fields_used_expr e StructField.Set.empty
+        in
+        structs_fields_used_expr e struct_fields_used)
+      ~init:StructField.Set.empty p
+  in
+  let scope_out_structs_fields =
+    ScopeName.Map.fold
+      (fun _ out_struct acc ->
+        ScopeVar.Map.fold
+          (fun _ field acc -> StructField.Set.add field acc)
+          out_struct.out_struct_fields acc)
+      p.program_ctx.ctx_scopes StructField.Set.empty
+  in
+  StructName.Map.iter
+    (fun s_name fields ->
+      StructField.Map.iter
+        (fun field _ ->
+          if
+            (not (StructField.Set.mem field struct_fields_used))
+            && not (StructField.Set.mem field scope_out_structs_fields)
+          then
+            Errors.format_spanned_warning
+              (snd (StructField.get_info field))
+              "The field %a of struct %a is never used; maybe it's unnecessary?"
+              (Cli.format_with_style [ANSITerminal.yellow])
+              (Format.asprintf "\"%a\"" StructField.format_t field)
+              (Cli.format_with_style [ANSITerminal.yellow])
+              (Format.asprintf "\"%a\"" StructName.format_t s_name))
+        fields)
+    p.program_ctx.ctx_structs
+
+let lint_program (p : program) : unit =
+  detect_empty_definitions p;
+  detect_unused_struct_fields p

compiler/shared_ast/program.ml

@@ -22,6 +22,12 @@ let map_exprs ~f ~varf { code_items; decl_ctx } =
     (fun code_items -> { code_items; decl_ctx })
     (Scope.map_exprs ~f ~varf code_items)
 
+let fold_left_exprs ~f ~init { code_items; decl_ctx = _ } =
+  Scope.fold_left ~f:(fun acc e _ -> f acc e) ~init code_items
+
+let fold_right_exprs ~f ~init { code_items; decl_ctx = _ } =
+  Scope.fold_right ~f:(fun e _ acc -> f e acc) ~init code_items
+
 let get_scope_body { code_items; _ } scope =
   match
     Scope.fold_left ~init:None

compiler/shared_ast/program.mli

@@ -25,6 +25,12 @@ val map_exprs :
   'expr1 program ->
   'expr2 program Bindlib.box
 
+val fold_left_exprs :
+  f:('a -> 'expr code_item -> 'a) -> init:'a -> 'expr program -> 'a
+
+val fold_right_exprs :
+  f:('expr code_item -> 'a -> 'a) -> init:'a -> 'expr program -> 'a
+
 val get_scope_body :
   ((_ any, 't) gexpr as 'e) program -> ScopeName.t -> 'e scope_body