typer: checks for constructor redundancy

src/bin/expect_tests/contract_tests.ml

@@ -1130,4 +1130,18 @@ let%expect_test _ =
 let%expect_test _ =
   run_ligo_good [ "dry-run" ; contract "super-counter.mligo" ; "main" ; "test_param" ; "test_storage" ] ;
   [%expect {|
-    ( list[] , 3 ) |}]
+    ( list[] , 3 ) |}]
+
+let%expect_test _ =
+  run_ligo_bad [ "compile-contract" ; bad_contract "redundant_constructors.mligo" ; "main" ] ;
+  [%expect {|
+    ligo: redundant constructor:  {"constructor":"Add","environment":"- E[]\tT[union_a -> sum[Add -> int , Remove -> int]] ]"}
+
+
+     If you're not sure how to fix this error, you can
+     do one of the following:
+
+    * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
+    * Ask a question on our Discord: https://discord.gg/9rhYaEt
+    * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
+    * Check the changelog by running 'ligo changelog' |}]

src/passes/4-typer-old/typer.ml

@@ -80,6 +80,15 @@ module Errors = struct
     ] in
     error ~data title message ()
 
+  let redundant_constructor (e:environment) (c:I.constructor') () =
+    let title = (thunk "redundant constructor") in
+    let message () = "" in
+    let data = [
+      ("constructor" , fun () -> Format.asprintf "%a" I.PP.constructor c);
+      ("environment" , fun () -> Format.asprintf "%a" Environment.PP.full_environment e) ;
+    ] in
+    error ~data title message ()
+
   let wrong_arity (n:string) (expected:int) (actual:int) (loc : Location.t) () =
     let title () = "wrong arity" in
     let message () = "" in
@@ -321,6 +330,9 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
       let aux k v prev =
         let%bind prev' = prev in
         let%bind v' = evaluate_type e v in
+        let%bind () = match Environment.get_constructor k e with
+          | Some _ -> fail (redundant_constructor e k)
+          | None -> ok () in
         ok @@ I.CMap.add k v' prev'
       in
       let%bind m = I.CMap.fold aux m (ok I.CMap.empty) in

src/test/contracts/negative/redundant_constructors.mligo

@@ -0,0 +1,20 @@
+type union_a =
+| Add of int
+| Remove of int
+
+(* comment this type out to successfully compile the contract *)
+type union_b =
+| Add of nat
+| Remove of nat
+| Config of nat
+
+
+let foo (a : union_a) =
+  match a with
+  |Add a -> unit
+  |Remove b -> unit
+
+
+let main(p, s : union_a * unit) : (operation list) * unit =
+  let ss = foo p in 
+  ([]: operation list), ss