Migrate to Primitive.t

Author: cannorin

CHANGELOG.md

@@ -11,6 +11,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Union types appearing as argument of function are now emitted in a simpler form: `` [`U1 of t1 | `U2 of t2 | .. ] [@js.union] ``.
   - Now you don't have to do `Union.inject_n` on function arguments.
   - This is a breaking change.
+- Union of primitive types are now represented as `[...] Primitive.t`.
+  - Use `Primitive.classify` function to convert it to a polymorphic variant, on which you can `match` directly.
+  - `'a or_XXX` types are removed in this change.
+  - This is a breaking change.
 
 ## [1.4.0-beta.4] - 2022-01-21
 - Ts2ocaml now emits builder function `[@js.builder]` for POJO interfaces.

docs/js_of_ocaml.md

@@ -276,7 +276,7 @@ Here we list the "safe" types, of which runtime representation is the same both
 * Primitive types in the `Ts2ocaml_min` module, such as `any`, `never`, `bigint`, or `symbol`.
 * (Non-discriminated) union and intersection types, in the form `[ ... ] Union.t` or `[ ... ] Intersection.t`.
   - These modules has `get_n'` or `inject_n'` functions, which takes the conversion function of the contained type.
-* `typeof`-able unions, in the form `[ ... ] TypeofableUnion.t`.
+* Union of primitive types, in the form `[ ... ] Primitive.t`.
   - These modules has `inject'` and `classify'`, which takes the conversion function of the `'other` type.
 * Bindings to classes and interfaces.
   - It is an alias to `Ojs.t` (or `Ts2ocaml.intf`), which means the runtime representation is
@@ -291,7 +291,7 @@ Here we list the common "unsafe" types, which can cause problem when used as typ
   - Use `Ojs.list_to_js` and `Ojs.list_of_js` to explicitly convert these values.
 * Bindings to enums.
   - Use the `t_to_js` and `t_of_js` functions in the binding module.
-* Bindings to discriminated unions, which is represented as a polymorphic variant with `[@js.union]`.
+* Bindings to discriminated unions, which is represented as a polymorphic variant with `[@js.union on_field "..."]`.
   - Use the `t_to_js` and `t_of_js` functions in the binding module.
 
 Also, with the [`--functor`](#--functor) option (which is enabled by default),

lib/Typer.fs

@@ -1336,20 +1336,29 @@ module ResolvedUnion =
       seq {
         match t with
         | Union { types = types } -> yield! Seq.collect go types
-        | Intersection { types = types } -> yield! types |> List.map (go >> Set.ofSeq) |> Set.intersectMany |> Set.toSeq
+        | Intersection { types = types } ->
+          let cases = types |> List.map (go >> Set.ofSeq) |> Set.intersectMany
+          if Set.isEmpty cases then yield Choice2Of2 t
+          else yield! cases
         | (Ident ({ loc = loc } & i) & Dummy tyargs)
         | App (AIdent i, tyargs, loc) ->
-          for x in i |> Ident.getDefinitions ctx do
-            match x with
+          let finder = function
             | Definition.TypeAlias a ->
               let bindings = Type.createBindings i.name loc a.typeParams tyargs
-              yield! go (a.target |> Type.substTypeVar bindings ())
+              go (a.target |> Type.substTypeVar bindings ())
             | Definition.Enum e ->
-              for c in e.cases do yield Choice1Of2 (Choice1Of2 (e, c))
+              e.cases |> Seq.map (fun c -> Choice1Of2 (Choice1Of2 (e, c)))
             | Definition.EnumCase (c, e) ->
-              yield Choice1Of2 (Choice1Of2 (e, c))
-            | Definition.Class _ -> yield Choice2Of2 t
-            | _ -> ()
+              Seq.singleton (Choice1Of2 (Choice1Of2 (e, c)))
+            | _ -> Seq.empty
+          let result =
+            i |> Ident.getDefinitions ctx
+              |> List.tryPick (fun d ->
+                let e = finder d
+                if Seq.isEmpty e then None else Some e)
+          match result with
+          | Some e -> yield! e
+          | None -> yield Choice2Of2 t
         | TypeLiteral l -> yield Choice1Of2 (Choice2Of2 l)
         | _ -> yield Choice2Of2 t
       }
@@ -1496,7 +1505,7 @@ module ResolvedUnion =
       ) discriminatables ([], rest)
 
     if List.length discriminatables < 2 then
-      Map.empty, { u with types = List.distinct u.types }
+      Map.empty, u
     else
       let dus =
         discriminatables
@@ -1537,15 +1546,22 @@ module ResolvedUnion =
       let caseArray =
         if List.isEmpty arrayTypes then None
         else Some (Set.ofList arrayTypes)
