diff --git a/compiler/desugared/ast.ml b/compiler/desugared/ast.ml index a46f5a1a..5c5ae88d 100644 --- a/compiler/desugared/ast.ml +++ b/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 diff --git a/compiler/desugared/ast.mli b/compiler/desugared/ast.mli index 224b8cd2..0357a6d4 100644 --- a/compiler/desugared/ast.mli +++ b/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. *) diff --git a/compiler/desugared/linting.ml b/compiler/desugared/linting.ml index 748367a2..58d7343c 100644 --- a/compiler/desugared/linting.ml +++ b/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 diff --git a/compiler/shared_ast/program.ml b/compiler/shared_ast/program.ml index 76ac24fd..f43c2c05 100644 --- a/compiler/shared_ast/program.ml +++ b/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 diff --git a/compiler/shared_ast/program.mli b/compiler/shared_ast/program.mli index 2c23c4a8..b5656854 100644 --- a/compiler/shared_ast/program.mli +++ b/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