WIP #660 Erased Union types

src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs

@@ -776,8 +776,12 @@ let rec transformExpression (env: Environment) (expr: FSharpExpr) =
             else
                 NewUnionCase(t, case.CompiledName, exprs |> List.map tr)
         | P.UnionCaseGet (expr, typ, case, field) ->
-            let i = case.UnionCaseFields |> Seq.findIndex (fun f -> f = field)
-            ItemGet(tr expr, Value (String ("$" + string i)))   
+            let td = sr.ReadTypeDefinition typ.TypeDefinition
+            if erasedUnions.Contains td then
+                tr expr
+            else
+                let i = case.UnionCaseFields |> Seq.findIndex (fun f -> f = field)
+                ItemGet(tr expr, Value (String ("$" + string i)))   
         | P.UnionCaseTest (expr, typ, case) ->
             let t =
                 match sr.ReadType env.TParams typ with

src/compiler/WebSharper.Compiler/Translator.fs

@@ -970,6 +970,11 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) =
 
     override this.TransformNewUnionCase(typ, case, args) = 
         let t = typ.Entity
+        if erasedUnions.Contains t then
+            match args with
+            | [ a ] -> this.TransformExpression a
+            | _ -> this.Error("Erased union constructor expects a single argument")
+        else
         match comp.GetCustomType typ.Entity with
         | M.FSharpUnionInfo u ->
             let i, c = u.Cases |> Seq.indexed |> Seq.find (fun (i, c) -> c.Name = case)
@@ -986,6 +991,14 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) =
         | _ -> this.Error("Failed to translate union case creation.")
 
     override this.TransformUnionCaseTest(expr, typ, case) = 
+        if erasedUnions.Contains typ.Entity then
+            let i = int case.[5] - 49 // int '1' is 49
+            try
+                this.TransformTypeCheck(expr, typ.Generics.[i])
+            with e ->
+                this.Error(sprintf "Translating erased union test failed, case: %s, generics: %A"
+                    case (typ.Generics |> List.map (fun t -> t.AssemblyQualifiedName)))
+        else
         match comp.GetCustomType typ.Entity with
         | M.FSharpUnionInfo u ->
             let i, c = u.Cases |> Seq.indexed |> Seq.find (fun (i, c) -> c.Name = case)
@@ -1003,6 +1016,7 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) =
         | _ -> this.Error("Failed to translate union case test.")
 
     override this.TransformUnionCaseTag(expr, typ) = 
+        // Todo: tag for erased union
         match comp.GetCustomType typ.Entity with
         | M.FSharpUnionInfo u ->
             let constantCases = 
@@ -1234,7 +1248,7 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) =
                 typeof "function"
             | tname ->
                 if not (List.isEmpty gs) then
-                    this.Warning ("Generic type check is ignoring erased type parameter.")
+                    this.Warning ("Type test in JavaScript translation is ignoring erased type parameter.")
                 match comp.TryLookupClassInfo t with
                 | Some c ->
                     match c.Address with
@@ -1252,7 +1266,8 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) =
                         let i = Id.New (mut = false)
                         Let (i, trE, this.TransformTypeCheck(Var i, ConcreteType uTyp) ^&& this.TransformUnionCaseTest(Var i, uTyp, c.Name)) 
                     | M.DelegateInfo _ ->
-                        this.Error("Type tests do not support delegate type, check against WebSharper.JavaScript.Function.")   
+                        this.Warning("Type test JavaScript translation is ignoring the signature of the delegate.")   
+                        typeof "function"
                     | _ -> 
                         this.Error(sprintf "Failed to compile a type check for type '%s'" tname)
         | TypeParameter _ | StaticTypeParameter _ -> 

src/compiler/WebSharper.Compiler/WIGCompile.fs

