Merge pull request #1568 from stan-dev/feat/pedantic-warnings-filename

Include locations in all pedantic warnings

Author: WardBrian

src/analysis_and_optimization/Dataflow_utils.ml

@@ -24,13 +24,6 @@ let merge_set_maps m1 m2 =
     | `Both (e1, e2) -> Some (Set.union e1 e2) in
   Map.Poly.merge ~f:merge_map_elems m1 m2
 
-(**
-   Generate a Map by applying a function to each element of a key set.
-*)
-let generate_map s ~f =
-  Set.fold s ~init:Map.Poly.empty ~f:(fun m e ->
-      Map.Poly.add_exn m ~key:e ~data:(f e))
-
 (**
    Like a forward traversal, but branches accumulate two different states that are
    recombined with join.

src/analysis_and_optimization/Dataflow_utils.mli

@@ -69,11 +69,6 @@ val merge_set_maps :
    Merge two maps whose values are sets, and union the sets when there's a collision.
 *)
 
-val generate_map : 'a Set.Poly.t -> f:('a -> 'b) -> ('a, 'b) Map.Poly.t
-(**
-   Generate a Map by applying a function to each element of a key set.
-*)
-
 val build_statement_map :
      ('s -> ('e, 's) Stmt.Pattern.t)
   -> ('s -> 'm)

src/analysis_and_optimization/Factor_graph.ml

@@ -161,17 +161,19 @@ let fg_var_priors (var : vexpr) (data : vexpr Set.Poly.t) (fg : factor_graph) :
   | None -> None
 
 let list_priors ?factor_graph:(fg_opt = None) (mir : Program.Typed.t) :
-    (vexpr, (factor * label) Set.Poly.t option) Map.Poly.t =
+    (vexpr, (factor * label) Set.Poly.t option * Location_span.t) Map.Poly.t =
   let fg = Option.value ~default:(prog_factor_graph mir) fg_opt in
-  let params = Set.Poly.map ~f:(fun v -> VVar v) (parameter_names_set mir) in
+  let params =
+    Set.Poly.map ~f:(fun (v, _, loc) -> (VVar v, loc)) (parameter_set mir) in
   let data = Set.Poly.map ~f:(fun v -> VVar v) (data_set mir) in
   let likely_sizes =
     Set.diff data
       (Set.Poly.map ~f:(fun v -> VVar v) (data_set ~exclude_ints:true mir))
   in
   let fg' = Set.fold ~init:fg ~f:fg_remove_var likely_sizes in
   (* for each param, apply fg_var_priors and collect results in a map*)
-  generate_map params ~f:(fun p -> fg_var_priors p data fg')
+  Set.fold params ~init:Map.Poly.empty ~f:(fun m (p, loc) ->
+      Map.Poly.add_exn m ~key:p ~data:(fg_var_priors p data fg', loc))
 
 let string_of_factor (factor : factor) : string =
   match factor with

src/analysis_and_optimization/Mir_utils.ml

@@ -91,16 +91,17 @@ let data_set ?(exclude_transformed = false) ?(exclude_ints = false)
 
 let parameter_set ?(include_transformed = false) (mir : Program.Typed.t) =
   Set.Poly.of_list
-    (List.map
-       ~f:(fun (pname, _, {out_trans; _}) -> (pname, out_trans))
-       (List.filter
-          ~f:(fun (_, _, {out_block; _}) ->
-            out_block = Parameters
-            || (include_transformed && out_block = TransformedParameters))
-          mir.output_vars))
+    (List.filter_map
+       ~f:(fun (pname, l, {out_trans; out_block; _}) ->
+         if
+           out_block = Parameters
+           || (include_transformed && out_block = TransformedParameters)
+         then Some (pname, out_trans, l)
+         else None)
+       mir.output_vars)
 
 let parameter_names_set ?(include_transformed = false) (mir : Program.Typed.t) =
-  Set.Poly.map ~f:fst (parameter_set ~include_transformed mir)
+  Set.Poly.map ~f:fst3 (parameter_set ~include_transformed mir)
 
 let rec var_declarations Stmt.{pattern; _} : string Set.Poly.t =
   match pattern with

src/analysis_and_optimization/Mir_utils.mli

@@ -22,7 +22,7 @@ val data_set :
 val parameter_set :
      ?include_transformed:bool
   -> Program.Typed.t
-  -> (string * Expr.Typed.t Transformation.t) Set.Poly.t
+  -> (string * Expr.Typed.t Transformation.t * Location_span.t) Set.Poly.t
 
 val parameter_names_set :
   ?include_transformed:bool -> Program.Typed.t -> string Set.Poly.t

src/analysis_and_optimization/Pedantic_analysis.ml

@@ -17,17 +17,23 @@ type warning_span = Location_span.t * string [@@deriving compare]
  ********************)
 
 let list_unused_params (factor_graph : factor_graph) (mir : Program.Typed.t) :
-    string Set.Poly.t =
+    (string * Location_span.t) Set.Poly.t =
   (* Build a factor graph of the program, check for missing parameters *)
-  let params = parameter_names_set ~include_transformed:false mir in
+  let param_info = parameter_set ~include_transformed:false mir in
+  let params = Set.Poly.map ~f:fst3 param_info in
   let used_params =
     Set.Poly.map
       ~f:(fun (VVar v) -> v)
       (Set.Poly.of_list (Map.Poly.keys factor_graph.var_map)) in
-  Set.diff params used_params
+  let unused = Set.diff params used_params in
+  Set.Poly.filter_map
+    ~f:(fun (pname, _, loc) ->
+      if Set.mem unused pname then Some (pname, loc) else None)
+    param_info
 
 let list_hard_constrained (mir : Program.Typed.t) :
-    (string * [`HardConstraint | `NonsenseConstraint]) Set.Poly.t =
+    (string * [`HardConstraint | `NonsenseConstraint] * Location_span.t)
+    Set.Poly.t =
   (* Iterate through all parameters' transformations for hard constraints *)
   let constrained (e : bound_values) =
     match e with
@@ -37,9 +43,9 @@ let list_hard_constrained (mir : Program.Typed.t) :
     | {lower= `Lit _; upper= `Lit _} -> Some `HardConstraint
     | _ -> None in
   Set.Poly.filter_map
