Temp commit

fable-compiler · Nov 23, 2022 · de0eca8 · de0eca8
1 parent 8e9602e
commit de0eca8
Show file tree

Hide file tree

Showing 5 changed files with 138 additions and 42 deletions.
diff --git a/src/Fable.Core/Fable.Core.Util.fs b/src/Fable.Core/Fable.Core.Util.fs
@@ -39,12 +39,44 @@ module Testing =
 
 
 module Reflection =
-    let isUnion (x: obj): bool = nativeOnly
-    let isRecord (x: obj): bool = nativeOnly
-
-    let getCaseTag (x: obj): int = nativeOnly
-    let getCaseName (x: obj): string = nativeOnly
-    let getCaseFields (x: obj): obj[] = nativeOnly
+    open FSharp.Reflection
+
+    let isUnion (x: obj): bool =
+#if FABLE_COMPILER
+        nativeOnly
+#else
+        FSharpType.IsUnion(x.GetType())
+#endif
+
+    let isRecord (x: obj): bool =
+#if FABLE_COMPILER
+        nativeOnly
+#else
+        FSharpType.IsRecord(x.GetType())
+#endif
+
+    let getCaseTag (x: obj): int =
+#if FABLE_COMPILER
+        nativeOnly
+#else
+        let uci, _ = FSharpValue.GetUnionFields(x, x.GetType())
+        uci.Tag
+#endif
+
+    let getCaseName (x: obj): string =
+#if FABLE_COMPILER
+        nativeOnly
+#else
+        let uci, _ = FSharpValue.GetUnionFields(x, x.GetType())
+        uci.Name
+#endif
+
+    let getCaseFields (x: obj): obj[] =
+#if FABLE_COMPILER
+        nativeOnly
+#else
+        FSharpValue.GetUnionFields(x, x.GetType()) |> snd
+#endif
 
 module Compiler =
     /// Compiler full version as string

diff --git a/src/Fable.Transforms/Dart/Replacements.fs b/src/Fable.Transforms/Dart/Replacements.fs
@@ -1484,17 +1484,18 @@ let nullables (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg:
     | "get_HasValue", Some c -> makeEqOp r c (makeNull()) BinaryUnequal |> Some
     | _ -> None
 
-// See fable-library/Option.ts for more info on how options behave in Fable runtime
-let options (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) =
+let options isStruct (com: ICompiler) (_: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) =
     match i.CompiledName, thisArg with
+    | "get_None", _ -> NewOption(None, t.Generics.Head, isStruct) |> makeValue r |> Some
+    | "Some", _ -> NewOption(List.tryHead args, t.Generics.Head, isStruct) |> makeValue r |> Some
     | "get_Value", Some c -> getOptionValue r t c |> Some
     | "get_IsSome", Some c -> Test(c, OptionTest true, r) |> Some
     | "get_IsNone", Some c -> Test(c, OptionTest false, r) |> Some
     | _ -> None
 
-let optionModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) =
+let optionModule isStruct (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) =
     match i.CompiledName, args with
-    | "None", _ -> NewOption(None, t, false) |> makeValue r |> Some
+    | "None", _ -> NewOption(None, t, isStruct) |> makeValue r |> Some
     | "GetValue", [c] -> getOptionValue r t c |> Some
     | "IsSome", [c] -> Test(c, OptionTest true, r) |> Some
     | "IsNone", [c] -> Test(c, OptionTest false, r) |> Some
@@ -2708,10 +2709,11 @@ let private replacedModules =
     Types.queue, bclType
     Types.iset, hashSets
     Types.idisposable, disposables
-    Types.option, options
-    Types.valueOption, options
+    Types.option, options false
+    Types.valueOption, options true
     "System.Nullable`1", nullables
-    "Microsoft.FSharp.Core.OptionModule", optionModule
+    "Microsoft.FSharp.Core.OptionModule", optionModule false
+    "Microsoft.FSharp.Core.ValueOption", optionModule true
     "Microsoft.FSharp.Core.ResultModule", results
     Types.bigint, bigints
     "Microsoft.FSharp.Core.NumericLiterals.NumericLiteralI", bigints
@@ -2892,7 +2894,7 @@ let tryType = function
         Some(getNumberFullName false kind info, f, [])
     | String -> Some(Types.string, strings, [])
     | Tuple(genArgs, _) as t -> Some(getTypeFullName false t, tuples, genArgs)
