Merge pull request #515 from hacspec/make-warning-7-an-error

refactor(engine): enable OCaml warning `7`
hacspec · Feb 19, 2024 · 37ca073 · 37ca073
2 parents f7c2d5a + d20ac7e
commit 37ca073
Show file tree

Hide file tree

Showing 6 changed files with 41 additions and 38 deletions.
diff --git a/engine/lib/analyses/mutable_variables.ml b/engine/lib/analyses/mutable_variables.ml
@@ -99,18 +99,21 @@ module%inlined_contents Make (F : Features.T) = struct
            (*           ~f:(fst >> super#visit_pat env))) *)
            (*     (Option.value_map (Map.find env var) ~default:m#zero ~f:(fun x -> (Set.of_list (module W) x, Map.empty (module LocalIdent)))) *)
 
-           method visit_Let env _monadic pat expr body =
-             let new_set, new_env = super#visit_expr env expr in
-             m#plus
-               (super#visit_expr
-                  (m#snd#plus (m#snd#plus env new_env)
-                     (Map.of_alist_exn
-                        (module Local_ident)
-                        (List.map
-                           ~f:(fun v -> (v, Set.to_list new_set))
-                           (Set.to_list (U.Reducers.variables_of_pat pat)))))
-                  body)
-               (new_set, m#snd#zero)
+           method! visit_expr' env e =
+             match e with
+             | Let { lhs = pat; rhs = expr; body; _ } ->
+                 let new_set, new_env = super#visit_expr env expr in
+                 m#plus
+                   (super#visit_expr
+                      (m#snd#plus (m#snd#plus env new_env)
+                         (Map.of_alist_exn
+                            (module Local_ident)
+                            (List.map
+                               ~f:(fun v -> (v, Set.to_list new_set))
+                               (Set.to_list (U.Reducers.variables_of_pat pat)))))
+                      body)
+                   (new_set, m#snd#zero)
+             | _ -> super#visit_expr' env e
 
            method! visit_local_ident (env : W.t list Map.M(Local_ident).t) ident
                =

diff --git a/engine/lib/ast_utils.ml b/engine/lib/ast_utils.ml
@@ -156,7 +156,7 @@ module Make (F : Features.T) = struct
     let regenerate_span_ids =
       object
         inherit [_] Visitors.map
-        method visit_span () = Span.refresh_id
+        method! visit_span () = Span.refresh_id
       end
 
     let normalize_borrow_mut =
@@ -344,10 +344,10 @@ module Make (F : Features.T) = struct
           inherit [_] Visitors.reduce as super
           inherit [_] Sets.Local_ident.monoid as _m
 
-          method visit_arm' env { arm_pat; body } =
+          method! visit_arm' env { arm_pat; body } =
             shadows ~env [ arm_pat ] body super#visit_expr
 
-          method visit_expr' env e =
+          method! visit_expr' env e =
             match e with
             | Let { monadic = _; lhs; rhs; body } ->
                 super#visit_expr env rhs
@@ -378,12 +378,12 @@ module Make (F : Features.T) = struct
                 shadows ~env params body super#visit_expr
             | _ -> super#visit_expr' env e
 
-          method visit_impl_item' env ii =
+          method! visit_impl_item' env ii =
             match ii with
             | IIFn { body; params } -> self#visit_function_like env body params
             | _ -> super#visit_impl_item' env ii
 
-          method visit_item' env i =
+          method! visit_item' env i =
             match i with
             | Fn { body; params; _ } -> self#visit_function_like env body params
             | _ -> super#visit_item' env i
@@ -392,7 +392,7 @@ module Make (F : Features.T) = struct
             let f p = p.pat in
             shadows ~env (List.map ~f params) body super#visit_expr
 
-          method visit_local_ident env id =
+          method! visit_local_ident env id =
             Set.(if id_shadows ~env id then Fn.flip singleton id else empty)
               (module Local_ident)
         end
@@ -490,7 +490,7 @@ module Make (F : Features.T) = struct
 
         (* TODO: loop state *)
 
-        method visit_expr' () e =
+        method! visit_expr' () e =
           match e with
           | Assign { lhs; e; _ } ->
               let rec visit_lhs lhs =
@@ -531,7 +531,7 @@ module Make (F : Features.T) = struct
                    (without_vars (self#visit_expr () body) vars))
           | _ -> super#visit_expr' () e
 
-        method visit_arm' () { arm_pat; body } =
+        method! visit_arm' () { arm_pat; body } =
           without_pat_vars (self#visit_expr () body) arm_pat
       end
 

diff --git a/engine/lib/dune b/engine/lib/dune
@@ -71,4 +71,4 @@
 (env
  (_
   (flags
-   (:standard -g -warn-error "+A" -w "-17-7-30-56-32"))))
+   (:standard -g -warn-error "+A" -w "-17-30-56-32"))))
diff --git a/engine/lib/generic_printer/generic_printer.ml b/engine/lib/generic_printer/generic_printer.ml
@@ -117,7 +117,7 @@ module Make (F : Features.T) (View : Concrete_ident.VIEW_API) = struct
             separate_map (comma ^^ break 1) (print#ty_at Ty_Tuple)
             >> iblock parens
 
-        method ty : par_state -> ty fn =
+        method! ty : par_state -> ty fn =
           fun ctx ty ->
             match ty with
             | TBool -> string "bool"
@@ -144,7 +144,7 @@ module Make (F : Features.T) (View : Concrete_ident.VIEW_API) = struct
             | TOpaque _ -> string "opaque_type!()"
             | TApp _ -> super#ty ctx ty
 
-        method expr' : par_state -> expr' fn =
+        method! expr' : par_state -> expr' fn =
           fun ctx e ->
             let wrap_parens =
               group
@@ -321,7 +321,7 @@ module Make (F : Features.T) (View : Concrete_ident.VIEW_API) = struct
 
         method attr : attr fn = fun _ -> empty
 
-        method pat' : par_state -> pat' fn =
+        method! pat' : par_state -> pat' fn =
           fun ctx ->
             let wrap_parens =
               group

diff --git a/engine/lib/phase_utils.ml b/engine/lib/phase_utils.ml
@@ -155,9 +155,7 @@ end = struct
              let regenerate_span_ids =
                (object
                   inherit [_] Visitors.map
-                  method visit_t () x = x
-                  method visit_mutability _ () m = m
-                  method visit_span = Fn.const Span.refresh_id
+                  method! visit_span = Fn.const Span.refresh_id
                end)
                  #visit_item
                  ()

diff --git a/engine/lib/phases/phase_and_mut_defsite.ml b/engine/lib/phases/phase_and_mut_defsite.ml
@@ -97,10 +97,12 @@ struct
       let map_returns ~(f : expr -> expr) : expr -> expr =
         let visitor =
           object
-            inherit [_] Visitors.map as _super
-            method visit_t () x = x
-            method visit_mutability _ () m = m
-            method visit_Return () e witness = Return { e = f e; witness }
+            inherit [_] Visitors.map as super
+
+            method! visit_expr' () e =
+              match e with
+              | Return { e; witness } -> Return { e = f e; witness }
+              | _ -> super#visit_expr' () e
           end
         in
         visitor#visit_expr ()
@@ -146,7 +148,7 @@ struct
           object
             inherit [_] Visitors.map as super
 
-            method visit_expr () e =
+            method! visit_expr () e =
               (let* e = Expect.deref e in
                retyped_local_var_in_vars e)
               <|?> (fun _ -> retyped_local_var_in_vars e)
@@ -183,13 +185,13 @@ struct
           object
             inherit [_] Visitors.map as super
 
-            method visit_expr () e =
+            method! visit_expr () e =
               try super#visit_expr () e
               with Diagnostics.SpanFreeError.Exn (Data (context, kind)) ->
                 UB.hax_failure_expr e.span e.typ (context, kind)
                   (UB.LiftToFullAst.expr e)
 
-            method visit_expr' () e =
+            method! visit_expr' () e =
               match e with
               | Assign { lhs; e; witness } ->
                   let span = e.span in
@@ -243,7 +245,7 @@ struct
         object
           inherit [_] BVisitors.map as super
 
-          method visit_impl_item' () item' =
+          method! visit_impl_item' () item' =
             (match item' with
             | IIFn { params; body } ->
                 let* params, body = rewrite_function params body in
@@ -252,7 +254,7 @@ struct
             |> Option.value_or_thunk
                  ~default:(Fn.flip super#visit_impl_item' item')
 
-          method visit_trait_item () item =
+          method! visit_trait_item () item =
             let span = item.ti_span in
             let ti_v =
               (match item.ti_v with
@@ -290,7 +292,7 @@ struct
             in
             { item with ti_v }
 
-          method visit_item () i =
+          method! visit_item () i =
             try super#visit_item () i
             with Diagnostics.SpanFreeError.Exn (Data (context, kind)) ->
               let error = Diagnostics.pretty_print_context_kind context kind in
@@ -301,7 +303,7 @@ struct
               in
               B.make_hax_error_item i.span i.ident msg
 
-          method visit_item' () item' =
+          method! visit_item' () item' =
             (match item' with
             | Fn { name; generics; body; params } ->
                 let* params, body = rewrite_function params body in