-      let caseEnum, rest =
+      let caseEnum, rest' =
         match rest with
         | _ :: _ :: _ -> getEnumFromUnion ctx { types = rest }
         | _ -> Set.empty, { types = rest }
-      let discriminatedUnions, rest =
-        match rest.types with
-        | _ :: _ :: _ -> getDiscriminatedFromUnion ctx rest
-        | _ -> Map.empty, rest
-      let otherTypes = Set.ofList rest.types
+      let discriminatedUnions, rest'' =
+        match rest'.types with
+        | _ :: _ :: _ -> getDiscriminatedFromUnion ctx rest'
+        | _ -> Map.empty, rest'
+      let otherTypes = Set.ofList rest''.types
+
+      if not u'.hasNull && not u'.hasUndefined && Set.isEmpty typeofableTypes && caseArray = None
+         && Set.isEmpty caseEnum && Map.isEmpty discriminatedUnions && Set.isEmpty otherTypes then
+        eprintfn "[0] %A" rest
+        eprintfn "[1] %A" rest'
+        eprintfn "[2] %A" rest''
+        failwith "error!!!!!!!!!!!!!"
 
       let result =
         { caseNull = u'.hasNull

src/Targets/JsOfOCaml/Common.fs

@@ -327,6 +327,7 @@ end
 type null = private Ojs.t
 val null_of_js: Ojs.t -> null
 val null_to_js: null -> Ojs.t
+val null: null [@@js.custom let null = Ojs.null]
 module Null : sig
   type t = null
   val t_of_js: Ojs.t -> t
@@ -339,6 +340,7 @@ end
 type undefined = private Ojs.t
 val undefined_of_js: Ojs.t -> undefined
 val undefined_to_js: undefined -> Ojs.t
+val undefined: undefined [@@js.custom let undefined = Ojs.unit_to_js ()]
 module Undefined : sig
   type t = undefined
   val t_of_js: Ojs.t -> t
@@ -522,7 +524,7 @@ val union7_of_js: (Ojs.t -> 'a) -> (Ojs.t -> 'b) -> (Ojs.t -> 'c) -> (Ojs.t -> '
 val union8_to_js: ('a -> Ojs.t) -> ('b -> Ojs.t) -> ('c -> Ojs.t) -> ('d -> Ojs.t) -> ('e -> Ojs.t) -> ('f -> Ojs.t) -> ('g -> Ojs.t) -> ('h -> Ojs.t) -> ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) union8 -> Ojs.t
 val union8_of_js: (Ojs.t -> 'a) -> (Ojs.t -> 'b) -> (Ojs.t -> 'c) -> (Ojs.t -> 'd) -> (Ojs.t -> 'e) -> (Ojs.t -> 'f) -> (Ojs.t -> 'g) -> (Ojs.t -> 'h) -> Ojs.t -> ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) union8
 
-module TypeofableUnion : sig
+module Primitive : sig
   [@@@js.stop]
   type +'cases t = private Ojs.t
   val t_to_js: ('cases -> Ojs.t) -> 'cases t -> Ojs.t
@@ -574,71 +576,11 @@ module TypeofableUnion : sig
     | "boolean" -> Obj.magic (`Boolean (Ojs.bool_of_js u))
     | "symbol" -> Obj.magic (`Symbol (symbol_of_js u))
     | "bigint" -> Obj.magic (`BigInt (bigint_of_js u))
-    | "null" -> Obj.magic `Null
     | "undefined" -> Obj.magic `Undefined
-    | _ -> Obj.magic (`Other (other_of_js u))
+    | _ ->
+      if Ojs.is_null u then Obj.magic `Null
+      else Obj.magic (`Other (other_of_js u))
   let classify c = classify' Obj.magic c
   ]
 end
