fix interpreter bugs and make it pass tests

.paket/Paket.Restore.targets

@@ -102,7 +102,11 @@
       <PaketRestoreRequired Condition=" '$(PaketRestoreLockFileHash)' == '' ">true</PaketRestoreRequired>
     </PropertyGroup>
 
-    <PropertyGroup Condition="'$(PaketPropsVersion)' != '5.174.2' ">
+	<!-- 
+		This value should match the version in the props generated by paket 
+		If they differ, this means we need to do a restore in order to ensure correct dependencies
+	-->
+    <PropertyGroup Condition="'$(PaketPropsVersion)' != '5.185.3' ">
       <PaketRestoreRequired>true</PaketRestoreRequired>
     </PropertyGroup>
 
@@ -183,6 +187,7 @@
         <ExcludeAssets Condition=" '%(PaketReferencesFileLinesInfo.Splits)' == '6' And %(PaketReferencesFileLinesInfo.CopyLocal) == 'false'">runtime</ExcludeAssets>
         <ExcludeAssets Condition=" '%(PaketReferencesFileLinesInfo.Splits)' != '6' And %(PaketReferencesFileLinesInfo.AllPrivateAssets) == 'exclude'">runtime</ExcludeAssets>
         <Publish Condition=" '$(PackAsTool)' == 'true' ">true</Publish>
+        <AllowExplicitVersion>true</AllowExplicitVersion>
       </PackageReference>
     </ItemGroup>
 

src/Fabulous.Cli/FromCompilerService.fs

@@ -30,7 +30,7 @@ let rec convExpr (e:FSharpExpr) : DExpr =
         let mrefR = convMemberRef memberOrFunc
         let typeArgs1R = convTypes typeArgs1
         let typeArgs2R = convTypes typeArgs2
-        let argExprsR = convExprs argExprs
+        let argExprsR = convArgExprs memberOrFunc argExprs
         match objExprOptR with 
         // FCS TODO: Fix quirk with extension members so this isn't needed
         | Some objExprR when memberOrFunc.IsExtensionMember || not memberOrFunc.IsInstanceMemberInCompiledCode  -> 
@@ -48,7 +48,7 @@ let rec convExpr (e:FSharpExpr) : DExpr =
     | BasicPatterns.LetRec(recursiveBindings, bodyExpr) -> DExpr.LetRec(List.mapToArray (map2 convLocalDef convExpr) recursiveBindings, convExpr bodyExpr)
     | BasicPatterns.NewArray(arrayType, argExprs) -> DExpr.NewArray(convType arrayType, convExprs argExprs)
     | BasicPatterns.NewDelegate(delegateType, delegateBodyExpr) -> DExpr.NewDelegate(convType delegateType, convExpr delegateBodyExpr)
-    | BasicPatterns.NewObject(objCtor, typeArgs, argExprs) -> DExpr.NewObject(convMemberRef objCtor, convTypes typeArgs, convExprs argExprs)
+    | BasicPatterns.NewObject(objCtor, typeArgs, argExprs) -> DExpr.NewObject(convMemberRef objCtor, convTypes typeArgs, convArgExprs objCtor argExprs)
     | BasicPatterns.NewRecord(recordType, argExprs) ->  DExpr.NewRecord(convType recordType, convExprs argExprs)
     | BasicPatterns.NewTuple(tupleType, argExprs) -> DExpr.NewTuple(convType tupleType, convExprs argExprs)
     | BasicPatterns.NewUnionCase(unionType, unionCase, argExprs) -> DExpr.NewUnionCase(convType unionType, convUnionCase unionCase, convExprs argExprs)
@@ -118,29 +118,74 @@ and convMemberDef (memb: FSharpMemberOrFunctionOrValue) : DMemberDef =
     { EnclosingEntity = convEntityRef memb.DeclaringEntity.Value
       Name = memb.CompiledName
       GenericParameters = convGenericParamDefs memb.GenericParameters
-      Parameters = convParamDefs memb.CurriedParameterGroups
+      Parameters = convParamDefs memb
       ReturnType = convReturnType memb
       IsInstance = memb.IsInstanceMemberInCompiledCode }
 
 and convMemberRef (memb: FSharpMemberOrFunctionOrValue) = 
     if not (memb.IsMember || memb.IsModuleValueOrMember) then failwith "can't convert non-member ref"
-    let paramTypesR = convParamTypes memb.CurriedParameterGroups
+    let paramTypesR = convParamTypes memb
 
     // TODO: extensions of generic type
     if memb.IsExtensionMember && memb.ApparentEnclosingEntity.GenericParameters.Count > 0 && not (memb.CompiledName = "ProgramRunner`2.EnableLiveUpdate") then 
        failwithf "NYI: extension of generic type, needs FCS support: %s" memb.CompiledName
 
