more union workarounds in welltyped.ml

Author: cp526

lib/coreTypeChecks.ml

@@ -41,7 +41,13 @@ let check_against_core_bt core_bt cn_bt =
       let@ () = check_object_type (OTy_integer, param_t) in
       check_object_type (t, t2)
     | OTy_struct tag, BT.Struct tag2 when Sym.equal tag tag2 -> return ()
-    | OTy_union _tag, _ -> fail (Pp.string "unsupported: union types")
+    | (OTy_union _tag as core_obj_ty), bt ->
+      if !Sym.executable_spec_enabled then (
+        match bt with
+        | Map (_, Option MemByte) -> return ()
+        | _ -> mismatch (BTy_object core_obj_ty) bt)
+      else
+        fail (Pp.string "unsupported: union types")
     | OTy_floating, _ -> fail (Pp.string "unsupported: floats")
     | core_obj_ty, bt -> mismatch (BTy_object core_obj_ty) bt
   in

lib/wellTyped.ml

@@ -1735,8 +1735,17 @@ module BaseTyping = struct
         | PEapply_fun (fname, pes) ->
           let@ bt, pes = check_infer_apply_fun None fname pes pe in
           return (bt, PEapply_fun (fname, pes))
-        | PEconstrained _
-        | PEunion (_, _, _)
+        | PEconstrained _ -> todo ()
+        | PEunion (tag, member, pe) ->
+          if !Sym.executable_spec_enabled then (
+            (* todo: make this proper when CN actually supports unions *)
+            let ct = Option.get (Sctypes.of_ctype (CF.Ctype.Ctype ([], Union tag))) in
+            let@ () = WCT.is_ct loc ct in
+            let@ pe = infer_pexpr pe in
+            return (Memory.bt_of_sct ct, PEunion (tag, member, pe)))
+          else
+            fail
+              { loc; msg = Generic !^"unsupported: union types" } [@alert "-deprecated"]
         | PEmemberof (_, _, _)
         | PEconv_int (_, _)
         | PEconv_loaded_int (_, _)