-
-type 'a or_null = 'a option
-val or_null_to_js: ('a -> Ojs.t) -> 'a or_null -> Ojs.t
-val or_null_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a or_null
-type 'a or_undefined = 'a option
-val or_undefined_to_js: ('a -> Ojs.t) -> 'a or_undefined -> Ojs.t
-val or_undefined_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a or_undefined
-type 'a or_null_or_undefined = 'a option
-val or_null_or_undefined_to_js: ('a -> Ojs.t) -> 'a or_null_or_undefined -> Ojs.t
-val or_null_or_undefined_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a or_null_or_undefined
-
-type 'a or_string = [`String of string | `Other of 'a] [@@js.custom {
-  of_js = (fun a_of_js x -> match Ojs.type_of x with "string" -> `String (Ojs.string_of_js x) | _ -> `Other (a_of_js x));
-  to_js = (fun a_to_js -> function `String x -> Ojs.string_to_js x | `Other x -> a_to_js x)
-}]
-val or_string_to_js: ('a -> Ojs.t) -> 'a or_string -> Ojs.t
-val or_string_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a or_string
-type 'a or_number = [`Number of float | `Other of 'a] [@@js.custom {
-  of_js = (fun a_of_js x -> match Ojs.type_of x with "number" -> `Number (Ojs.float_of_js x) | _ -> `Other (a_of_js x));
-  to_js = (fun a_to_js -> function `Number x -> Ojs.float_to_js x | `Other x -> a_to_js x)
-}]
-val or_number_to_js: ('a -> Ojs.t) -> 'a or_number -> Ojs.t
-val or_number_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a or_number
-type 'a or_boolean = [`Boolean of bool | `Other of 'a] [@@js.custom {
-  of_js = (fun a_of_js x -> match Ojs.type_of x with "boolean" -> `Boolean (Ojs.bool_of_js x) | _ -> `Other (a_of_js x));
-  to_js = (fun a_to_js -> function `Boolean x -> Ojs.bool_to_js x | `Other x -> a_to_js x)
-}]
-val or_boolean_to_js: ('a -> Ojs.t) -> 'a or_boolean -> Ojs.t
-val or_boolean_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a or_boolean
-type 'a or_symbol = [`Symbol of symbol | `Other of 'a] [@@js.custom {
-  of_js = (fun a_of_js x -> match Ojs.type_of x with "symbol" -> `Symbol (symbol_of_js x) | _ -> `Other (a_of_js x));
-  to_js = (fun a_to_js -> function `Symbol x -> symbol_to_js x | `Other x -> a_to_js x)
-}]
-val or_symbol_to_js: ('a -> Ojs.t) -> 'a or_symbol -> Ojs.t
-val or_symbol_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a or_symbol
-type 'a or_bigint = [`BigInt of bigint | `Other of 'a] [@@js.custom {
-  of_js = (fun a_of_js x -> match Ojs.type_of x with "bigint" -> `BigInt (bigint_of_js x) | _ -> `Other (a_of_js x));
-  to_js = (fun a_to_js -> function `BigInt x -> bigint_to_js x | `Other x -> a_to_js x)
-}]
-val or_bigint_to_js: ('a -> Ojs.t) -> 'a or_bigint -> Ojs.t
-val or_bigint_of_js: (Ojs.t -> 'a) -> Ojs.t -> 'a or_bigint
-
-val is_array: Ojs.t -> bool [@@js.global "Array.isArray"]
-
-type ('a, 't) or_array = [`Array of 't list | `Other of 'a] [@@js.custom {
-  of_js = (fun a_of_js t_of_js x ->
-    if is_array x then `Array (Ojs.list_of_js t_of_js x)
-    else `Other (a_of_js x)
-  );
-  to_js = (fun a_to_js t_to_js -> function `Array x -> Ojs.list_to_js t_to_js x | `Other x -> a_to_js x)
-}]
-val or_array_to_js: ('a -> Ojs.t) -> ('t -> Ojs.t) -> ('a, 't) or_array -> Ojs.t
-val or_array_of_js: (Ojs.t -> 'a) -> (Ojs.t -> 't) -> Ojs.t -> ('a, 't) or_array
-
-type ('a, 'cases) or_enum = [`Enum of 'cases | `Other of 'a] [@@js.custom {
-  of_js = (fun a_of_js cases_of_js x ->
-    try `Enum (cases_of_js x) with _ -> `Other (a_of_js x));
-  to_js = (fun a_to_js cases_to_js -> function `Enum cases -> cases_to_js cases | `Other x -> a_to_js x)
-}]
-val or_enum_to_js: ('a -> Ojs.t) -> ('cases -> Ojs.t) -> ('a, 'cases) or_enum -> Ojs.t
-val or_enum_of_js: (Ojs.t -> 'a) -> (Ojs.t -> 'cases) -> Ojs.t -> ('a, 'cases) or_enum
 """

src/Targets/JsOfOCaml/OCamlHelper.fs

@@ -179,18 +179,6 @@ module Type =
   // our types
   let intf  = str "intf"
 
-  let null_or t        = app (str "or_null") [t]
-  let undefined_or t   = app (str "or_undefined") [t]
-  let null_or_undefined_or t = app (str "or_null_or_undefined") [t]
-  let string_or t  = app (str "or_string") [t]
-  let number_or t  = app (str "or_number") [t]
-  let boolean_or t = app (str "or_boolean") [t]
-  let symbol_or t  = app (str "or_symbol") [t]
-  let bigint_or t  = app (str "or_bigint") [t]
-
-  let array_or elemT t = app (str "or_array") [t; elemT]
-  let enum_or cases t = app (str "or_enum") [t; cases]
-
   let rec union = function
     | [] -> failwith "union type with zero elements"
     | x :: [] -> x