@@ -359,7 +359,7 @@ type TypeBuilder(aR: IAssemblyResolver, out: AssemblyDefinition, fsCoreFullName:
         createTuple (Array.ofSeq ts)
 
     member b.Choice(ts: seq<TypeReference>) =
-        commonType fscore "Microsoft.FSharp.Core" "FSharpChoice" ts
+        commonType wsCore "WebSharper.JavaScript" "Union" ts
 
     member b.Option t =
         genericInstance optionType [t]    

src/compiler/WebSharper.Core/ASTHelpers.fs

@@ -183,3 +183,14 @@ let (|UnaryOpName|_|) = function
     | "op_UnaryNegation" -> Some UnaryOperator.``-``
     | "op_OnesComplement" -> Some UnaryOperator.``~``
     | _ -> None
+
+let erasedUnions = 
+    System.Collections.Generic.HashSet (
+        seq {
+            for i in 2 .. 7 ->
+                TypeDefinition {
+                    Assembly = "WebSharper.Core"
+                    FullName = "WebSharper.JavaScript.Union`" + string i
+                }                                           
+        }
+    )

src/compiler/WebSharper.Core/Interop.fs

@@ -295,4 +295,37 @@ type ThisParamsFunc<'TThis, 'T1, 'T2, 'T3, 'T4, 'T5, 'T6, 'TParams, 'TResult> =
     new (del: System.Func<'TThis, 'T1, 'T2, 'T3, 'T4, 'T5, 'T6, 'TParams, 'TResult>) = { }
     member this.Bind(thisArg: 'TThis) = X<ParamsFunc<'T1, 'T2, 'T3, 'T4, 'T5, 'T6, 'TParams, 'TResult>>
     member this.Call(thisArg: 'TThis, arg1: 'T1, arg2: 'T2, arg3: 'T3, arg4: 'T4, arg5: 'T5, arg6: 'T6, [<PA>] rest: 'TParams[]) = X<'TResult>
+type Union<'T1, 'T2> =
+    | Union1Of2 of 'T1
+    | Union2Of2 of 'T2
+type Union<'T1, 'T2, 'T3> =
+    | Union1Of3 of 'T1
+    | Union2Of3 of 'T2
+    | Union3Of3 of 'T3
+type Union<'T1, 'T2, 'T3, 'T4> =
+    | Union1Of4 of 'T1
+    | Union2Of4 of 'T2
+    | Union3Of4 of 'T3
+    | Union4Of4 of 'T4
+type Union<'T1, 'T2, 'T3, 'T4, 'T5> =
+    | Union1Of5 of 'T1
+    | Union2Of5 of 'T2
+    | Union3Of5 of 'T3
+    | Union4Of5 of 'T4
+    | Union5Of5 of 'T5
+type Union<'T1, 'T2, 'T3, 'T4, 'T5, 'T6> =
+    | Union1Of6 of 'T1
+    | Union2Of6 of 'T2
+    | Union3Of6 of 'T3
+    | Union4Of6 of 'T4
+    | Union5Of6 of 'T5
+    | Union6Of6 of 'T6
+type Union<'T1, 'T2, 'T3, 'T4, 'T5, 'T6, 'T7> =
+    | Union1Of7 of 'T1
+    | Union2Of7 of 'T2
+    | Union3Of7 of 'T3
+    | Union4Of7 of 'T4
+    | Union5Of7 of 'T5
+    | Union6Of7 of 'T6
+    | Union7Of7 of 'T7
 // }}

src/compiler/WebSharper.Core/Json.fs

@@ -585,7 +585,6 @@ let serializers =
         | x -> raise (DecoderException(x, typeof<char>))
     add encChar decChar d
     let decString = function
-        | Null -> null
         | String x -> x
         | x -> raise (DecoderException(x, typeof<string>))
     add EncodedString decString d

src/compiler/WebSharper.Core/genInterop.fsx

@@ -40,7 +40,7 @@ let code =
     let inline cprintfn x = Printf.kprintf code.Add x 
 
     for i = 0 to maxArgCount do
-        cprintfn "type FuncWithRest<'TRest, %s'TResult> =" (tArgs i |> concatE ", ")
+        cprintfn "type FuncWithRest<%s'TRest, 'TResult> =" (tArgs i |> concatE ", ")
         cprintfn "    inherit Function"
         cprintfn "    new (func: %s'TRest[] -> 'TResult) = { }" (tArgs i |> concatE " * ")
         cprintfn "    member this.Call (%s[<PA>] rest: 'TRest[]) = X<'TResult>" (args i |> concatE ", ")
@@ -62,6 +62,11 @@ let code =
                             cprintfn "    member this.Bind(thisArg: 'TThis) = X<%s%s%s>" (if pars then "Params" else "System.") del (toTypArgs (List.tail t))
                         cprintfn "    member this.Call(%s) = X<%s>" (a |> String.concat ", ") (if ret then "'TResult" else "unit")
 
+    for i = 2 to 7 do
+        cprintfn "type Union<%s> =" (tArgs i |> String.concat ", ")
+        for j = 1 to i do
+            cprintfn "    | Union%dOf%d of 'T%d" j i j
+
     code.ToArray()
 
 let allCode = 

src/compiler/WebSharper.InterfaceGenerator/Type.fs

@@ -575,12 +575,6 @@ module Type =
                 | _ ->
                     fun x -> "function(args) { return (" + x + ").apply(null, args.slice(0, " + string i + ").concat(args[ " + string i + "])); }" 
         }
-
-    let private unionTransform optional typeStrings =
-        {
-            In = fun x -> x + ".$0"
-            Out = fun x -> sprintf "$wsruntime.UnionByType([%s], %s%s)" (String.concat ", " typeStrings) x (if optional then ", true" else "")
-        } 
 
     let (|UnionOf|_|) t =
         let rec getTypes t =
@@ -693,7 +687,7 @@ module Type =
             if List.length tts = List.length ts then
                 let ts, tts =
                     (ts, tts) ||> List.zip |> List.sortBy snd |> List.unzip
-                InteropType (ChoiceType ts, unionTransform opt tts)
+                ChoiceType ts
             else t
         | _ -> t
 

tests/WebSharper.Collections.Tests/Interop.fs

@@ -97,6 +97,9 @@ module Module =
 
     let mutable ValueB = 2
 
+    let ErasedUnion1 = JavaScript.Union<int, string>.Union1Of2 42
+    let ErasedUnion2 = JavaScript.Union<int, string>.Union2Of2 "hi"
+
 [<JavaScript>]
 type GenericClass<'T>() =
     member this.GenericMethod<'U>(x: 'U) = x

tests/WebSharper.Tests/WIG.fs

@@ -68,7 +68,7 @@ let Tests =
         Test "Functions with ParamArray" {
             let doNotRun() = 
                 (WIGtest.TestCurriedSig(0).Invoke("") : obj) |> ignore
-                (WIGtest.TestIntOrStringReturned() : Choice<int, string>) |> ignore
+                (WIGtest.TestIntOrStringReturned() : Union<int, string>) |> ignore
                 (WIGtest.TestWithNoInterop : FuncWithArgs<int * int, int> -> obj) |> ignore
 
             equal (WIGtest.Sum(1)) 1
@@ -115,11 +115,11 @@ let Tests =
 
         Test "Choice property" {
             let x = WIGtest.Instance 
-            equal (x.StringOrInt) (Choice1Of2 0)
-            x.StringOrInt <- Choice2Of2 "hi"
-            equal (x.StringOrInt) (Choice2Of2 "hi")
-            x.StringOrInt <- Choice1Of2 1
-            equal (x.StringOrInt) (Choice1Of2 1)
+            equal (x.StringOrInt) (Union1Of2 0)
+            x.StringOrInt <- Union2Of2 "hi"
+            equal (x.StringOrInt) (Union2Of2 "hi")
+            x.StringOrInt <- Union1Of2 1
+            equal (x.StringOrInt) (Union1Of2 1)
         }
 
         Test "Option property" {
@@ -134,12 +134,12 @@ let Tests =
         Test "Optional choice property" {
             let x = WIGtest.Instance 
             equal (x.OptionalStringOrFunction) None
-            x.OptionalStringOrFunction <- Some (Choice2Of2 "hi")
-            equal (x.OptionalStringOrFunction) (Some (Choice2Of2 "hi"))
-            x.OptionalStringOrFunction <- Some (Choice1Of2 (System.Func<_,_,_>(fun a b -> a + b)))
+            x.OptionalStringOrFunction <- Some (Union2Of2 "hi")
+            equal (x.OptionalStringOrFunction) (Some (Union2Of2 "hi"))
+            x.OptionalStringOrFunction <- Some (Union1Of2 (System.Func<_,_,_>(fun a b -> a + b)))
             equal (
                 match x.OptionalStringOrFunction with
-                | Some (Choice1Of2 f) -> f.Invoke(1, 2)
+                | Some (Union1Of2 f) -> f.Invoke(1, 2)
                 | _ -> 0
             ) 3
             x.OptionalStringOrFunction <- None

tests/WebSharper.Web.Tests/ClientSideJson.fs

@@ -338,7 +338,7 @@ module ClientSideJson =
                 JQuery.AjaxSettings(
                     Url = url,
                     Type = JQuery.RequestType.POST,
-                    ContentType = Choice<bool, string>.Choice2Of2("application/json"),
+                    ContentType = Union2Of2("application/json"),
                     DataType = JQuery.DataType.Json,
                     Data = serializedArg,
                     Success = (fun data _ _ -> ok (decode data)),