-    | Option(genArg, _) -> Some(Types.option, options, [genArg])
+    | Option(genArg, isStruct) -> Some(Types.option, options isStruct, [genArg])
     | Array(genArg,_) -> Some(Types.array, arrays, [genArg])
     | List genArg -> Some(Types.list, lists, [genArg])
     | Builtin kind ->

diff --git a/src/fable-library/Reflection.ts b/src/fable-library/Reflection.ts
@@ -18,6 +18,11 @@ export class CaseInfo {
   }
 }
 
+export const enum ErasedUnion {
+  Default,
+  WithTag
+}
+
 export type EnumCase = [string, number];
 
 export class MethodInfo {
@@ -32,13 +37,21 @@ export class MethodInfo {
 export class TypeInfo implements IEquatable<TypeInfo> {
   constructor(
     public fullname: string,
-    public generics?: TypeInfo[],
-    public construct?: Constructor,
-    public parent?: TypeInfo,
-    public fields?: () => FieldInfo[],
-    public cases?: () => CaseInfo[],
-    public enumCases?: EnumCase[]) {
-  }
+    private info?: {
+      generics?: TypeInfo[],
+      construct?: Constructor,
+      parent?: TypeInfo,
+      fields?: () => FieldInfo[],
+      cases?: () => CaseInfo[],
+      enumCases?: EnumCase[],
+    }
+  ) { }
+  public get generics() { return this.info?.generics; }
+  public get construct() { return this.info?.construct; }
+  public get parent() { return this.info?.parent; }
+  public get fields() { return this.info?.fields; }
+  public get cases() { return this.info?.cases; }
+  public get enumCases() { return this.info?.enumCases; }
   public toString() {
     return fullName(this);
   }
@@ -83,59 +96,74 @@ export function class_type(
   generics?: TypeInfo[],
   construct?: Constructor,
   parent?: TypeInfo): TypeInfo {
-  return new TypeInfo(fullname, generics, construct, parent);
+  return new TypeInfo(fullname, { generics, construct, parent });
 }
 
 export function record_type(
   fullname: string,
   generics: TypeInfo[],
   construct: Constructor,
   fields: () => FieldInfo[]): TypeInfo {
-  return new TypeInfo(fullname, generics, construct, undefined, fields);
+  return new TypeInfo(fullname, { generics, construct, fields });
 }
 
 export function anonRecord_type(...fields: FieldInfo[]): TypeInfo {
-  return new TypeInfo("", undefined, undefined, undefined, () => fields);
+  return new TypeInfo("", { fields: () => fields });
 }
 
 export function union_type(
   fullname: string,
   generics: TypeInfo[],
   construct: Constructor,
   cases: () => FieldInfo[][]): TypeInfo {
-  const t: TypeInfo = new TypeInfo(fullname, generics, construct, undefined, undefined, () => {
-    const caseNames = construct.prototype.cases() as string[];
-    return cases().map((fields, i) => new CaseInfo(t, i, caseNames[i], fields))
+  const t: TypeInfo = new TypeInfo(fullname, {
+    generics,
+    construct,
+    cases() {
+      const caseNames = construct.prototype.cases() as string[];
+      return cases().map((fields, i) => new CaseInfo(t, i, caseNames[i], fields))
+    }
   });
   return t;
 }
 
 export function tuple_type(...generics: TypeInfo[]): TypeInfo {
-  return new TypeInfo("System.Tuple`" + generics.length, generics);
+  return new TypeInfo("System.Tuple`" + generics.length, { generics });
 }
 
 export function delegate_type(...generics: TypeInfo[]): TypeInfo {
-  return new TypeInfo("System.Func`" + generics.length, generics);
+  return new TypeInfo("System.Func`" + generics.length, { generics });
 }
 
 export function lambda_type(argType: TypeInfo, returnType: TypeInfo): TypeInfo {
-  return new TypeInfo("Microsoft.FSharp.Core.FSharpFunc`2", [argType, returnType]);
+  return new TypeInfo("Microsoft.FSharp.Core.FSharpFunc`2", {
+    generics: [argType, returnType]
+  });
 }
 
 export function option_type(generic: TypeInfo): TypeInfo {
-  return new TypeInfo("Microsoft.FSharp.Core.FSharpOption`1", [generic]);
+  return new TypeInfo("Microsoft.FSharp.Core.FSharpOption`1", {
+    generics: [generic]
+  });
 }
 
 export function list_type(generic: TypeInfo): TypeInfo {
-  return new TypeInfo("Microsoft.FSharp.Collections.FSharpList`1", [generic]);
+  return new TypeInfo("Microsoft.FSharp.Collections.FSharpList`1", {
+    generics: [generic]
+  });
 }
 
 export function array_type(generic: TypeInfo): TypeInfo {
-  return new TypeInfo("[]", [generic]);
+  return new TypeInfo("[]", {
+    generics: [generic]
+  });
 }
 
 export function enum_type(fullname: string, underlyingType: TypeInfo, enumCases: EnumCase[]): TypeInfo {
-  return new TypeInfo(fullname, [underlyingType], undefined, undefined, undefined, undefined, enumCases);
+  return new TypeInfo(fullname, {
+    generics: [underlyingType],
+    enumCases
+  });
 }
 
 export function measure_type(fullname: string): TypeInfo {
@@ -262,7 +290,9 @@ export function isInstanceOfType(t: TypeInfo, o: any) {
  * but it should be enough for type comparison purposes
  */
 export function getGenericTypeDefinition(t: TypeInfo) {
-  return t.generics == null ? t : new TypeInfo(t.fullname, t.generics.map(() => obj_type));
+  return t.generics == null ? t : new TypeInfo(t.fullname, {
+    generics: t.generics.map(() => obj_type)
+  });
 }
 
 export function getEnumUnderlyingType(t: TypeInfo) {
@@ -452,12 +482,13 @@ export function makeTuple(values: any[], _t: TypeInfo): any {
 
 export function makeGenericType(t: TypeInfo, generics: TypeInfo[]): TypeInfo {
   return new TypeInfo(
-    t.fullname,
-    generics,
-    t.construct,
-    t.parent,
-    t.fields,
-    t.cases);
+    t.fullname, {
+      generics,
+      construct: t.construct,
+      parent: t.parent,
+      fields: t.fields,
+      cases: t.cases
+    });
 }
 
 export function createInstance(t: TypeInfo, consArgs?: any[]): any {

diff --git a/src/quicktest/QuickTest.fs b/src/quicktest/QuickTest.fs
@@ -79,10 +79,13 @@ let measureTime (f: unit -> unit): unit = emitJsStatement () """
 // testCase "Addition works" <| fun () ->
 //     2 + 2 |> equal 4
 
-[<Erase>]
+// [<Erase>]
 type MyRecord =
     { Foo: int }
 
+type MyRecord2 =
+    { Bar: MyRecord }
+
 let testMyRecord (r: MyRecord) =
     r.Foo
 
@@ -100,6 +103,18 @@ let test = function
 Zas 5.67890 |> test |> printfn "%s"
 Foo("oh", 3) |> test |> printfn "%s"
 
+[<Erase>]
+type WrappedNum = Num of int with
+    static member ( + ) (Num x, Num y) = 2 * (x + y) |> Num
+
+let add1 (x: WrappedNum) y = x + y
+
+let add2 (x: WrappedNum) y = x + Num y
+
+testCase "Can resolve custom operators on erased types" <| fun () -> // See #2915
+    add1 (Num 4) (Num 5) |> equal (Num 18)
+    add2 (Num 4) 5 |> equal (Num 18)
+
 (*
 module TaggedUnion =
     type Base<'Kind> =

diff --git a/tests/Js/Main/OptionTests.fs b/tests/Js/Main/OptionTests.fs
@@ -80,6 +80,14 @@ let tests =
         Option.isNone o2 |> equal false
         Option.isSome o2 |> equal true
 
+    testCase "ValueOption.isSome/isNone works" <| fun () ->
+        let o1: int voption = ValueNone
+        let o2 = ValueSome 5
+        ValueOption.isNone o1 |> equal true
+        ValueOption.isSome o1 |> equal false
+        ValueOption.isNone o2 |> equal false
+        ValueOption.isSome o2 |> equal true
+
     testCase "Option.IsSome/IsNone works" <| fun () ->
         let o1 = None
         let o2 = Some 5
@@ -88,6 +96,14 @@ let tests =
         o2.IsNone |> equal false
         o2.IsSome |> equal true
 
+    testCase "ValueOption.IsSome/IsNone works" <| fun () ->
+        let o1: int voption = ValueNone
+        let o2 = Some 5
+        o1.IsNone |> equal true
+        o1.IsSome |> equal false
+        o2.IsNone |> equal false
+        o2.IsSome |> equal true
+
     testCase "Option.iter works" <| fun () -> // See #198
         let mutable res = false
         let getOnlyOnce =