-    ~f:(fun (name, trans) ->
+    ~f:(fun (name, trans, loc) ->
       Option.map
-        ~f:(fun c -> (name, c))
+        ~f:(fun c -> (name, c, loc))
         (constrained (trans_bounds_values trans)))
     (parameter_set mir)
 
@@ -261,30 +267,31 @@ let list_param_dependant_fundefs_cf (mir : Program.Typed.t) :
           (fun_def.fdname, cf_loc, deps, arg_name, arg_loc)))
 
 let list_non_one_priors (fg : factor_graph) (mir : Program.Typed.t) :
-    (string * int) Set.Poly.t =
+    (string * int * Location_span.t) Set.Poly.t =
   (* Use the factor graph definition of priors, which treats a neighboring
      factor as a prior for parameter P if it has no connection to the data
      except through P *)
   let priors = list_priors ~factor_graph:(Some fg) mir in
   let prior_set =
     Map.Poly.fold priors ~init:Set.Poly.empty
-      ~f:(fun ~key:(VVar v) ~data:factors_opt s ->
+      ~f:(fun ~key:(VVar v) ~data:(factors_opt, loc) s ->
         Option.value_map factors_opt ~default:s ~f:(fun factors ->
-            Set.add s (v, Set.length factors))) in
+            Set.add s (v, Set.length factors, loc))) in
   (* Return only multi-prior parameters *)
-  Set.filter prior_set ~f:(fun (_, n) -> n <> 1)
+  Set.filter prior_set ~f:(fun (_, n, _) -> n <> 1)
 
 (* Collect useful information about an expression that's available at
    compile-time into a convenient form. *)
 let compiletime_value_of_expr
