From 3bd452a8081f389ff7f845461b27e0b2f4652df7 Mon Sep 17 00:00:00 2001 From: Jand42 Date: Sat, 18 Feb 2017 21:44:37 +0100 Subject: [PATCH] Fix #660 add erased unions and option --- .../WebSharper.Compiler.FSharp/CodeReader.fs | 11 +- .../WebSharper.Compiler/QuotationReader.fs | 29 +- .../WebSharper.Compiler/Translator.fs | 281 ++++++++++-------- .../WebSharper.Core.JavaScript/Runtime.js | 6 +- src/stdlib/WebSharper.Main/Interop.fs | 2 +- .../WebSharper.Main/JavaScript.Pervasives.fs | 123 ++++++++ src/stdlib/WebSharper.Main/Proxy/Choice.fs | 6 + src/stdlib/WebSharper.Main/Proxy/List.fs | 2 +- src/stdlib/WebSharper.Main/Proxy/Option.fs | 7 +- src/stdlib/WebSharper.Main/genInterop.fsx | 66 ++-- tests/WebSharper.CSharp.Tests/Interop.cs | 59 +++- tests/WebSharper.Collections.Tests/Interop.fs | 2 +- .../Main.fs | 2 +- tests/WebSharper.Tests/WIG.fs | 10 + 14 files changed, 421 insertions(+), 185 deletions(-) diff --git a/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs b/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs index 0b424af60..7a225715e 100644 --- a/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs +++ b/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs @@ -776,12 +776,11 @@ let rec transformExpression (env: Environment) (expr: FSharpExpr) = else NewUnionCase(t, case.CompiledName, exprs |> List.map tr) | P.UnionCaseGet (expr, typ, case, field) -> - 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))) + let t = + match sr.ReadType env.TParams typ with + | ConcreteType ct -> ct + | _ -> parsefailf "Expected a union type" + UnionCaseGet(tr expr, t, case.CompiledName, field.Name) | P.UnionCaseTest (expr, typ, case) -> let t = match sr.ReadType env.TParams typ with diff --git a/src/compiler/WebSharper.Compiler/QuotationReader.fs b/src/compiler/WebSharper.Compiler/QuotationReader.fs index e43507ad4..9e46d2e3f 100644 --- a/src/compiler/WebSharper.Compiler/QuotationReader.fs +++ b/src/compiler/WebSharper.Compiler/QuotationReader.fs @@ -213,25 +213,18 @@ let rec transformExpression (env: Environment) (expr: Expr) = | Patterns.Coerce (expr, typ) -> tr expr // TODO: type check when possible | Patterns.NewUnionCase (case, exprs) -> - let annot = A.attrReader.GetMemberAnnot(A.TypeAnnotation.Empty, case.GetCustomAttributesData()) - match annot.Kind with - | Some (A.MemberKind.Constant c) -> Value c - | _ -> - let i = case.Tag - CopyCtor( - Reflection.ReadTypeDefinition case.DeclaringType, - Object ( - ("$", Value (Int i)) :: - (exprs |> List.mapi (fun j e -> "$" + string j, tr e)) - ) - ) + let t = + match Reflection.ReadType case.DeclaringType with + | ConcreteType ct -> ct + | _ -> parsefailf "Expected a union type" + + NewUnionCase(t, case.Name, exprs |> List.map tr) | Patterns.UnionCaseTest (expr, case) -> - let annot = A.attrReader.GetMemberAnnot(A.TypeAnnotation.Empty, case.GetCustomAttributesData()) - match annot.Kind with - | Some (A.MemberKind.Constant c) -> Binary (tr expr, BinaryOperator.``==``, Value c) - | _ -> - let i = case.Tag - Binary(ItemGet(tr expr, Value (String "$")), BinaryOperator.``==``, Value (Int i)) + let t = + match Reflection.ReadType case.DeclaringType with + | ConcreteType ct -> ct + | _ -> parsefailf "Expected a union type" + UnionCaseTest(tr expr, t, case.Name) | Patterns.NewRecord (typ, items) -> let t = match Reflection.ReadType typ with diff --git a/src/compiler/WebSharper.Compiler/Translator.fs b/src/compiler/WebSharper.Compiler/Translator.fs index 038cf187e..68d58ed41 100644 --- a/src/compiler/WebSharper.Compiler/Translator.fs +++ b/src/compiler/WebSharper.Compiler/Translator.fs @@ -141,6 +141,12 @@ type GenericInlineResolver (generics) = args |> List.map this.TransformExpression ) + override this.TransformTypeCheck(expr, typ) = + TypeCheck ( + expr |> this.TransformExpression, + typ |> subs + ) + let private objTy = NonGenericType Definitions.Obj let rpcMethodNode name ret = @@ -246,125 +252,108 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = this.Warning("Could not run generator in code service.") Undefined - member this.GetCustomTypeConstructorInline (i : M.CustomTypeInfo, ctor: Constructor) = + member this.CustomTypeConstructor (typ : Concrete, i : M.CustomTypeInfo, ctor: Constructor, args) = match i with | M.FSharpRecordInfo fields -> - let obj = - fields - |> Seq.mapi (fun i f -> - f.JSName, - if f.Optional then - let id = Id.New(mut = false) - Let(id, Hole i, - Conditional(Var id, ItemGet(Var id, Value (String "$0")), Undefined)) - else Hole i) - |> List.ofSeq |> Object - let optFields = - fields |> List.choose (fun f -> - if f.Optional then Some (Value (String f.JSName)) else None) - if List.isEmpty optFields then obj - else JSRuntime.DeleteEmptyFields obj optFields + this.TransformNewRecord(typ, args) | _ -> this.Error("Unhandled F# compiler generated constructor") - member this.GetCustomTypeMethodInline (typ : Concrete, i : M.CustomTypeInfo, meth: Concrete) = + member this.CustomTypeMethod (objExpr : option, typ : Concrete, i : M.CustomTypeInfo, meth: Concrete, args) = let me = meth.Entity.Value + let unionCase isSingleCase (c: M.FSharpUnionCaseInfo) = + let mN = me.MethodName + if mN.StartsWith "get_" then + let fN = mN.[4 ..] + let getUnionBaseType td = + if isSingleCase then td else + let n = td.FullName + { td with FullName = n.Substring(0, n.LastIndexOf('+')) } + let uTyp = + { typ with + Entity = TypeDefinition (getUnionBaseType typ.Entity.Value) + } + this.TransformUnionCaseGet(objExpr.Value, uTyp, c.Name, fN) + |> Some + else + None + match i with - | M.DelegateInfo di -> + | M.DelegateInfo _ -> match me.MethodName with | "Invoke" -> // TODO: optional arguments - let args = di.DelegateArgs |> List.mapi (fun i _ -> Hole (i + 1)) //|> NewArray - - Application(Hole 0, args, false, Some args.Length) - //Application(JSRuntime.InvokeDelegate, [Hole 0; args]) - | "op_Addition" -> JSRuntime.CombineDelegates (NewArray [Hole 0; Hole 1]) - | "op_Equality" -> JSRuntime.DelegateEqual (Hole 0) (Hole 1) + Application(this.TransformExpression objExpr.Value, args |> List.map this.TransformExpression, false, Some args.Length) + | "op_Addition" -> JSRuntime.CombineDelegates (NewArray (args |> List.map this.TransformExpression)) + | "op_Equality" -> + match args |> List.map this.TransformExpression with + | [ d1; d2 ] -> + JSRuntime.DelegateEqual d1 d2 + | _ -> this.Error("Delegate equality check expects two arguments") | "ToString" -> Value (String typ.Entity.Value.FullName) | mn -> this.Error("Unrecognized delegate method: " + mn) - | M.FSharpRecordInfo fields -> + | M.FSharpRecordInfo _ -> match me.MethodName.[.. 2] with | "get" -> let fn = me.MethodName.[4 ..] - let resOpt = - fields |> List.tryPick (fun f -> - if f.Name = fn then - if f.Optional then - JSRuntime.GetOptional(ItemGet(Hole 0, Value (String f.JSName))) - else - ItemGet(Hole 0, Value (String f.JSName)) - |> Some - else None - ) - match resOpt with - | Some res -> res - | _ -> this.Error(sprintf "Could not find property of F# record type: %s.%s" typ.Entity.Value.FullName fn) + this.TransformFieldGet(objExpr, typ, fn) | "set" -> let fn = me.MethodName.[4 ..] - let resOpt = - fields |> List.tryPick (fun f -> - if f.Name = fn then - if f.Optional then - JSRuntime.SetOptional (Hole 0) (Value (String f.JSName)) (Hole 1) - else - ItemSet(Hole 0, Value (String f.JSName), Hole 1) - |> Some - else None - ) - match resOpt with - | Some res -> res - | _ -> this.Error(sprintf "Could not find property of F# record type: %s.%s" typ.Entity.Value.FullName fn) + this.TransformFieldSet(objExpr, typ, fn, args.Head) | _ -> match me.MethodName with | "ToString" -> Value (String typ.Entity.Value.FullName) | _ -> this.Error("Unrecognized member of F# record type") | M.FSharpUnionInfo u -> + // union types with a single non-null case do not have + // nested subclass subclass for the case + let checkSingleCaseUnion = + let numCases = u.Cases.Length + if numCases = 1 then + Some u.Cases.Head + elif (u.HasNull && numCases = 2) then + if u.Cases.Head.Kind = M.ConstantFSharpUnionCase Null then + Some u.Cases.Tail.Head + else + Some u.Cases.Head + else None + |> Option.bind (unionCase true) + match checkSingleCaseUnion with + | Some res -> res + | _ -> let mN = me.MethodName + let styp() = + // substituted generic arguments are needed for erased choice + let mgen = Array.ofList meth.Generics + { typ with + Generics = typ.Generics |> List.map (fun t -> t.SubstituteGenerics(mgen)) + } if mN.StartsWith "get_Is" then let cN = mN.[6 ..] - let i, c = u.Cases |> Seq.indexed |> Seq.find (fun (i, c) -> c.Name = cN) - match c.Kind with - | M.ConstantFSharpUnionCase v -> Hole 0 ^== Value v - | _ -> - if u.HasNull then - let v = Id.New(mut = false) - Let (v, Hole 0, (Var v ^!= Value Null) ^&& (Var v).[Value (String "$")] ^== Value (Int i)) - else - if u.Cases.Length = 2 then Hole 0 ^!= Value Null - else (Hole 0).[Value (String "$")] ^== Value (Int i) + let u = + match objExpr with + | Some u -> u + | _ -> args.Head + this.TransformUnionCaseTest(u, styp(), cN) elif mN = "get_Tag" then - if u.Cases |> List.forall (function { Kind = M.NormalFSharpUnionCase _ } -> true | _ -> false) then - (Hole 0).[Value (String "$")] - else - let v = Id.New(mut = false) - let afterNullCheck = - if u.Cases |> List.forall (function { Kind = M.NormalFSharpUnionCase _ | M.ConstantFSharpUnionCase Null } -> true | _ -> false) then - (Var v).[Value (String "$")] - else - u.Cases |> List.indexed - |> List.choose (function (i, { Kind = M.ConstantFSharpUnionCase v }) -> (if v <> Null then Some (i, v) else None) | _ -> None) - |> List.fold (fun rest (i, c) -> Conditional (Var v ^== Value c, Value (Int i), rest)) ((Var v).[Value (String "$")]) - if u.HasNull then - let ui = u.Cases |> List.findIndex (function { Kind = M.ConstantFSharpUnionCase Null } -> true | _ -> false) - Let (v, Hole 0, Conditional((Var v ^!= Value Null), Value (Int ui), afterNullCheck)) - else - Let (v, Hole 0, afterNullCheck) + let u = + match objExpr with + | Some u -> u + | _ -> args.Head + this.TransformUnionCaseTag(u, styp()) elif mN.StartsWith "New" then let cN = mN.[3 ..] - let i, c = u.Cases |> Seq.indexed |> Seq.find (fun (_, c) -> c.Name = cN) - - match c.Kind with - | M.ConstantFSharpUnionCase v -> Value v - | M.NormalFSharpUnionCase fields -> - let args = fields |> List.mapi (fun i _ -> Hole i) - let objExpr = - Object ( - ("$", Value (Int i)) :: - (args |> List.mapi (fun j e -> "$" + string j, this.TransformExpression e)) - ) - this.TransformCopyCtor(typ.Entity, objExpr) + this.TransformNewUnionCase(typ, cN, args) elif mN.StartsWith "get_" then + if erasedUnions.Contains typ.Entity then + if mN = "get_Undefined" then Undefined else + this.TransformExpression objExpr.Value + else let cN = mN.[4 ..] - let i, c = u.Cases |> Seq.indexed |> Seq.find (fun (_, c) -> c.Name = cN) + let i, c = + try + u.Cases |> Seq.indexed |> Seq.find (fun (_, c) -> c.Name = cN) + with _ -> + failwithf "Failed to find union case %s in %s, found: %s" cN typ.Entity.Value.FullName (u.Cases |> Seq.map (fun c -> c.Name) |> String.concat ", ") match c.Kind with | M.ConstantFSharpUnionCase v -> Value v @@ -375,21 +364,10 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = match mN with | "ToString" -> Value (String typ.Entity.Value.FullName) | _ -> this.Error("Unrecognized F# compiler generated method for union: " + mN) - | M.FSharpUnionCaseInfo c -> - let mN = me.MethodName - if mN.StartsWith "get_" then - let fN = mN.[4 ..] - match c.Kind with - | M.ConstantFSharpUnionCase _ -> - this.Error("Getting item of Constant union case: " + me.MethodName) - | M.NormalFSharpUnionCase fields -> - match fields |> List.tryFindIndex (fun f -> f.Name = fN) with - | Some i -> - ItemGet(Hole 0, Value (String ("$" + string i))) - | _ -> - this.Error("Could not find item of union case: " + fN) - else - this.Error("Unrecognized F# compiler generated method for union case: " + me.MethodName) + | M.FSharpUnionCaseInfo c -> + match unionCase false c with + | Some res -> res + | _ -> this.Error("Unrecognized F# compiler generated method for union case: " + me.MethodName) | _ -> this.Error("Unrecognized F# compiler generated method: " + me.MethodName) member this.CompileMethod(info, expr, typ, meth) = @@ -808,10 +786,9 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = this.CompileCall(info, M.Optimizations.None, expr, thisObj, typ, meth, args) | CustomTypeMember ct -> try - let inl = this.GetCustomTypeMethodInline(typ, ct, meth) - Substitution(args |> List.map this.TransformExpression, ?thisObj = (thisObj |> Option.map this.TransformExpression)).TransformExpression(inl) - with _ -> - this.Error("Failed to translate compiler generated method: " + meth.Entity.Value.MethodName) + this.CustomTypeMethod(thisObj, typ, ct, meth, args) + with e -> + this.Error(sprintf "Failed to translate compiler generated method: %s.%s - %s" typ.Entity.Value.FullName meth.Entity.Value.MethodName e.Message) | LookupMemberError err -> comp.AddError (this.CurrentSourcePos, err) match thisObj with @@ -956,17 +933,31 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = New (GlobalAccess a, [ this.TransformExpression objExpr ]) | _ -> this.TransformExpression objExpr - override this.TransformNewRecord(typ, fields) = + override this.TransformNewRecord(typ, args) = match comp.TryGetRecordConstructor typ.Entity with | Some rctor -> if comp.HasGraph then this.AddDependency(M.ConstructorNode (comp.FindProxied typ.Entity, rctor)) - this.TransformCtor(typ, rctor, fields) + this.TransformCtor(typ, rctor, args) | _ -> - try - let inl = this.GetCustomTypeConstructorInline(comp.GetCustomType typ.Entity, emptyConstructor) - Substitution(fields |> List.map this.TransformExpression).TransformExpression(inl) - with _ -> this.Error("Failed to translate F# record creation.") + match comp.GetCustomType typ.Entity with + | M.FSharpRecordInfo fields -> + let obj = + (args, fields) + ||> Seq.map2 (fun a f -> + f.JSName, + if f.Optional then + let id = Id.New(mut = false) + Let(id, this.TransformExpression a, + Conditional(Var id, ItemGet(Var id, Value (String "$0")), Undefined)) + else this.TransformExpression a) + |> List.ofSeq |> Object + let optFields = + fields |> List.choose (fun f -> + if f.Optional then Some (Value (String f.JSName)) else None) + if List.isEmpty optFields then obj + else JSRuntime.DeleteEmptyFields obj optFields + | _ -> this.Error("Unhandled F# compiler generated constructor") override this.TransformNewUnionCase(typ, case, args) = let t = typ.Entity @@ -978,7 +969,11 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = 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) + let i, c = + try + u.Cases |> Seq.indexed |> Seq.find (fun (_, c) -> c.Name = case) + with _ -> + failwithf "Failed to find union case constructor %s in %s, found: %s" case typ.Entity.Value.FullName (u.Cases |> Seq.map (fun c -> c.Name) |> String.concat ", ") match c.Kind with | M.ConstantFSharpUnionCase v -> Value v @@ -1019,9 +1014,41 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = else ItemGet(this.TransformExpression expr, Value (String "$")) ^== Value (Int i) | _ -> this.Error("Failed to translate union case test.") + + override this.TransformUnionCaseGet(expr, typ, case, field) = + if erasedUnions.Contains typ.Entity then + this.TransformExpression expr + else + match comp.GetCustomType typ.Entity with + | M.FSharpUnionInfo u -> + let i, c = u.Cases |> Seq.indexed |> Seq.find (fun (_, c) -> c.Name = case) + match c.Kind with + | M.ConstantFSharpUnionCase _ -> + this.Error(sprintf "Getting item of Constant union case: %s.%s" typ.Entity.Value.FullName case) + | M.NormalFSharpUnionCase fields -> + match fields |> List.tryFindIndex (fun f -> f.Name = field) with + | Some i -> + ItemGet(this.TransformExpression expr, Value (String ("$" + string i))) + | _ -> + this.Error(sprintf "Could not find field of union case: %s.%s.%s" typ.Entity.Value.FullName case field) + + | _ -> this.Error("Failed to translate union case field getter.") override this.TransformUnionCaseTag(expr, typ) = - // Todo: tag for erased union + if erasedUnions.Contains typ.Entity then + if typ.Entity.Value.FullName = "WebSharper.JavaScript.Optional`1" then + Conditional(this.TransformExpression expr ^=== Undefined, Value (Int 0), Value (Int 1)) + else + let id = Id.New(mut = false) + let rec checkTypes i gen = + match gen with + | [ t; _ ] -> + Conditional(this.TransformTypeCheck(Var id, t), Value (Int i), Value (Int (i + 1))) + | t :: r -> + Conditional(this.TransformTypeCheck(Var id, t), Value (Int i), checkTypes (i + 1) r) + | _ -> this.Error "Erased union type must have 2 or more type arguments" + Let(id, this.TransformExpression expr, checkTypes 0 typ.Generics) + else match comp.GetCustomType typ.Entity with | M.FSharpUnionInfo u -> let constantCases = @@ -1064,8 +1091,7 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = this.CompileCtor(info, M.Optimizations.None, expr, typ, ctor, args) | CustomTypeMember ct -> try - let inl = this.GetCustomTypeConstructorInline(ct, ctor) - Substitution(args |> List.map this.TransformExpression).TransformExpression(inl) + this.CustomTypeConstructor(typ, ct, ctor, args) with _ -> this.Error("Failed to translate compiler generated constructor") | LookupMemberError err -> @@ -1132,7 +1158,7 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = | M.NormalFSharpUnionCase fields -> let fName = "$" + string (fields |> List.findIndex (fun f -> f.Name = field)) ItemGet(this.TransformExpression expr.Value, Value (String fName)) - | _ -> failwith "Constant union case should not have fields" + | _ -> this.Error "Constant union case should not have fields" | M.FSharpRecordInfo fields -> match fields |> List.tryPick (fun f -> if f.Name = field then Some (f.JSName, f.Optional) else None) with | Some (name, isOpt) -> @@ -1141,7 +1167,7 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = else this.TransformExpression expr.Value |> getItem name | _ -> this.Error(sprintf "Could not find field of F# record type: %s.%s" typ.Entity.Value.FullName field) - | M.FSharpUnionInfo _ -> failwith "Union base type should not have fields" + | M.FSharpUnionInfo _ -> this.Error "Union base type should not have fields" | _ -> failwith "CustomTypeField error" | PropertyField (getter, _) -> match getter with @@ -1183,8 +1209,8 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = else ItemSet(this.TransformExpression expr.Value, Value (String name), this.TransformExpression value) | _ -> this.Error(sprintf "Could not find field of F# record type: %s.%s" typ.Entity.Value.FullName field) - | M.FSharpUnionCaseInfo _ -> failwith "Union case field should not be set" - | M.FSharpUnionInfo _ -> failwith "Union base type should not have fields" + | M.FSharpUnionCaseInfo _ -> this.Error "Union case field should not be set" + | M.FSharpUnionInfo _ -> this.Error "Union base type should not have fields" | _ -> failwith "CustomTypeField error" | PropertyField (_, setter) -> match setter with @@ -1251,6 +1277,13 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = instanceof "Array" | "WebSharper.JavaScript.Function" -> typeof "function" + | "Microsoft.FSharp.Core.FSharpChoice`2" + | "Microsoft.FSharp.Core.FSharpChoice`3" + | "Microsoft.FSharp.Core.FSharpChoice`4" + | "Microsoft.FSharp.Core.FSharpChoice`5" + | "Microsoft.FSharp.Core.FSharpChoice`6" + | "Microsoft.FSharp.Core.FSharpChoice`7" -> + this.TransformExpression expr | tname -> if not (List.isEmpty gs) then this.Warning ("Type test in JavaScript translation is ignoring erased type parameter.") @@ -1261,7 +1294,7 @@ type DotNetToJavaScript private (comp: Compilation, ?inProgress) = Binary(this.TransformExpression expr, BinaryOperator.instanceof, GlobalAccess a) | _ -> this.Error("Type test cannot be translated because client-side class does not have a prototype: " + t.Value.FullName) - | None -> + | _ -> match comp.GetCustomType t with | M.FSharpUnionCaseInfo c -> let tN = t.Value.FullName diff --git a/src/compiler/WebSharper.Core.JavaScript/Runtime.js b/src/compiler/WebSharper.Core.JavaScript/Runtime.js index 85c65ffee..17b8f74cc 100644 --- a/src/compiler/WebSharper.Core.JavaScript/Runtime.js +++ b/src/compiler/WebSharper.Core.JavaScript/Runtime.js @@ -84,10 +84,10 @@ IntelliFactory = { SetOrDelete: function (obj, field, value) { - if (value !== void (0)) { - obj[field] = value; - } else { + if (value === void (0)) { delete obj[field]; + } else { + obj[field] = value; } }, diff --git a/src/stdlib/WebSharper.Main/Interop.fs b/src/stdlib/WebSharper.Main/Interop.fs index acc51c0a6..30320b478 100644 --- a/src/stdlib/WebSharper.Main/Interop.fs +++ b/src/stdlib/WebSharper.Main/Interop.fs @@ -143,7 +143,7 @@ type FuncWithArgsRestProxy<'TArgs, 'TRest, 'TResult> = member this.Call (args: 'TArgs, [] rest: 'TRest[]) = Unchecked.defaultof<'TResult> [>)>] -type Optional<'T> = +type OptionalProxy<'T> = | Undefined | Defined of 'T diff --git a/src/stdlib/WebSharper.Main/JavaScript.Pervasives.fs b/src/stdlib/WebSharper.Main/JavaScript.Pervasives.fs index ea928a6b6..4bb50c17c 100644 --- a/src/stdlib/WebSharper.Main/JavaScript.Pervasives.fs +++ b/src/stdlib/WebSharper.Main/JavaScript.Pervasives.fs @@ -124,5 +124,128 @@ let GetJS<'T> (x: obj) (items: seq) = x <- x?(i) As<'T> x +/// Erases generic parameters inside this expression during WebSharper translation. +/// You can get use this to translate `defaultof` inside a generic function. [)>] let DefaultToUndefined<'T> (x: 'T) = x + +module Optional = + /// Converts an F# option value to a JavaScript erased option + [] + let ofOption x = + match x with + | None -> Undefined + | Some v -> Defined v + + /// Converts a JavaScript erased option to an F# option value + [] + let toOption x = + match x with + | Undefined -> None + | Defined v -> Some v + +module Union = +// {{ generated by genInterop.fsx, do not modify + /// Converts an F# Choice value to a JavaScript erased union + [] + let ofChoice2 x = + match x with + | Choice1Of2 v -> Union1Of2 v + | Choice2Of2 v -> Union2Of2 v + /// Converts a JavaScript erased union to an F# option value + [] + let toChoice2 x = + match x with + | Union1Of2 v -> Choice1Of2 v + | Union2Of2 v -> Choice2Of2 v + /// Converts an F# Choice value to a JavaScript erased union + [] + let ofChoice3 x = + match x with + | Choice1Of3 v -> Union1Of3 v + | Choice2Of3 v -> Union2Of3 v + | Choice3Of3 v -> Union3Of3 v + /// Converts a JavaScript erased union to an F# option value + [] + let toChoice3 x = + match x with + | Union1Of3 v -> Choice1Of3 v + | Union2Of3 v -> Choice2Of3 v + | Union3Of3 v -> Choice3Of3 v + /// Converts an F# Choice value to a JavaScript erased union + [] + let ofChoice4 x = + match x with + | Choice1Of4 v -> Union1Of4 v + | Choice2Of4 v -> Union2Of4 v + | Choice3Of4 v -> Union3Of4 v + | Choice4Of4 v -> Union4Of4 v + /// Converts a JavaScript erased union to an F# option value + [] + let toChoice4 x = + match x with + | Union1Of4 v -> Choice1Of4 v + | Union2Of4 v -> Choice2Of4 v + | Union3Of4 v -> Choice3Of4 v + | Union4Of4 v -> Choice4Of4 v + /// Converts an F# Choice value to a JavaScript erased union + [] + let ofChoice5 x = + match x with + | Choice1Of5 v -> Union1Of5 v + | Choice2Of5 v -> Union2Of5 v + | Choice3Of5 v -> Union3Of5 v + | Choice4Of5 v -> Union4Of5 v + | Choice5Of5 v -> Union5Of5 v + /// Converts a JavaScript erased union to an F# option value + [] + let toChoice5 x = + match x with + | Union1Of5 v -> Choice1Of5 v + | Union2Of5 v -> Choice2Of5 v + | Union3Of5 v -> Choice3Of5 v + | Union4Of5 v -> Choice4Of5 v + | Union5Of5 v -> Choice5Of5 v + /// Converts an F# Choice value to a JavaScript erased union + [] + let ofChoice6 x = + match x with + | Choice1Of6 v -> Union1Of6 v + | Choice2Of6 v -> Union2Of6 v + | Choice3Of6 v -> Union3Of6 v + | Choice4Of6 v -> Union4Of6 v + | Choice5Of6 v -> Union5Of6 v + | Choice6Of6 v -> Union6Of6 v + /// Converts a JavaScript erased union to an F# option value + [] + let toChoice6 x = + match x with + | Union1Of6 v -> Choice1Of6 v + | Union2Of6 v -> Choice2Of6 v + | Union3Of6 v -> Choice3Of6 v + | Union4Of6 v -> Choice4Of6 v + | Union5Of6 v -> Choice5Of6 v + | Union6Of6 v -> Choice6Of6 v + /// Converts an F# Choice value to a JavaScript erased union + [] + let ofChoice7 x = + match x with + | Choice1Of7 v -> Union1Of7 v + | Choice2Of7 v -> Union2Of7 v + | Choice3Of7 v -> Union3Of7 v + | Choice4Of7 v -> Union4Of7 v + | Choice5Of7 v -> Union5Of7 v + | Choice6Of7 v -> Union6Of7 v + | Choice7Of7 v -> Union7Of7 v + /// Converts a JavaScript erased union to an F# option value + [] + let toChoice7 x = + match x with + | Union1Of7 v -> Choice1Of7 v + | Union2Of7 v -> Choice2Of7 v + | Union3Of7 v -> Choice3Of7 v + | Union4Of7 v -> Choice4Of7 v + | Union5Of7 v -> Choice5Of7 v + | Union6Of7 v -> Choice6Of7 v + | Union7Of7 v -> Choice7Of7 v +// }} diff --git a/src/stdlib/WebSharper.Main/Proxy/Choice.fs b/src/stdlib/WebSharper.Main/Proxy/Choice.fs index a7a03b24e..493dea0d0 100644 --- a/src/stdlib/WebSharper.Main/Proxy/Choice.fs +++ b/src/stdlib/WebSharper.Main/Proxy/Choice.fs @@ -21,12 +21,14 @@ namespace WebSharper [>)>] +[] [] type private ChoiceProxy<'T1,'T2> = | Choice1Of2 of 'T1 | Choice2Of2 of 'T2 [>)>] +[] [] type private ChoiceProxy<'T1,'T2,'T3> = | Choice1Of3 of 'T1 @@ -34,6 +36,7 @@ type private ChoiceProxy<'T1,'T2,'T3> = | Choice3Of3 of 'T3 [>)>] +[] [] type private ChoiceProxy<'T1,'T2,'T3,'T4> = | Choice1Of4 of 'T1 @@ -42,6 +45,7 @@ type private ChoiceProxy<'T1,'T2,'T3,'T4> = | Choice4Of4 of 'T4 [>)>] +[] [] type private ChoiceProxy<'T1,'T2,'T3,'T4,'T5> = | Choice1Of5 of 'T1 @@ -51,6 +55,7 @@ type private ChoiceProxy<'T1,'T2,'T3,'T4,'T5> = | Choice5Of5 of 'T5 [>)>] +[] [] type private ChoiceProxy<'T1,'T2,'T3,'T4,'T5,'T6> = | Choice1Of6 of 'T1 @@ -61,6 +66,7 @@ type private ChoiceProxy<'T1,'T2,'T3,'T4,'T5,'T6> = | Choice6Of6 of 'T6 [>)>] +[] [] type private ChoiceProxy<'T1,'T2,'T3,'T4,'T5,'T6,'T7> = | Choice1Of7 of 'T1 diff --git a/src/stdlib/WebSharper.Main/Proxy/List.fs b/src/stdlib/WebSharper.Main/Proxy/List.fs index ca206c497..19fe32634 100644 --- a/src/stdlib/WebSharper.Main/Proxy/List.fs +++ b/src/stdlib/WebSharper.Main/Proxy/List.fs @@ -27,7 +27,7 @@ open WebSharper.JavaScript [] type private ListProxy<'T> = | Empty - | Cons of 'T * List<'T> + | Cons of Head: 'T * Tail: List<'T> [] static member Cons(head: 'T, tail: list<'T>) = head :: tail diff --git a/src/stdlib/WebSharper.Main/Proxy/Option.fs b/src/stdlib/WebSharper.Main/Proxy/Option.fs index 9de8c90d4..7623a599a 100644 --- a/src/stdlib/WebSharper.Main/Proxy/Option.fs +++ b/src/stdlib/WebSharper.Main/Proxy/Option.fs @@ -27,11 +27,8 @@ open WebSharper.JavaScript [] [] type private OptionProxy<'T> = - | None - | Some of 'T - - [] - member this.Value with [] get () = X<'T> + | None + | Some of Value: 'T [] static member get_IsSome(x: option<'T>) = false diff --git a/src/stdlib/WebSharper.Main/genInterop.fsx b/src/stdlib/WebSharper.Main/genInterop.fsx index 2f31a23db..3d987b5b2 100644 --- a/src/stdlib/WebSharper.Main/genInterop.fsx +++ b/src/stdlib/WebSharper.Main/genInterop.fsx @@ -35,17 +35,51 @@ let concatE s l = let maxArgCount = 6 -let code = +let replaceGenerated path code = + let allCode = + [| + let mutable incl = true + for l in System.IO.File.ReadAllLines(path) do + if incl then yield l + if l.Contains "// {{" + then + incl <- false + yield! code + elif l.Contains "// }}" + then + incl <- true + yield l + |] + + System.IO.File.WriteAllLines(path, allCode) + +let toAnonTypArgs ts = if List.isEmpty ts then "" else "<" + String.concat "," (ts |> Seq.map (fun _ -> "_")) + ">" + +let jsPervasives = let code = ResizeArray() 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 " inherit Function" -// cprintfn " new (func: %s'TRest[] -> 'TResult) = { }" (tArgs i |> concatE " * ") -// cprintfn " member this.Call (%s[] rest: 'TRest[]) = X<'TResult>" (args i |> concatE ", ") + for i = 2 to 7 do + cprintfn " /// Converts an F# Choice value to a JavaScript erased union" + cprintfn " []" + cprintfn " let ofChoice%d x =" i + cprintfn " match x with" + for j = 1 to i do + cprintfn " | Choice%dOf%d v -> Union%dOf%d v" j i j i + cprintfn " /// Converts a JavaScript erased union to an F# option value" + cprintfn " []" + cprintfn " let toChoice%d x =" i + cprintfn " match x with" + for j = 1 to i do + cprintfn " | Union%dOf%d v -> Choice%dOf%d v" j i j i + + code.ToArray() + +replaceGenerated (__SOURCE_DIRECTORY__ + @"\JavaScript.Pervasives.fs") jsPervasives - let toAnonTypArgs ts = if List.isEmpty ts then "" else "<" + String.concat "," (ts |> Seq.map (fun _ -> "_")) + ">" +let interop = + let code = ResizeArray() + let inline cprintfn x = Printf.kprintf code.Add x for pars in [ false; true ] do for this in [ false; true ] do @@ -55,7 +89,6 @@ let code = let thisPars = (if this then "This" else "") + (if pars then "Params" else "") let name = thisPars + del let inTr = thisPars + "Func" -// let outTr = inTr + "Out" for i = 0 to maxArgCount do let t = (if this then ["'TThis"] else[]) @ tArgs i @ (if pars then ["'TParams"] else []) @ (if ret then ["'TResult"] else []) let toTypArgs ts = if List.isEmpty ts then "" else "<" + String.concat ", " ts + ">" @@ -82,19 +115,4 @@ let code = code.ToArray() -let allCode = - [| - let mutable incl = true - for l in System.IO.File.ReadAllLines(__SOURCE_DIRECTORY__ + @"\Interop.fs") do - if incl then yield l - if l.Contains "// {{" - then - incl <- false - yield! code - elif l.Contains "// }}" - then - incl <- true - yield l - |] - -System.IO.File.WriteAllLines(__SOURCE_DIRECTORY__ + @"\Interop.fs", allCode) +replaceGenerated (__SOURCE_DIRECTORY__ + @"\Interop.fs") interop diff --git a/tests/WebSharper.CSharp.Tests/Interop.cs b/tests/WebSharper.CSharp.Tests/Interop.cs index 95523bd3c..84eac639c 100644 --- a/tests/WebSharper.CSharp.Tests/Interop.cs +++ b/tests/WebSharper.CSharp.Tests/Interop.cs @@ -66,6 +66,7 @@ public void ErasedUnion() { IsTrue(I.Module.ErasedUnion1.IsUnion1Of2); IsTrue(I.Module.ErasedUnion2.IsUnion2Of2); + var x = I.Module.ErasedUnion1; var res = 0; switch (x.Tag) @@ -73,9 +74,65 @@ public void ErasedUnion() case Union.Tags.Union1Of2: res = ((Union.Union1Of2)x).Item; break; - } + Equal(res, 42); + x = Union.NewUnion1Of2(43); + switch (x.Tag) + { + case Union.Tags.Union1Of2: + res = ((Union.Union1Of2)x).Item; + break; + } + Equal(res, 43); + + var res2 = ""; + x = I.Module.ErasedUnion2; + switch (x.Tag) + { + case Union.Tags.Union2Of2: + res2 = ((Union.Union2Of2)x).Item; + break; + } + Equal(res2, "hi"); + + x = Union.NewUnion2Of2("hi!"); + switch (x.Tag) + { + case Union.Tags.Union2Of2: + res2 = ((Union.Union2Of2)x).Item; + break; + } + Equal(res2, "hi!"); + + } + + [Test] + public void ErasedOption() + { + IsTrue(I.Module.UndefVal.IsUndefined); + IsTrue(I.Module.DefVal.IsDefined); + + var x = Optional.Undefined; + var res = 0; + switch (x.Tag) + { + case Optional.Tags.Undefined: + res = -1; + break; + } + Equal(res, -1); + JsEqual(x.Value, JS.Undefined); + + x = Optional.NewDefined(4); + switch (x.Tag) + { + case Optional.Tags.Defined: + res = ((Optional.Defined)x).Item; + break; + } + Equal(res, 4); + JsEqual(x.Value, 4); } [Test] diff --git a/tests/WebSharper.Collections.Tests/Interop.fs b/tests/WebSharper.Collections.Tests/Interop.fs index 770eb5d00..fc064bccb 100644 --- a/tests/WebSharper.Collections.Tests/Interop.fs +++ b/tests/WebSharper.Collections.Tests/Interop.fs @@ -99,7 +99,7 @@ module Module = let ErasedUnion1 = JavaScript.Union.Union1Of2 42 let ErasedUnion2 = JavaScript.Union.Union2Of2 "hi" - let UndefVal = JavaScript.Undefined + let UndefVal = JavaScript.Undefined : JavaScript.Optional let DefVal = JavaScript.Defined 42 [] diff --git a/tests/WebSharper.InterfaceGenerator.Tests/Main.fs b/tests/WebSharper.InterfaceGenerator.Tests/Main.fs index 8d4a47e14..904695e4e 100644 --- a/tests/WebSharper.InterfaceGenerator.Tests/Main.fs +++ b/tests/WebSharper.InterfaceGenerator.Tests/Main.fs @@ -136,7 +136,7 @@ module Definition = "" =@ !? T |> Indexed T "asLowerCase" =@ !? T |> Indexed Lowercase |> WithInteropGetterInline (fun tr -> sprintf "$this[%s]" (tr "index")) - |> WithInteropSetterInline (fun tr -> sprintf "$wsruntime.SetOptional($this, %s, %s)" (tr "index") (tr "value")) + |> WithInteropSetterInline (fun tr -> sprintf "$wsruntime.SetOrDelete($this, %s, %s)" (tr "index") (tr "value")) ] let Assembly = diff --git a/tests/WebSharper.Tests/WIG.fs b/tests/WebSharper.Tests/WIG.fs index e23e07541..d6f819ade 100644 --- a/tests/WebSharper.Tests/WIG.fs +++ b/tests/WebSharper.Tests/WIG.fs @@ -116,8 +116,14 @@ let Tests = Test "Choice property" { let x = WIGtest.Instance equal (x.StringOrInt) (Union1Of2 0) + equal (Union.toChoice2 x.StringOrInt) (Choice1Of2 0) + equal (x.StringOrInt.Value1) 0 +// raises (x.StringOrInt.Value2) x.StringOrInt <- Union2Of2 "hi" equal (x.StringOrInt) (Union2Of2 "hi") + equal (Union.toChoice2 x.StringOrInt) (Choice2Of2 "hi") + equal (x.StringOrInt.Value2) "hi" +// raises (x.StringOrInt.Value1) x.StringOrInt <- Union1Of2 1 equal (x.StringOrInt) (Union1Of2 1) } @@ -125,8 +131,12 @@ let Tests = Test "Option property" { let x = WIGtest.Instance equal (x.OptionalInt) Undefined + equal (Optional.toOption x.OptionalInt) None +// raises (x.OptionalInt.Value) x.OptionalInt <- Defined 1 equal (x.OptionalInt) (Defined 1) + equal (Optional.toOption x.OptionalInt) (Some 1) + equal (x.OptionalInt.Value) 1 x.OptionalInt <- Undefined equal (x.OptionalInt) Undefined }