-    let paramTypesR = if memb.IsExtensionMember then Array.append [| DNamedType (convEntityRef memb.ApparentEnclosingEntity, [| |]) |] paramTypesR else paramTypesR
     DMemberRef (convEntityRef memb.DeclaringEntity.Value, memb.CompiledName, memb.GenericParameters.Count, paramTypesR, convReturnType memb)
 
-and convParamTypes (parameters: IList<IList<FSharpParameter>>) = 
-    parameters |> Seq.concat |> Array.ofSeq |> Array.map (fun p -> p.Type) |> convTypes 
-
-and convParamDefs (parameters: IList<IList<FSharpParameter>>) = 
-    parameters |> Seq.concat |> Array.ofSeq |> Array.map (fun p -> { Name = p.DisplayName; IsMutable = false; Type = convType p.Type })
+and convParamTypes (memb: FSharpMemberOrFunctionOrValue) =
+    let parameters = memb.CurriedParameterGroups 
+    let paramTypesR = parameters |> Seq.concat |> Array.ofSeq |> Array.map (fun p -> p.Type) 
+    // TODO: FCS should do this unit arg elimination for us
+    let paramTypesR = 
+        match paramTypesR with 
+        | [| pty |] when memb.IsModuleValueOrMember && pty.HasTypeDefinition && pty.TypeDefinition.LogicalName = "unit" -> [| |]
+        | _ -> paramTypesR |> convTypes 
+    // TODO: FCS should do this instance --> static transformation for us
+    if memb.IsInstanceMember && not memb.IsInstanceMemberInCompiledCode then 
+        if memb.IsExtensionMember then 
+            Array.append [| DNamedType (convEntityRef memb.ApparentEnclosingEntity, [| |]) |] paramTypesR 
+        else
+            let instanceType = memb.FullType.GenericArguments.[0]
+            Array.append [| convType instanceType |] paramTypesR 
+    else 
+        paramTypesR 
+
+and convArgExprs (memb: FSharpMemberOrFunctionOrValue) exprs = 
+    let parameters = memb.CurriedParameterGroups 
+    let paramTypes = parameters |> Seq.concat |> Array.ofSeq |> Array.map (fun p -> p.Type) 
+    // TODO: FCS should do this unit arg elimination for us
+    match paramTypes, exprs with 
+    | [| pty |] , [ _expr ] when memb.IsModuleValueOrMember && pty.HasTypeDefinition && pty.TypeDefinition.LogicalName = "unit"  -> [| |]
+    | _ -> convExprs exprs
+
+and convParamDefs (memb: FSharpMemberOrFunctionOrValue) = 
+    let parameters = memb.CurriedParameterGroups 
+    // TODO: FCS should do this unit arg elimination for us
+    let parameters = 
+        match parameters |> Seq.concat |> Seq.toArray with 
+        | [| p |] when p.Type.HasTypeDefinition && p.Type.TypeDefinition.LogicalName = "unit" -> [| |]
+        | ps -> ps
+    let parametersR = 
+        parameters |> Array.map (fun p -> { Name = p.DisplayName; IsMutable = false; Type = convType p.Type })
+    if memb.IsInstanceMember && not memb.IsInstanceMemberInCompiledCode then 
+        if memb.IsExtensionMember then 
+            let instanceTypeR = DNamedType (convEntityRef memb.ApparentEnclosingEntity, [| |])
+            let thisParam = { Name = "$this"; IsMutable = false; Type = instanceTypeR }
+            Array.append [| thisParam |] parametersR
+        else
+            let instanceType = memb.FullType.GenericArguments.[0]
+            let thisParam = { Name = "$this"; IsMutable = false; Type = convType instanceType }
+            Array.append [| thisParam |] parametersR
+    else
+        parametersR
 
 and convParamDefs2 (parameters: FSharpMemberOrFunctionOrValue list list) = 
-    parameters |> Seq.concat |> Array.ofSeq |> Array.map (fun p -> { Name = p.DisplayName; IsMutable = false; Type = convType p.FullType })
+    // TODO: FCS should do this unit arg elimination for us
+    let parameters = 
+        match parameters |> Seq.concat |> Seq.toArray with 
+        | [| p |] when p.FullType.HasTypeDefinition && p.FullType.TypeDefinition.LogicalName = "unit" -> [| |]
+        | ps -> ps
+    parameters |> Array.map (fun p -> { Name = p.DisplayName; IsMutable = false; Type = convType p.FullType })
 
 and convReturnType (memb: FSharpMemberOrFunctionOrValue) = 
     convType memb.ReturnParameter.Type

src/Fabulous.Cli/Interpreter.fs

