add target IR validation for representation arity

test/invariants.ml

@@ -3,6 +3,16 @@ open Vanity
 let assert_true msg b =
   if not b then failwith msg
 
+let assert_target_valid msg term =
+  match Target.validate term with
+  | Ok () -> ()
+  | Error errors -> failwith (msg ^ ": " ^ String.concat "; " errors)
+
+let assert_target_invalid msg term =
+  match Target.validate term with
+  | Ok () -> failwith msg
+  | Error _ -> ()
+
 let find_case name =
   match List.find_opt (fun (case : Corpus.case) -> String.equal case.name name) Corpus.all with
   | Some case -> case
@@ -13,7 +23,11 @@ let () =
     (fun (case : Corpus.case) ->
       assert_true
         ("ill-typed corpus case " ^ case.name)
-        (Typecheck.is_well_typed case.ty case.source))
+        (Typecheck.is_well_typed case.ty case.source);
+      let compiled = Pipeline.compile case.flags case.ty case.source in
+      assert_target_valid
+        ("invalid target IR for corpus case " ^ case.name)
+        compiled.target_program)
     Corpus.all;
   let repr = Audit.audit_case (find_case "free-theorem-fails-after-unsafe-inlining") in
   assert_true
@@ -29,4 +43,20 @@ let () =
       assert_true
         ("ill-typed generated specimen " ^ Source.string_of_term specimen.Gen.term)
         (Typecheck.is_well_typed specimen.Gen.ty specimen.Gen.term))
-    generated
+    generated;
+  assert_target_invalid
+    "expected tuple projection arity validation failure"
+    (Target.Proj (2, Target.Tuple [Target.Int 1; Target.Bool true]));
+  assert_target_invalid
+    "expected worker-wrapper arity validation failure"
+    (Target.WorkerWrapper
+       {
+         wrapper = "wrapper";
+         worker = "worker";
+         boxed_arg = Types.TPair (Types.TInt, Types.TBool);
+         unboxed_args = [Target.RInt];
+         result_repr = Target.RTuple [Target.RInt; Target.RBool];
+         wrap_body = Target.Tuple [Target.Int 0; Target.Bool true];
+         worker_body = Target.Tuple [Target.Var "u0"; Target.Bool true];
+         in_term = Target.Var "wrapper";
+       })