-    (params : (string * Expr.Typed.t Transformation.t) Set.Poly.t)
+    (params :
+      (string * Expr.Typed.t Transformation.t * Location_span.t) Set.Poly.t)
     (data : string Set.Poly.t) (expr : Expr.Typed.t) :
     compiletime_val * Expr.Typed.Meta.t =
   let v =
     match expr with
     | {pattern= Var pname; _} -> (
-        match Set.find params ~f:(fun (name, _) -> name = pname) with
-        | Some (name, trans) -> Param (name, trans)
+        match Set.find params ~f:(fun (name, _, _) -> name = pname) with
+        | Some (name, trans, _) -> Param (name, trans)
         | None -> (
             match Set.find data ~f:(fun name -> name = pname) with
             | Some name -> Data name
@@ -372,11 +379,10 @@ let hard_constrained_message (pname : string) : string =
 let hard_constrained_warnings (mir : Program.Typed.t) =
   let pnames = list_hard_constrained mir in
   Set.Poly.map
-    ~f:(fun (pname, c) ->
+    ~f:(fun (pname, c, loc) ->
       match c with
-      | `HardConstraint -> (Location_span.empty, hard_constrained_message pname)
-      | `NonsenseConstraint ->
-          (Location_span.empty, nonsense_constrained_message pname))
+      | `HardConstraint -> (loc, hard_constrained_message pname)
+      | `NonsenseConstraint -> (loc, nonsense_constrained_message pname))
     pnames
 
 let maybe_jacobian_adjustment_warnings (mir : Program.Typed.t) =
@@ -440,7 +446,7 @@ let unused_params_message (pname : string) : string =
 let unused_params_warnings (factor_graph : factor_graph) (mir : Program.Typed.t)
     =
   Set.Poly.map
-    ~f:(fun pname -> (Location_span.empty, unused_params_message pname))
+    ~f:(fun (pname, loc) -> (loc, unused_params_message pname))
     (list_unused_params factor_graph mir)
 
 let non_one_priors_message (pname : string) (n : int) : string =
@@ -455,7 +461,7 @@ let non_one_priors_message (pname : string) (n : int) : string =
 let non_one_priors_warnings (factor_graph : factor_graph)
     (mir : Program.Typed.t) =
   Set.Poly.map
-    ~f:(fun (pname, n) -> (Location_span.empty, non_one_priors_message pname n))
+    ~f:(fun (pname, n, loc) -> (loc, non_one_priors_message pname n))
     (list_non_one_priors factor_graph mir)
 
 let uninitialized_message (vname : string) : string =
@@ -500,4 +506,4 @@ let warn_pedantic (mir_unopt : Program.Typed.t) =
     ; param_dependant_cf_warnings mir; param_dependant_fundef_cf_warnings mir
     ; non_one_priors_warnings factor_graph mir
     ; distribution_warnings distributions_info ]
-  |> to_list
+  |> to_list |> List.rev

src/middle/Location.ml

@@ -36,7 +36,7 @@ let pp_context_for ppf (({line_num; _} as loc), lines) =
   pp_line_and_number ppf (line_num + 2);
   bars ppf ()
 
-let empty = {filename= ""; line_num= 0; col_num= 0; included_from= None}
+let empty = {filename= ""; line_num= -1; col_num= -1; included_from= None}
 
 (**
 Format the location for error messaging.
@@ -48,8 +48,7 @@ let rec pp ?(print_file = true) ?(print_line = true) printed_filename ppf loc =
   let incl, filename =
     match loc.included_from with
     | Some loc2 ->
-        ( (fun ppf ->
-            Fmt.pf ppf ", included from\n%a" (pp printed_filename) loc2)
+        ( Format.dprintf ", included from\n%a" (pp printed_filename) loc2
         , loc.filename )
     | None -> (ignore, Option.value ~default:loc.filename printed_filename)
   in