@@ -399,20 +399,22 @@ type EvalContext ()  =
                 | _res -> 
                     let (RTypesOrObj paramTysV) = ctxt.ResolveTypes (formalEnv, paramTys)
                     match entityType.GetConstructor(bindAll, null, paramTysV, null) with 
-                    | null -> ctxt.InterpMethod(formalEnv, eR, nm, paramTys)
+                    | null -> failwithf "couldn't bind constructor %A for %A" v entityType //ctxt.InterpMethod(formalEnv, eR, nm, paramTys)
                     | cinfo -> RMethod cinfo
             else
                 match entityType.GetMethods(bindAll) |> Array.filter (fun m -> m.Name = nm && m.GetParameters().Length = n) with 
                 | [| minfo |] -> ctxt.MakeRMethod minfo
                 | [| |] when n = 0 && genericParams = 0 -> 
                     // FCS QUIRK TODO: cleanup FCS and portacode so names of properties are never used
                     match entityType.GetProperty(nm, bindAll) with 
-                    | null -> ctxt.InterpMethod(formalEnv, eR, nm, paramTys)
+                    | null -> failwithf "couldn't bind method %A for %A" v entityType //ctxt.InterpMethod(formalEnv, eR, nm, paramTys)
+                    //| null -> ctxt.InterpMethod(formalEnv, eR, nm, paramTys)
                     | pinfo  -> ctxt.MakeRMethod pinfo.GetMethod
                 | _res -> 
                     let (RTypesOrObj paramTysV) = ctxt.ResolveTypes (formalEnv, paramTys)
                     match entityType.GetMethod(nm, bindAll, null, paramTysV, null) with 
-                    | null -> ctxt.InterpMethod(formalEnv, eR, nm, paramTys)
+                    | null -> failwithf "couldn't bind property %A for %A" v entityType //ctxt.InterpMethod(formalEnv, eR, nm, paramTys)
+                    //| null -> ctxt.InterpMethod(formalEnv, eR, nm, paramTys)
                     | minfo -> RMethod minfo
         | eR -> 
             ctxt.InterpMethod(formalEnv, eR, nm, paramTys)
@@ -427,11 +429,12 @@ type EvalContext ()  =
                 // Override any existing resolution
                 entityResolutions.[DEntityRef entityName] <- UEntity entityDef
                 ctxt.AddDecls(subDecls)
-            | DDeclMember (membDef, _body) when membDef.Parameters.Length = 0 && membDef.GenericParameters.Length = 0 -> ()
+            // TODO: static member properties will be evaluated eagerly incorrectly
+            | DDeclMember (membDef, _body) when not (membDef.Name = ".ctor") && not membDef.IsInstance && membDef.Parameters.Length = 0 && membDef.GenericParameters.Length = 0 -> ()
             | DDeclMember (membDef, body) -> 
                 let ty = ctxt.ResolveEntity(membDef.EnclosingEntity)
-                let paramTypes = membDef.Parameters |> Array.map (fun p -> p.Type)
-                let paramTypesR = ctxt.ResolveTypes(env, paramTypes)
+                let paramTypes = membDef.Parameters |> Array.map (fun p -> p.Type) 
+                let paramTypesR = ctxt.ResolveTypes(env, paramTypes) 
                 let thunk = ctxt.EvalMethodLambda (envEmpty, (membDef.Name = ".ctor"), membDef.IsInstance, membDef.GenericParameters, membDef.Parameters, body)
                 members.[(ty, membDef.Name, paramTypesR)] <- Value thunk
             | _ -> ()
@@ -456,7 +459,7 @@ type EvalContext ()  =
         for d in decls do
             match d with 
             | DDeclEntity (_e, subDecls) -> ctxt.EvalDecls(env, subDecls)
-            | DDeclMember (membDef, body) when membDef.Parameters.Length = 0 && membDef.GenericParameters.Length = 0 -> 
+            | DDeclMember (membDef, body) when not (membDef.Name = ".ctor") && not membDef.IsInstance && membDef.Parameters.Length = 0 && membDef.GenericParameters.Length = 0 -> 
                 let ty = ctxt.ResolveEntity(membDef.EnclosingEntity)
                 let res = ctxt.EvalExpr (env, body)
                 members.[(ty, membDef.Name, RTypes [| |])] <- res

src/Fabulous.Cli/fscd.fs

@@ -36,7 +36,7 @@ module MockForms =
             member __.CreateTicker() = raise (NotImplementedException())
             member __.StartTimer(interval, callback) =  raise (NotImplementedException())
             member __.GetStreamAsync(uri, cancellationToken) = raise (NotImplementedException())
-            member __.GetAssemblies() = raise (NotImplementedException())
+            member __.GetAssemblies() = [| |] // raise (NotImplementedException())
             member __.GetUserStoreForApplication() = raise (NotImplementedException())
             member __.QuitApplication() = raise (NotImplementedException())
 
