[lint] Report usages of physical equality

Signed-off-by: Kakadu <Kakadu@pm.me>

src/main.ml

@@ -26,6 +26,7 @@ let typed_linters =
     (module AmbiguousConstructors : LINT.TYPED)
   ; (module ExcTryWithWildcard : LINT.TYPED)
   ; (module Equality : LINT.TYPED)
+  ; (module Equality_phys : LINT.TYPED)
   ; (module Failwith : LINT.TYPED)
   ; (module If_bool : LINT.TYPED)
   ; (module Ignore : LINT.TYPED)

src/typed/Equality_phys.ml

@@ -0,0 +1,79 @@
+(** Copyright 2021-2023, Kakadu. *)
+
+(** SPDX-License-Identifier: LGPL-3.0-or-later *)
+
+open Base
+module Format = Stdlib.Format
+open Zanuda_core
+open Zanuda_core.Utils
+open Format
+
+type input = Tast_iterator.iterator
+
+let lint_source = LINT.Camelot
+let lint_id = "physical_equality"
+let level = LINT.Warn
+
+let documentation =
+  {|
+### What it does
+Warns about using of physical equality (of pointers) vs. structural equality (of values)
+
+### Why is is important?
+The newcomers from C++ and C# may automatically write == to test for equality, 
+and get unexpected results for complex values.
+
+If you do low level performance hacking, this lint could give false positives.
+|}
+  |> Stdlib.String.trim
+;;
+
+let describe_as_json () = describe_as_clippy_json lint_id ~docs:documentation
+
+let msg ppf () =
+  Stdlib.Format.fprintf
+    ppf
+    "Do you really need physical equality? Physical means the equality of pointers.%!"
+;;
+
+let report filename ~loc =
+  let module M = struct
+    let txt ppf () = Utils.Report.txt ~filename ~loc ppf msg ()
+
+    let rdjsonl ppf () =
+      RDJsonl.pp
+        ppf
+        ~filename:(Config.recover_filepath loc.loc_start.pos_fname)
+        ~line:loc.loc_start.pos_lnum
+        (fun _ _ -> ())
+        ()
+    ;;
+  end
+  in
+  (module M : LINT.REPORTER)
+;;
+
+let run _ fallback =
+  let pat =
+    let open Tast_pattern in
+    texp_apply2
+      (texp_ident (path [ "Stdlib!"; "==" ] ||| path [ "Stdlib"; "==" ]))
+      drop
+      drop
+  in
+  let open Tast_iterator in
+  { fallback with
+    expr =
+      (fun self expr ->
+        let loc = expr.Typedtree.exp_loc in
+        Tast_pattern.parse
+          pat
+          loc
+          ~on_error:(fun _msg () -> ())
+          expr
+          (fun _ ->
+            CollectedLints.add ~loc (report loc.Location.loc_start.Lexing.pos_fname ~loc))
+          ();
+        fallback.expr self expr)
+  }
+;;

src/typed/dune

@@ -5,20 +5,23 @@
   AmbiguousConstructors
   ExcTryWithWildcard
   Equality
+  Equality_phys
   Failwith
   Hashtables
   If_bool
   List_fusion
   List_length
   Monad_laws
+  Mutually_rec_types
+  Nested_if
   Record1
   Propose_function
   String_concat
   String_concat_fold
   Ignore
   Tuple_matching
-  Mutually_rec_types
-  Nested_if)
+  ;
+  )
  (preprocess
   (pps ppx_inline_test ppxlib.metaquot))
  (instrumentation

tests/typed/Equality.t/Equality.ml

@@ -8,3 +8,7 @@ let __ xx y (>>=) =
   (match x = Boolean true with
         | true -> y
         | false -> y)
+
+
+let suffix_is_always_false x ~suffix =
+  x == (1::suffix)

tests/typed/Equality.t/dune

@@ -2,5 +2,7 @@
  (name test_Equality)
  (wrapped false)
  (modules Equality)
+ ;  (flags
+ ;   (:standard -dtypedtree))
  (instrumentation
   (backend bisect_ppx)))

tests/typed/Equality.t/run.t

@@ -12,3 +12,7 @@
   3 | let __ x = if x = true then 3 else 3
                  ^^^^^^^^^^^^^^^^^^^^^^^^^
   Alert zanuda-linter: Using generic equality for type bool and other algebraic data types is not recommended. Use pattern matching
+  File "Equality.ml", line 14, characters 2-18:
+  14 |   x == (1::suffix)
+         ^^^^^^^^^^^^^^^^
+  Alert zanuda-linter: Do you really need physical equality? Physical means the equality of pointers.