@@ -47,7 +47,7 @@ module MockForms =
 
     type MockResourcesProvider() = 
         interface ISystemResourcesProvider with 
-            member __.GetSystemResources() = raise (NotImplementedException())
+            member __.GetSystemResources() = (ResourceDictionary() :> IResourceDictionary) // raise (NotImplementedException())
 
     type MockDeviceInfo() = 
         inherit DeviceInfo()

tests/Fabulous.Cli.Tests/Tests.fs

@@ -183,16 +183,21 @@ PROJ.fs"""
 -r:PACKAGEDIR/xamarin.forms/XAMARINFORMSVERSION/lib/netstandard2.0/Xamarin.Forms.Xaml.dll
 """
 
-    let SimpleTestCase name code =
+    let GeneralTestCase name code refs =
         let directory = __SOURCE_DIRECTORY__ + "/data"
         Directory.CreateDirectory directory |> ignore
         Environment.CurrentDirectory <- directory
         File.WriteAllText (name + ".fs", """
 module TestCode
 """ + code)
-        createNetStandardProjectArgs name ""
+        createNetStandardProjectArgs name refs
 
         Assert.AreEqual(0, FSharpDaemon.Driver.main( [| "dummy.exe"; "--eval"; "@" + name + ".args.txt" |]))
+
+    let SimpleTestCase name code = GeneralTestCase name code ""
+
+    let ElmishTestCase name code = GeneralTestCase name code elmishExtraRefs
+
     [<TestMethod>]
     member this.TestCanEvaluateCounterApp () =
         Environment.CurrentDirectory <- __SOURCE_DIRECTORY__ + "/../../Samples/CounterApp/CounterApp"
@@ -297,6 +302,46 @@ let y = C(3)
 let z = if y.X <> 3 then failwith "fail!" else 1
         """
 
+    [<TestMethod>]
+    member this.TestExtrinsicFSharpExtensionOnClass1() =
+        SimpleTestCase "TestExtrinsicFSharpExtensionOnClass1" """
+type System.String with 
+    member x.GetLength() = x.Length
+
+let y = "a".GetLength() 
+let z = if y <> 1 then failwith "fail!" else 1
+        """
+
+    [<TestMethod>]
+    member this.TestExtrinsicFSharpExtensionOnClass2() =
+        SimpleTestCase "TestExtrinsicFSharpExtensionOnClass2" """
+type System.String with 
+    member x.GetLength2(y:int) = x.Length + y
+
+let y = "ab".GetLength2(5) 
+let z = if y <> 7 then failwith "fail!" else 1
+        """
+
+    [<TestMethod>]
+    member this.TestExtrinsicFSharpExtensionOnClass3() =
+        SimpleTestCase "TestExtrinsicFSharpExtensionOnClass3" """
+type System.String with 
+    static member GetLength3(x:string) = x.Length
+
+let y = System.String.GetLength3("abc") 
+let z = if y <> 3 then failwith "fail!" else 1
+        """
+
+    [<TestMethod>]
+    member this.TestExtrinsicFSharpExtensionOnClass4() =
+        SimpleTestCase "TestExtrinsicFSharpExtensionOnClass4" """
+type System.String with 
+    member x.LengthProp = x.Length
+
+let y = "abcd".LengthProp
+let z = if y <> 4 then failwith "fail!" else 1
+        """
+
     [<TestMethod>]
     member this.TestEvalSetterOnClass() =
         SimpleTestCase "TestEvalSetterOnClass" """
@@ -310,6 +355,12 @@ c.Y <- 4
 if c.Y <> 4 then failwith "fail! fail!" 
         """
 
+    [<TestMethod>]
+    member this.TestLengthOnList() =
+        SimpleTestCase "TestLengthOnList" """
+let x = [1;2;3].Length
+if x <> 3 then failwith "fail! fail!" 
+        """
 // Known limitation of FSharp Compiler Service
 //    [<TestMethod>]
 //    member this.TestEvalLocalFunctionOnClass() =
@@ -403,6 +454,18 @@ let f() =
 f()
        """
 
+    [<TestMethod>]
+    member this.ViewRefSmoke() =
+        ElmishTestCase "ViewRefSmoke" """
+let theRef = Fabulous.DynamicViews.ViewRef<Xamarin.Forms.Label>()
+       """
+
+    [<TestMethod>]
+    member this.TestCallUnitFunction() =
+        ElmishTestCase "TestCallUnitFunction" """
+let theRef = FSharp.Core.LanguagePrimitives.GenericZeroDynamic<int>()
+       """
+
 
 // tests needed:
 //   2D arrays