This commit is contained in:
Don Syme 2018-07-11 14:25:03 +01:00
Родитель 20c66e6a1a
Коммит f3a591bfe4
41 изменённых файлов: 12617 добавлений и 8996 удалений

8
.nuget/NuGet.config Normal file
Просмотреть файл

@ -0,0 +1,8 @@
<?xml version="1.0" encoding="utf-8"?>
<configuration>
<packageSources>
<add key="NuGet official package source" value="https://api.nuget.org/v3/index.json" />
<add key="myget.org" value="https://www.myget.org/F/oxyplot" />
</packageSources>
</configuration>

Просмотреть файл

@ -0,0 +1,17 @@
// Auto-Generated by FAKE; do not edit
namespace System
open System.Reflection
[<assembly: AssemblyTitleAttribute("Elmish.XamarinForms.LiveUpdate")>]
[<assembly: AssemblyProductAttribute("Elmish.XamarinForms.LiveUpdate")>]
[<assembly: AssemblyDescriptionAttribute("F# Functional App Dev Framework Live Update")>]
[<assembly: AssemblyVersionAttribute("0.12.10")>]
[<assembly: AssemblyFileVersionAttribute("0.12.10")>]
do ()
module internal AssemblyVersionInformation =
let [<Literal>] AssemblyTitle = "Elmish.XamarinForms.LiveUpdate"
let [<Literal>] AssemblyProduct = "Elmish.XamarinForms.LiveUpdate"
let [<Literal>] AssemblyDescription = "F# Functional App Dev Framework Live Update"
let [<Literal>] AssemblyVersion = "0.12.10"
let [<Literal>] AssemblyFileVersion = "0.12.10"

Просмотреть файл

@ -0,0 +1,20 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<TargetFramework>netstandard2.0</TargetFramework>
<OtherFlags>/warnon:1182</OtherFlags>
</PropertyGroup>
<ItemGroup>
<Compile Include="..\fscd\CodeModel.fs" Link="CodeModel.fs" />
<Compile Include="..\fscd\Interpreter.fs" Link="Interpreter.fs" />
<None Include="paket.template" />
<Compile Include="AssemblyInfo.fs" />
<Compile Include="LiveUpdate.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.Core" Version="4.5.0" />
<PackageReference Include="Xamarin.Forms" Version="3.0.0.482510" />
<PackageReference Include="FsPickler" Version="5.2.0" />
<PackageReference Include="FsPickler.Json" Version="5.2.0" />
<ProjectReference Include="..\Elmish.XamarinForms\Elmish.XamarinForms.fsproj" />
</ItemGroup>
</Project>

Просмотреть файл

@ -0,0 +1,239 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
namespace Elmish.XamarinForms
open System
open System.Net
open System.Net.Sockets
open System.Net.NetworkInformation
open System.IO
open System.Text
open Elmish.XamarinForms
open Elmish.XamarinForms.DynamicViews
open FSharp.Compiler.PortaCode.CodeModel
open FSharp.Compiler.PortaCode.Interpreter
module Ports =
let DefaultPort = 9867
let BroadcasterPort = 8098
let BroadcasterReceiverPort = 8099
[<CLIMutable>]
type UpdateResponse =
{ Quacked: string }
[<CLIMutable>]
type BroadcasterAddress =
{ Address: string
Port: int
Interface : string }
[<CLIMutable>]
type Broadcaster =
{ DeviceName: string
Addresses : BroadcasterAddress[]
DeviceModel : string }
static member Start(?httpPort) =
let broadcastEndpoint = new IPEndPoint(IPAddress.Broadcast, Ports.BroadcasterReceiverPort)
let httpPort = defaultArg httpPort Ports.DefaultPort
let serializer = MBrace.FsPickler.Json.FsPickler.CreateJsonSerializer()
do
async {
while true do
let client = new UdpClient (Ports.BroadcasterPort, EnableBroadcast = true)
let iips =
[| for x in NetworkInterface.GetAllNetworkInterfaces () do
if x.NetworkInterfaceType <> NetworkInterfaceType.Loopback &&
not (x.Name.StartsWith ("pdp_ip", StringComparison.Ordinal)) &&
x.OperationalStatus = OperationalStatus.Up then
for y in x.GetIPProperties().UnicastAddresses do
if y.Address.AddressFamily = AddressFamily.InterNetwork then
yield { Address = y.Address.ToString ()
Port = httpPort
Interface = x.Name } |]
let broadcast =
{ DeviceName = "Device"
DeviceModel = "Model"
Addresses = iips }
for iip in iips do
printfn "LiveUpdate: broadcasting address %s. Access via http://localhost:%d/ if you have run 'adb -d forward tcp:%d tcp:%d'" iip.Address httpPort httpPort httpPort
let json = serializer.PickleToString (broadcast)
let bytes = System.Text.Encoding.UTF8.GetBytes (json)
try
client.Send (bytes, bytes.Length, broadcastEndpoint) |> ignore
with e ->
printfn "LiveUpdate: error on broadcast: %A" e.Message
do! Async.Sleep 5000 } |> Async.Start
type HttpServer(?port) =
let port = defaultArg port Ports.DefaultPort
do Broadcaster.Start()
member x.Run (switchD) =
let _syncCtxt = System.Threading.SynchronizationContext.Current
async {
// Run this on the host machine
(*
adb -d forward --list
USB:
adb -d forward tcp:9867 tcp:9867
EMULATOR:
adb -e forward tcp:9867 tcp:9867
*)
// netsh http add urlacl url=http://*:9867/ user=System.Environment.UserDomainName
let url = sprintf "http://*:%d/" port
let serializer = MBrace.FsPickler.Json.FsPickler.CreateJsonSerializer()
let listener = new HttpListener ()
listener.Prefixes.Add (url)
try
listener.Start ()
while true do
printfn "LiveUpdate: listening on url = %s" url
let! c = listener.GetContextAsync () |> Async.AwaitTask
let path = c.Request.Url.AbsolutePath
printfn "LiveUpdate: got request, path = = %s" url
use resp = c.Response
try
let! (resString : string) =
async {
//if (path = "/switch") then
// //let req = serializer.UnPickleOfString<UpdatePackage>(requestText)
// let resp = switch ()
// return serializer.PickleToString resp
if (path = "/update") then
let reader = new StreamReader (c.Request.InputStream, Encoding.UTF8)
let! requestText = reader.ReadToEndAsync () |> Async.AwaitTask
let req = serializer.UnPickleOfString<DFile>(requestText)
let resp = switchD req
return serializer.PickleToString resp
else
return """
<html>
<body>
<p>Welcome to LiveUpdate web api. The valid API is:</p>
<p> - PUT '<a href="/update">/update</a>'</p>
<br />
<p>To set up watcher for Android use:</p>
<pre> adb -d forward tcp:PORT tcp:PORT (USB)</pre>
<pre> adb -e forward tcp:PORT tcp:PORT (Emulator)</pre>
<p> then</p>
<pre> cd MyApp\MyApp</pre>
<pre> %USERPROFILE%\.nuget\packages\Elmish.XamarinForms.LiveUpdate\0.13.0\tools\fscd.exe --watch --webhook:http://localhost:PORT/update -- @proj.args</pre>
<p>where proj.args contains the compilation arguments for your project (you must currently create this manually)</p>
</body>
</html>"""
|> fun s -> s.Replace("PORT", string port)
}
printfn "LiveUpdate: setting response code to 200, response = %s" resString
let bytes = Encoding.UTF8.GetBytes (resString)
resp.StatusCode <- 200
resp.ContentLength64 <- bytes.LongLength
do! c.Response.OutputStream.WriteAsync (bytes, 0, bytes.Length) |> Async.AwaitTask
with ex ->
let msg = "<html><body><pre>" + ex.ToString() + "</pre></body></html>"
printfn "setting response code to 500, msg = %s" msg
let bytes = Encoding.UTF8.GetBytes msg
resp.StatusCode <- 500
resp.ContentLength64 <- bytes.LongLength
do! c.Response.OutputStream.WriteAsync (bytes, 0, bytes.Length) |> Async.AwaitTask
with :? HttpListenerException as ex ->
printfn "couldn't start listener %s" (ex.ToString())
} |> Async.Start
/// Program module - functions to manipulate program instances
[<AutoOpen>]
module Extensions =
let rec tryFindEntityByName name (decls: DDecl[]) =
decls |> Array.tryPick (function
| DDeclEntity (entityDef, subDecls) -> if entityDef.Name = name then Some (entityDef, subDecls) else tryFindEntityByName name subDecls
| _ -> None)
let rec tryFindMemberByName name (decls: DDecl[]) =
decls |> Array.tryPick (function
| DDeclEntity (_, ds) -> tryFindMemberByName name ds
| DDeclMember (membDef, body) -> if membDef.Name = name then Some (membDef, body) else None
| _ -> None)
/// Trace all the updates to the console
type ProgramRunner<'model,'msg> with
member runner.EnableLiveUpdate() =
let interp = EvalContext()
let switchD (arg: DFile) =
lock interp (fun () ->
printfn "LiveUpdate: adding declarations...."
interp.AddDecls arg.Code
printfn "LiveUpdate: evaluating decls in code package for side effects...."
interp.EvalDecls (envEmpty, arg.Code)
let programOptD =
match tryFindMemberByName "programLiveUpdate" arg.Code with
| Some d -> Some d
| None ->
match tryFindMemberByName "program" arg.Code with
| None -> None
| Some d -> Some d
match programOptD with
| None ->
printfn "*** LiveUpdate failure:"
printfn "*** [x] got code pacakge"
printfn "*** FAIL: couldn't find declaration called 'program' or 'programLiveUpdate'"
{ Quacked = "couldn't quack! No declaration called 'program' or 'programLiveUpdate'!" }
| Some (membDef, _) ->
if membDef.Parameters.Length > 0 then
printfn "*** LiveUpdate failure:"
printfn "*** [x] got code pacakge"
printfn "*** [x] found declaration called 'programLiveUpdate' or 'program'"
printfn "*** FAIL: the declaration has parameters, it must be a single top-level value"
{ Quacked = "couldn't quack! Found declaration called 'program' or 'programLiveUpdate' but the declaration has parameters!" }
else
printfn "LiveUpdate: evaluating 'program'...."
let entity = interp.ResolveEntity(membDef.EnclosingEntity)
let programObj = interp.GetExprDeclResult(entity, membDef.Name)
match getVal programObj with
| :? Program<obj, obj, obj -> (obj -> unit) -> ViewElement> as programErased ->
// Stop the running program
printfn "changing running program...."
runner.ChangeProgram(programErased)
printfn "*** LiveUpdate failure:"
printfn "*** [x] got code pacakge"
printfn "*** [x] found declaration called 'programLiveUpdate' or 'program'"
printfn "*** [x] it had no parameters (good!)"
printfn "*** [x] the declaration had the right type"
printfn "*** [x] changed the running program"
{ Quacked = "LiveUpdate quacked!" }
| p ->
printfn "*** LiveUpdate failure:"
printfn "*** [x] got code pacakge"
printfn "*** [x] found declaration called 'programLiveUpdate' or 'program'"
printfn "*** [x] it had no parameters (good!)"
printfn "*** FAIL: the declaration had the wrong type '%A', expected 'Program<Model, Msg, Model -> (Msg-> unit) -> ViewElement>'" (p.GetType())
{ Quacked = "LiveUpdate couldn't quack! types mismatch!" }
)
let server = HttpServer()
server.Run(switchD)

Просмотреть файл

@ -0,0 +1,29 @@
type file
id Elmish.XamarinForms
version 0.0
authors Elmish.XamarinForms Contributors
description
F# bindings for using elmish in Xamarin.Forms
tags
Xamarin.Forms F# Elmish Elm
projectUrl
https://github.com/fsprojects/Elmish.XamarinForms
licenseUrl
https://github.com/fsprojects/Elmish.XamarinForms/blob/master/LICENSE.md
requireLicenseAcceptance false
files
../build_output/Elmish.XamarinForms.LiveUpdate.dll ==> lib/netstandard2.0
../build_output/tools/fscd.exe ==> tools
../build_output/tools/FSharp.Core.dll ==> tools
../build_output/tools/FSharp.Compiler.Service.dll ==> tools
../build_output/tools/System.Collections.Immutable.dll ==> tools
../build_output/tools/System.Reflection.Metadata.dll ==> tools
../build_output/tools/FSharp.Core.resources.dll ==> tools
../build_output/tools/FsPickler.dll ==> tools
../build_output/tools/FsPickler.Json.dll ==> tools
dependencies
FSharp.Core >= LOCKEDVERSION-neutral
Xamarin.Forms >= LOCKEDVERSION-neutral
FsPickler >= LOCKEDVERSION-neutral
FsPickler.Json >= LOCKEDVERSION-neutral
Elmish.XamarinForms ~> CURRENTVERSION

Просмотреть файл

@ -5,6 +5,8 @@ VisualStudioVersion = 15.0.27004.2006
MinimumVisualStudioVersion = 10.0.40219.1
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Elmish.XamarinForms", "Elmish.XamarinForms\Elmish.XamarinForms.fsproj", "{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FD}"
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Elmish.XamarinForms.LiveUpdate", "Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj", "{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}"
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Elmish.XamarinForms.Maps", "extensions\Maps\Elmish.XamarinForms.Maps.fsproj", "{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FE}"
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Elmish.XamarinForms.SkiaSharp", "extensions\SkiaSharp\Elmish.XamarinForms.SkiaSharp.fsproj", "{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FF}"
@ -49,6 +51,10 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "CounterApp.iOS", "Samples\C
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Generator", "Generator\Generator.fsproj", "{10DF5D2F-17FA-43DE-9549-B84E6CF26602}"
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "fscd", "fscd\fscd.fsproj", "{23640E46-E830-4AB7-9289-E527F6429435}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "fscd.Tests", "fscd.Tests\fscd.Tests.fsproj", "{810EEB40-5042-4946-B695-5B13E9957807}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
@ -77,6 +83,22 @@ Global
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FD}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FD}.Release|x86.ActiveCfg = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FD}.Release|x86.Build.0 = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|Any CPU.Build.0 = Debug|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|iPhone.ActiveCfg = Debug|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|iPhone.Build.0 = Debug|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|iPhoneSimulator.ActiveCfg = Debug|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|iPhoneSimulator.Build.0 = Debug|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|x86.ActiveCfg = Debug|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|x86.Build.0 = Debug|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|Any CPU.ActiveCfg = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|Any CPU.Build.0 = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|iPhone.ActiveCfg = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|iPhone.Build.0 = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|iPhoneSimulator.ActiveCfg = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|x86.ActiveCfg = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|x86.Build.0 = Release|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FE}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FE}.Debug|Any CPU.Build.0 = Debug|Any CPU
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FE}.Debug|iPhone.ActiveCfg = Debug|Any CPU
@ -345,6 +367,38 @@ Global
{10DF5D2F-17FA-43DE-9549-B84E6CF26602}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
{10DF5D2F-17FA-43DE-9549-B84E6CF26602}.Release|x86.ActiveCfg = Release|Any CPU
{10DF5D2F-17FA-43DE-9549-B84E6CF26602}.Release|x86.Build.0 = Release|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|Any CPU.Build.0 = Debug|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|iPhone.ActiveCfg = Debug|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|iPhone.Build.0 = Debug|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|iPhoneSimulator.ActiveCfg = Debug|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|iPhoneSimulator.Build.0 = Debug|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|x86.ActiveCfg = Debug|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|x86.Build.0 = Debug|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Release|Any CPU.ActiveCfg = Release|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Release|Any CPU.Build.0 = Release|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Release|iPhone.ActiveCfg = Release|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Release|iPhone.Build.0 = Release|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Release|iPhoneSimulator.ActiveCfg = Release|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Release|x86.ActiveCfg = Release|Any CPU
{23640E46-E830-4AB7-9289-E527F6429435}.Release|x86.Build.0 = Release|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|Any CPU.Build.0 = Debug|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|iPhone.ActiveCfg = Debug|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|iPhone.Build.0 = Debug|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|iPhoneSimulator.ActiveCfg = Debug|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|iPhoneSimulator.Build.0 = Debug|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|x86.ActiveCfg = Debug|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|x86.Build.0 = Debug|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Release|Any CPU.ActiveCfg = Release|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Release|Any CPU.Build.0 = Release|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Release|iPhone.ActiveCfg = Release|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Release|iPhone.Build.0 = Release|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Release|iPhoneSimulator.ActiveCfg = Release|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Release|x86.ActiveCfg = Release|Any CPU
{810EEB40-5042-4946-B695-5B13E9957807}.Release|x86.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE

Просмотреть файл

@ -1,4 +1,4 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
// Copyright 2018 Elmish and Elmish.XamarinForms contributors. See LICENSE.md for license.
namespace Elmish.XamarinForms
open System
@ -17,9 +17,12 @@ module Values =
type internal ProgramDispatch<'msg>() =
static let mutable dispatchImpl = (fun (_msg: 'msg) -> failwith "do not call dispatch during initialization" : unit)
static let dispatch = id (fun msg -> dispatchImpl msg)
static let dispatch =
id (fun msg ->
dispatchImpl msg)
static member Dispatch with get () = dispatch and set v = dispatchImpl <- v
static member DispatchViaThunk = dispatch
static member SetDispatchThunk v = dispatchImpl <- v
/// Program type captures various aspects of program behavior
type Program<'model, 'msg, 'view> =
@ -31,28 +34,30 @@ type Program<'model, 'msg, 'view> =
onError : (string*exn) -> unit }
/// Starts the Elmish dispatch loop for the page with the given Elmish program
type ProgramRunner<'model, 'msg>(app: Application, program: Program<'model, 'msg, _>) =
type ProgramRunner<'model, 'msg>(app: Application, program: Program<'model, 'msg, 'model -> ('msg -> unit) -> ViewElement>) =
do Debug.WriteLine "run: computing initial model"
// Get the initial model
let (initialModel,cmd) = program.init ()
let mutable alternativeRunner : ProgramRunner<obj,obj> option = None
let mutable lastModel = initialModel
let mutable lastViewDataOpt = None
let dispatch = ProgramDispatch<'msg>.Dispatch
let dispatch = ProgramDispatch<'msg>.DispatchViaThunk
let mutable reset = (fun () -> ())
// If the view is dynamic, create the initial page
let viewInfo, mainPage =
let pageDescription : ViewElement = program.view initialModel dispatch
let pageObj = pageDescription.Create()
let pageElement : ViewElement = program.view initialModel dispatch
let pageObj = pageElement.Create()
let mainPage =
match pageObj with
| :? Page as page -> page
| _ -> failwithf "Incorrect model type: expected a page but got a %O" (pageObj.GetType())
app.MainPage <- mainPage
//app.Properties.["model"] <- initialModel
(pageDescription), mainPage
pageElement, mainPage
// Start Elmish dispatch loop
let rec processMsg msg =
@ -76,21 +81,27 @@ type ProgramRunner<'model, 'msg>(app: Application, program: Program<'model, 'msg
| None ->
lastViewDataOpt <- Some viewInfo
| Some prevPageDescription ->
let newPageDescription: ViewElement = program.view updatedModel dispatch
if canReuseChild prevPageDescription newPageDescription then
newPageDescription.UpdateIncremental (prevPageDescription, app.MainPage)
| Some prevPageElement ->
let newPageElement: ViewElement = program.view updatedModel dispatch
if canReuseChild prevPageElement newPageElement then
newPageElement.UpdateIncremental (prevPageElement, app.MainPage)
else
let pageObj = newPageDescription.Create()
let pageObj = newPageElement.Create()
match pageObj with
| :? Page as page -> app.MainPage <- page
| _ -> failwithf "Incorrect model type: expected a page but got a %O" (pageObj.GetType())
lastViewDataOpt <- Some newPageDescription
lastViewDataOpt <- Some newPageElement
do
// Set up the global dispatch function
ProgramDispatch<'msg>.Dispatch <- (fun msg -> Device.BeginInvokeOnMainThread(fun () -> processMsg msg))
ProgramDispatch<'msg>.SetDispatchThunk (fun msg ->
Device.BeginInvokeOnMainThread(fun () ->
processMsg msg))
reset <- (fun () ->
Device.BeginInvokeOnMainThread(fun () ->
updateView lastModel))
Debug.WriteLine "updating the initial view"
@ -103,14 +114,32 @@ type ProgramRunner<'model, 'msg>(app: Application, program: Program<'model, 'msg
member __.InitialMainPage = mainPage
member __.CurrentModel = lastModel
member runner.ChangeProgram(newProgram: Program<obj, obj, obj -> (obj -> unit) -> ViewElement>) : unit =
Device.BeginInvokeOnMainThread(fun () ->
// TODO: transmogrify the model
alternativeRunner <- Some (ProgramRunner<obj, obj>(app, newProgram))
)
member __.ResetView() : unit =
Device.BeginInvokeOnMainThread(fun () ->
match alternativeRunner with
| Some r -> r.ResetView()
| None -> reset()
)
/// Set the current model, e.g. on resume
member __.SetCurrentModel(model, cmd: Cmd<_>) =
Debug.WriteLine "updating the view after setting the model"
lastModel <- model
updateView model
for sub in program.subscribe model @ cmd do
sub dispatch
Device.BeginInvokeOnMainThread(fun () ->
match alternativeRunner with
| Some _ -> failwith "SetCurrentModel: can't access runner after ChangeProgram has been called"
| None ->
Debug.WriteLine "updating the view after setting the model"
lastModel <- model
updateView model
for sub in program.subscribe model @ cmd do
sub dispatch
)
/// Program module - functions to manipulate program instances
[<RequireQualifiedAccess>]
@ -157,6 +186,24 @@ module Program =
init = traceInit
update = traceUpdate }
/// Trace all the updates to the console
let withLiveReload (program: Program<'model, 'msg, 'view>) =
let traceInit () =
let initModel,cmd = program.init ()
Console.WriteLine (sprintf "Initial model: %0A" initModel)
initModel,cmd
let traceUpdate msg model =
Console.WriteLine (sprintf "Message: %0A" msg)
let newModel,cmd = program.update msg model
Console.WriteLine (sprintf "Updated model: %0A" newModel)
newModel,cmd
{ program with
init = traceInit
update = traceUpdate }
/// Trace all the messages as they update the model
let withTrace trace (program: Program<'model, 'msg, 'view>) =
{ program
@ -175,11 +222,6 @@ module Program =
let runWithDynamicView (app : Application) (program: Program<'model, 'msg, _>) =
ProgramRunner(app, program)
/// Creates the view model for the given page and starts the Elmish dispatch loop for the matching program
[<Obsolete("Please use Program.runWithDynamicView", true)>]
let run app program = ProgramRunner(app,program)

Просмотреть файл

@ -1,4 +1,5 @@
namespace Elmish.XamarinForms
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
namespace Elmish.XamarinForms
open System
open System.Diagnostics

Просмотреть файл

@ -26,7 +26,7 @@ module StaticView =
let mutable lastModel = initialModel
let mutable lastViewData = None
let dispatch = ProgramDispatch<'msg>.Dispatch
let dispatch = ProgramDispatch<'msg>.DispatchViaThunk
do Debug.WriteLine "run: computing static components of view"
@ -65,7 +65,7 @@ module StaticView =
do
// Set up the global dispatch function
ProgramDispatch<'msg>.Dispatch <- (fun msg -> Device.BeginInvokeOnMainThread(fun () -> processMsg msg))
ProgramDispatch<'msg>.SetDispatchThunk (fun msg -> Device.BeginInvokeOnMainThread(fun () -> processMsg msg))
Debug.WriteLine "updating the initial view"

Просмотреть файл

@ -1,3 +1,5 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
namespace Elmish.XamarinForms.DynamicViews
open System

Просмотреть файл

@ -1,3 +1,5 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
namespace Elmish.XamarinForms.DynamicViews
#nowarn "67" // cast always holds

Просмотреть файл

@ -1,4 +1,6 @@
// dotnet build -c Release Generator\Generator.fsproj && dotnet Generator\bin\Release\netcoreapp2.0\Generator.dll Generator\Xamarin.Forms.Core.json Elmish.XamarinForms\Xamarin.Forms.Core.fs
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
// dotnet build -c Release Generator\Generator.fsproj && dotnet Generator\bin\Release\netcoreapp2.0\Generator.dll Generator\Xamarin.Forms.Core.json Elmish.XamarinForms\Xamarin.Forms.Core.fs
module Generator

Просмотреть файл

@ -671,4 +671,5 @@ type App () as app =
let runner =
Program.mkSimple App.init App.update App.view
|> Program.withConsoleTrace
//|> Program.withLiveReload app
|> Program.runWithDynamicView app

Просмотреть файл

@ -18,8 +18,8 @@
<MonoAndroidResourcePrefix>Resources</MonoAndroidResourcePrefix>
<MonoAndroidAssetsPrefix>Assets</MonoAndroidAssetsPrefix>
<AndroidUseLatestPlatformSdk>true</AndroidUseLatestPlatformSdk>
<SelectedDevice>Google Pixel 2</SelectedDevice>
<DefaultDevice>new_device</DefaultDevice>
<SelectedDevice>emulator_pixel</SelectedDevice>
<DefaultDevice>emulator_pixel</DefaultDevice>
<Name>AllControls.Droid</Name>
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
</PropertyGroup>

6386
Samples/AllControls/Droid/Resources/Resource.designer.cs сгенерированный

Разница между файлами не показана из-за своего большого размера Загрузить разницу

Просмотреть файл

@ -2,13 +2,13 @@
namespace CounterApp
open System.Diagnostics
open Elmish.XamarinForms
open Elmish.XamarinForms
open Elmish.XamarinForms.DynamicViews
open Xamarin.Forms
module App =
type Model =
{ Count : int
{ Count : int
Step : int
TimerOn: bool }
@ -20,11 +20,11 @@ module App =
| TimerToggled of bool
| TimedTick
let initModel = { Count = 0; Step = 1; TimerOn=false }
let initModel () = { Count = 0; Step = 1; TimerOn=false }
let init () = initModel, Cmd.none
let init () = initModel () , Cmd.none
let timerCmd =
let timerCmd () =
async { do! Async.Sleep 200
return TimedTick }
|> Cmd.ofAsyncMsg
@ -35,41 +35,46 @@ module App =
| Decrement -> { model with Count = model.Count - model.Step }, Cmd.none
| Reset -> init ()
| SetStep n -> { model with Step = n }, Cmd.none
| TimerToggled on -> { model with TimerOn = on }, (if on then timerCmd else Cmd.none)
| TimedTick -> if model.TimerOn then { model with Count = model.Count + model.Step }, timerCmd else model, Cmd.none
| TimerToggled on -> { model with TimerOn = on }, (if on then timerCmd() else Cmd.none)
| TimedTick -> if model.TimerOn then { model with Count = model.Count + model.Step }, timerCmd() else model, Cmd.none
let view (model: Model) dispatch =
let view (model: Model) dispatch =
Xaml.ContentPage(
content=Xaml.StackLayout(padding=20.0,
content=Xaml.StackLayout(padding=30.0,verticalOptions = LayoutOptions.Center,
children=[
yield
Xaml.StackLayout(padding=20.0, verticalOptions=LayoutOptions.Center,
children=[
Xaml.Label(text= sprintf "%d" model.Count, horizontalOptions=LayoutOptions.Center, fontSize = "Large")
Xaml.Button(text="Increment", command= fixf (fun () -> dispatch Increment))
Xaml.Button(text="Decrement", command= fixf (fun () -> dispatch Decrement))
Xaml.StackLayout(padding=20.0, orientation=StackOrientation.Horizontal, horizontalOptions=LayoutOptions.Center,
children = [ Xaml.Label(text="Timer")
Xaml.Switch(isToggled=model.TimerOn, toggled=fixf(fun on -> dispatch (TimerToggled on.Value))) ])
Xaml.Slider(minimum=0.0, maximum=10.0, value= double model.Step, valueChanged=fixf(fun args -> dispatch (SetStep (int (args.NewValue + 0.5)))))
Xaml.Label(text=sprintf "Step size: %d" model.Step, horizontalOptions=LayoutOptions.Center)
])
// If you want the button to disappear when in the initial condition then use this:
//if model <> initModel then
yield Xaml.Button(text="Reset", horizontalOptions=LayoutOptions.Center, command=fixf(fun () -> dispatch Reset), canExecute = (model <> initModel))
]))
yield Xaml.Label(text= sprintf "%d" model.Count, horizontalOptions=LayoutOptions.Center, fontSize = "Large")
yield Xaml.Button(text="Increment", command= (fun () -> dispatch Increment))
yield Xaml.Button(text="Decrement", command= (fun () -> dispatch Decrement))
yield Xaml.StackLayout(padding=20.0, orientation=StackOrientation.Horizontal, horizontalOptions=LayoutOptions.Center,
children = [ Xaml.Label(text="Timer")
Xaml.Switch(isToggled=model.TimerOn, toggled=(fun on -> dispatch (TimerToggled on.Value))) ])
yield Xaml.Slider(minimum=0.0, maximum=10.0, value= double model.Step, valueChanged=(fun args -> dispatch (SetStep (int (args.NewValue + 0.5)))))
yield Xaml.Label(text=sprintf "Step size: %d" model.Step, horizontalOptions=LayoutOptions.Center)
//if model <> initModel () then
yield Xaml.Button(text="Reset", horizontalOptions=LayoutOptions.Center, command=fixf(fun () -> dispatch Reset), canExecute = (model <> initModel () ))
]))
let program =
Program.mkProgram init update view
|> Program.withConsoleTrace
#if TESTEVAL
let testInit = fst (init ())
let testView = view testInit (fun _ -> ())
#endif
type CounterApp () as app =
inherit Application ()
let program = Program.mkProgram App.init App.update App.view
let runner =
program
#if DEBUG
|> Program.withConsoleTrace
#endif
|> Program.runWithDynamicView app
let runner = App.program |> Program.runWithDynamicView app
#if DEBUG && !TESTEVAL
do runner.EnableLiveUpdate ()
#endif
(*
#if !NO_SAVE_MODEL_WITH_JSON
let modelId = "model"
let serializer = MBrace.FsPickler.Json.FsPickler.CreateJsonSerializer()
@ -100,3 +105,4 @@ type CounterApp () as app =
override this.OnStart() = this.OnResume()
#endif
*)

Просмотреть файл

@ -9,6 +9,7 @@
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\..\Elmish.XamarinForms\Elmish.XamarinForms.fsproj" />
<ProjectReference Include="..\..\..\Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj" />
<PackageReference Include="FSharp.Core" Version="4.5.0" />
<PackageReference Include="FsPickler" Version="5.2.0" />
<PackageReference Include="FsPickler.Json" Version="5.2.0" />

Просмотреть файл

@ -0,0 +1,147 @@
-o:obj\Debug\netstandard2.0\CounterApp.dll
-g
--debug:portable
--noframework
--define:TRACE
--define:DEBUG
--define:NETSTANDARD2_0
--define:TESTEVAL
--optimize-
-r:C:\GitHub\dsyme\Elmish.XamarinForms\Elmish.XamarinForms\bin\Debug\netstandard2.0\Elmish.XamarinForms.dll
-r:C:\GitHub\dsyme\Elmish.XamarinForms\Elmish.XamarinForms.LiveUpdate\bin\Debug\netstandard2.0\Elmish.XamarinForms.LiveUpdate.dll
-r:C:\Users\dsyme\.nuget\packages\fsharp.core\4.5.0\lib\netstandard1.6\FSharp.Core.dll
-r:C:\Users\dsyme\.nuget\packages\fspickler\5.2.0\lib\netstandard2.0\FsPickler.dll
-r:C:\Users\dsyme\.nuget\packages\fspickler.json\5.2.0\lib\netstandard2.0\FsPickler.Json.dll
-r:C:\Users\dsyme\.nuget\packages\microsoft.csharp\4.3.0\ref\netstandard1.0\Microsoft.CSharp.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\Microsoft.Win32.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\mscorlib.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\netstandard.dll
-r:C:\Users\dsyme\.nuget\packages\newtonsoft.json\10.0.1\lib\netstandard1.3\Newtonsoft.Json.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.AppContext.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.Concurrent.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.NonGeneric.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.Specialized.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.Composition.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.EventBasedAsync.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.TypeConverter.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Console.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Core.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Data.Common.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Data.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Contracts.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Debug.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.FileVersionInfo.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Process.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.StackTrace.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.TextWriterTraceListener.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Tools.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.TraceSource.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Tracing.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Drawing.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Drawing.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Dynamic.Runtime.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.Calendars.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.Extensions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.FileSystem.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.ZipFile.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.DriveInfo.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.Watcher.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.IsolatedStorage.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.MemoryMappedFiles.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Pipes.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.UnmanagedMemoryStream.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Expressions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Parallel.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Queryable.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Http.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.NameResolution.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.NetworkInformation.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Ping.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Requests.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Security.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Sockets.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebHeaderCollection.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebSockets.Client.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebSockets.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Numerics.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ObjectModel.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.dll
-r:C:\Users\dsyme\.nuget\packages\system.reflection.emit.ilgeneration\4.3.0\ref\netstandard1.0\System.Reflection.Emit.ILGeneration.dll
-r:C:\Users\dsyme\.nuget\packages\system.reflection.emit.lightweight\4.3.0\ref\netstandard1.0\System.Reflection.Emit.Lightweight.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.Extensions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.Reader.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.ResourceManager.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.Writer.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.CompilerServices.VisualC.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Extensions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Handles.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.InteropServices.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.InteropServices.RuntimeInformation.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Numerics.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Formatters.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Json.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Xml.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Claims.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Algorithms.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Csp.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Encoding.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.X509Certificates.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Principal.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.SecureString.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ServiceModel.Web.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.Encoding.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.Encoding.Extensions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.RegularExpressions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Overlapped.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Tasks.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Tasks.Parallel.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Thread.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.ThreadPool.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Timer.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Transactions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ValueTuple.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Web.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Windows.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.Linq.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.ReaderWriter.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.Serialization.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XDocument.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XmlDocument.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XmlSerializer.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XPath.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XPath.XDocument.dll
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Core.dll
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Platform.dll
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Xaml.dll
--target:library
--warn:3
--warnaserror:76
--preferreduilang:en-US
--fullpaths
--flaterrors
--highentropyva-
--targetprofile:netstandard
--simpleresolution
--nocopyfsharpcore
CounterApp.fs
AssemblyInfo.fs
C:\Users\dsyme\AppData\Local\Temp\.NETStandard,Version=v2.0.AssemblyAttributes.fs

Просмотреть файл

@ -20,6 +20,7 @@
<AndroidUseLatestPlatformSdk>true</AndroidUseLatestPlatformSdk>
<SelectedDevice>Google Pixel 2</SelectedDevice>
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
<DefaultDevice>emulator_pixel</DefaultDevice>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
<DebugSymbols>true</DebugSymbols>
@ -43,6 +44,7 @@
<AndroidManagedSymbols>true</AndroidManagedSymbols>
<AndroidUseSharedRuntime>false</AndroidUseSharedRuntime>
<GenerateTailCalls>true</GenerateTailCalls>
<AndroidLinkMode>None</AndroidLinkMode>
<PlatformTarget>
</PlatformTarget>
</PropertyGroup>
@ -75,6 +77,11 @@
<None Include="Assets\AboutAssets.txt" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\..\Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj">
<Name>Elmish.XamarinForms.LiveUpdate</Name>
<Project>{b459afad-bb5b-43c3-bd86-609e8db3e3f1}</Project>
<Private>True</Private>
</ProjectReference>
<ProjectReference Include="..\..\..\Elmish.XamarinForms\Elmish.XamarinForms.fsproj">
<Name>Elmish.XamarinForms</Name>
<Project>{b459afad-bb5b-43c3-bd86-609e8db3e3fd}</Project>

Просмотреть файл

@ -1,6 +1,8 @@
<?xml version="1.0" encoding="utf-8"?>
<manifest xmlns:android="http://schemas.android.com/apk/res/android" android:versionCode="1" android:versionName="1.0" package="com.companyname.CounterApp">
<uses-sdk android:minSdkVersion="15" />
<application android:label="CounterApp">
</application>
</manifest>
<manifest xmlns:android="http://schemas.android.com/apk/res/android" android:versionCode="1" android:versionName="1.0" package="com.companyname.CounterApp" android:installLocation="internalOnly">
<uses-sdk android:minSdkVersion="10" />
<uses-permission android:name="android.permission.INTERNET" />
<uses-permission android:name="android.permission.ACCESS_NETWORK_STATE" />
<uses-permission android:name="android.permission.CHANGE_NETWORK_STATE" />
<application android:label="CounterApp"></application>
</manifest>

Просмотреть файл

@ -124,6 +124,11 @@
</Reference>
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\..\Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj">
<Name>Elmish.XamarinForms.LiveUpdate</Name>
<Project>{b459afad-bb5b-43c3-bd86-609e8db3e3f1}</Project>
<Private>True</Private>
</ProjectReference>
<ProjectReference Include="..\..\..\Elmish.XamarinForms\Elmish.XamarinForms.fsproj">
<Name>Elmish.XamarinForms</Name>
<Project>{b459afad-bb5b-43c3-bd86-609e8db3e3fd}</Project>

Разница между файлами не показана из-за своего большого размера Загрузить разницу

6414
Samples/TicTacToe/Droid/Resources/Resource.designer.cs сгенерированный

Разница между файлами не показана из-за своего большого размера Загрузить разницу

Просмотреть файл

@ -179,6 +179,24 @@
<Reference Include="FSharp.Core">
<HintPath>../../../packages/androidapp/FSharp.Core/lib/netstandard1.6/FSharp.Core.dll</HintPath>
</Reference>
<Reference Include="FsPickler">
<HintPath>..\..\..\packages\neutral\FsPickler\lib\netstandard2.0\FsPickler.dll</HintPath>
</Reference>
<Reference Include="FsPickler">
<HintPath>..\..\..\packages\neutral\FsPickler\lib\netstandard2.0\FsPickler.dll</HintPath>
</Reference>
<Reference Include="FsPickler.Json">
<HintPath>..\..\..\packages\neutral\FsPickler.Json\lib\netstandard2.0\FsPickler.Json.dll</HintPath>
</Reference>
<Reference Include="Microsoft.CSharp" />
<Reference Include="Newtonsoft.Json">
<HintPath>..\..\..\packages\neutral\Newtonsoft.Json\lib\netstandard1.3\Newtonsoft.Json.dll</HintPath>
</Reference>
<ProjectReference Include="..\..\..\Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj">
<Name>Elmish.XamarinForms.LiveUpdate</Name>
<Project>{b459afad-bb5b-43c3-bd86-609e8db3e3f1}</Project>
<Private>True</Private>
</ProjectReference>
<ProjectReference Include="..\TicTacToe\TicTacToe.fsproj">
<Project>{AE045D79-7FF3-45F3-BFD0-305542A1C728}</Project>
<Name>TicTacToe</Name>

Просмотреть файл

@ -11,6 +11,7 @@ type Player =
| X
| O
member p.Swap = match p with X -> O | O -> X
member p.Name = match p with X -> "X" | Y -> "Y"
/// Represents the game state contents of a single cell
type GameCell =
@ -47,6 +48,9 @@ type Model =
/// The state of play on the board
Board: Board
/// The state of play on the board
GameScore: (int * int)
/// The model occasionally includes things related to the view. In this case,
/// we track the desired visual size of the board, to ensure a square, in response to
@ -71,6 +75,7 @@ module App =
let init () =
{ NextUp = X
Board = initialBoard
GameScore = (0,0)
VisualBoardSize = None }
/// Check if there are any more moves available in the game
@ -108,8 +113,8 @@ module App =
/// Get a message to show the current game result
let getMessage model =
match getGameResult model with
| StillPlaying -> sprintf "%O's turn" model.NextUp
| Win p -> sprintf "%O wins!" p
| StillPlaying -> sprintf "%s's turn" model.NextUp.Name
| Win p -> sprintf "%s wins!" p.Name
| Draw -> "It is a draw!"
/// The 'update' function to update the model
@ -129,8 +134,14 @@ module App =
if result <> StillPlaying then
gameOver (getMessage newModel)
let newModel2 =
let (x,y) = newModel.GameScore
match result with
| Win p -> { newModel with GameScore = (if p = X then (x+1, y) else (x, y+1)) }
| _ -> newModel
// Return the new model.
newModel
newModel2
/// A helper used in the 'view' function to get the name
/// of the Xaml resource for the image for a player
@ -178,30 +189,47 @@ module App =
?widthRequest = model.VisualBoardSize,
?heightRequest = model.VisualBoardSize).GridRow(0)
Xaml.Label(text=getMessage model, margin=10.0, textColor=Color.Black, horizontalTextAlignment=TextAlignment.Center, fontSize="Large").GridRow(1)
Xaml.Label(text=getMessage model, margin=10.0, textColor=Color.Black,
horizontalOptions=LayoutOptions.Center,
verticalOptions=LayoutOptions.Center,
horizontalTextAlignment=TextAlignment.Center, verticalTextAlignment=TextAlignment.Center, fontSize="Large").GridRow(1)
Xaml.Button(command=(fun () -> dispatch Restart), text="Restart game", backgroundColor=Color.LightBlue, textColor=Color.Black, fontSize="Large").GridRow(2)
]),
// This requests a square board based on the width we get allocated on the device
onSizeAllocated=(fun (width, height) ->
if model.VisualBoardSize.IsNone then
match model.VisualBoardSize with
| None ->
let sz = min width height - 80.0
dispatch (SetVisualBoardSize sz)))])
dispatch (SetVisualBoardSize sz)
| Some _ ->
() ))])
// Display a modal message giving the game result. This is doing a UI
// action in the model update, which is ok for modal messages. We factor
// this dependency out to allow unit testing of the 'update' function.
let gameOver msg =
Application.Current.MainPage.DisplayAlert("Game over", msg, "OK") |> ignore
let program =
Program.mkSimple init (update gameOver) view
|> Program.withConsoleTrace
#if TESTEVAL
let testInit = init ()
let testView = view testInit (fun _ -> ())
#endif
/// Stitch the model, update and view content into a single app.
type App() as app =
inherit Application()
// Display a modal message giving the game result. This is doing a UI
// action in the model update, which is ok for modal messages. We factor
// this dependency out to allow unit testing of the 'update' function.
let gameOver msg =
Application.Current.MainPage.DisplayAlert("Game over", msg, "OK") |> ignore
let runner =
Program.mkSimple App.init (App.update gameOver) App.view
#if DEBUG
|> Program.withConsoleTrace
#endif
App.program
|> Program.runWithDynamicView app
#if DEBUG && !TESTEVAL
do runner.EnableLiveUpdate ()
#endif

Просмотреть файл

@ -9,7 +9,10 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.Core" Version="4.5.0" />
<PackageReference Include="FsPickler" Version="5.2.0" />
<PackageReference Include="FsPickler.Json" Version="5.2.0" />
<PackageReference Include="Xamarin.Forms" Version="3.0.0.482510" />
<ProjectReference Include="..\..\..\Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj" />
<ProjectReference Include="..\..\..\Elmish.XamarinForms\Elmish.XamarinForms.fsproj" />
</ItemGroup>
</Project>

Просмотреть файл

@ -0,0 +1,147 @@
-o:obj\Debug\netstandard2.0\TicTacToe.dll
-g
--debug:portable
--noframework
--define:TESTEVAL
--define:TRACE
--define:DEBUG
--define:NETSTANDARD2_0
--optimize-
-r:C:\GitHub\dsyme\Elmish.XamarinForms\Elmish.XamarinForms\bin\Debug\netstandard2.0\Elmish.XamarinForms.dll
-r:C:\GitHub\dsyme\Elmish.XamarinForms\Elmish.XamarinForms.LiveUpdate\bin\Debug\netstandard2.0\Elmish.XamarinForms.LiveUpdate.dll
-r:C:\Users\dsyme\.nuget\packages\fsharp.core\4.5.0\lib\netstandard1.6\FSharp.Core.dll
-r:C:\Users\dsyme\.nuget\packages\fspickler\5.2.0\lib\netstandard2.0\FsPickler.dll
-r:C:\Users\dsyme\.nuget\packages\fspickler.json\5.2.0\lib\netstandard2.0\FsPickler.Json.dll
-r:C:\Users\dsyme\.nuget\packages\microsoft.csharp\4.3.0\ref\netstandard1.0\Microsoft.CSharp.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\Microsoft.Win32.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\mscorlib.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\netstandard.dll
-r:C:\Users\dsyme\.nuget\packages\newtonsoft.json\10.0.1\lib\netstandard1.3\Newtonsoft.Json.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.AppContext.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.Concurrent.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.NonGeneric.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.Specialized.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.Composition.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.EventBasedAsync.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.TypeConverter.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Console.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Core.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Data.Common.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Data.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Contracts.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Debug.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.FileVersionInfo.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Process.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.StackTrace.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.TextWriterTraceListener.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Tools.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.TraceSource.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Tracing.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Drawing.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Drawing.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Dynamic.Runtime.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.Calendars.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.Extensions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.FileSystem.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.ZipFile.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.DriveInfo.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.Watcher.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.IsolatedStorage.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.MemoryMappedFiles.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Pipes.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.UnmanagedMemoryStream.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Expressions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Parallel.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Queryable.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Http.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.NameResolution.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.NetworkInformation.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Ping.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Requests.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Security.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Sockets.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebHeaderCollection.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebSockets.Client.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebSockets.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Numerics.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ObjectModel.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.dll
-r:C:\Users\dsyme\.nuget\packages\system.reflection.emit.ilgeneration\4.3.0\ref\netstandard1.0\System.Reflection.Emit.ILGeneration.dll
-r:C:\Users\dsyme\.nuget\packages\system.reflection.emit.lightweight\4.3.0\ref\netstandard1.0\System.Reflection.Emit.Lightweight.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.Extensions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.Reader.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.ResourceManager.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.Writer.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.CompilerServices.VisualC.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Extensions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Handles.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.InteropServices.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.InteropServices.RuntimeInformation.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Numerics.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Formatters.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Json.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Xml.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Claims.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Algorithms.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Csp.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Encoding.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Primitives.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.X509Certificates.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Principal.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.SecureString.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ServiceModel.Web.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.Encoding.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.Encoding.Extensions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.RegularExpressions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Overlapped.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Tasks.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Tasks.Parallel.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Thread.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.ThreadPool.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Timer.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Transactions.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ValueTuple.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Web.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Windows.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.Linq.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.ReaderWriter.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.Serialization.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XDocument.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XmlDocument.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XmlSerializer.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XPath.dll
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XPath.XDocument.dll
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Core.dll
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Platform.dll
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Xaml.dll
--target:library
--warn:3
--warnaserror:76
--preferreduilang:en-US
--fullpaths
--flaterrors
--highentropyva-
--targetprofile:netstandard
--simpleresolution
--nocopyfsharpcore
TicTacToe.fs
AssemblyInfo.fs
C:\Users\dsyme\AppData\Local\Temp\.NETStandard,Version=v2.0.AssemblyAttributes.fs

Просмотреть файл

@ -7,26 +7,28 @@ open System.IO
open Fake.AssemblyInfoFile
open Fake.ReleaseNotesHelper
let buildDir = "./build_output"
let buildDir nuget = if nuget then "./build_output" else "./build_output/tools"
let release = LoadReleaseNotes "RELEASE_NOTES.md"
let projects =
[ ("Elmish.XamarinForms/Elmish.XamarinForms.fsproj", "Elmish.XamarinForms", "F# Functional App Dev Framework")
("extensions/Maps/Elmish.XamarinForms.Maps.fsproj", "Elmish.XamarinForms.Maps", "Elmish.XamarinForms extension for Xamarin.Forms.Maps")
("extensions/SkiaSharp/Elmish.XamarinForms.SkiaSharp.fsproj", "Elmish.XamarinForms.SkiaSharp", "Elmish.XamarinForms extension for SkiaSharp")
("extensions/OxyPlot/Elmish.XamarinForms.OxyPlot.fsproj", "Elmish.XamarinForms.OxyPlot", "Elmish.XamarinForms extension for OxyPlot") ]
[ ("Elmish.XamarinForms/Elmish.XamarinForms.fsproj", "Elmish.XamarinForms", "F# Functional App Dev Framework", true)
("extensions/Maps/Elmish.XamarinForms.Maps.fsproj", "Elmish.XamarinForms.Maps", "Elmish.XamarinForms extension for Xamarin.Forms.Maps", true)
("extensions/SkiaSharp/Elmish.XamarinForms.SkiaSharp.fsproj", "Elmish.XamarinForms.SkiaSharp", "Elmish.XamarinForms extension for SkiaSharp", true)
("extensions/OxyPlot/Elmish.XamarinForms.OxyPlot.fsproj", "Elmish.XamarinForms.OxyPlot", "Elmish.XamarinForms extension for OxyPlot", true)
("fscd/fscd.fsproj", "fscd", "F# Compiler Daemon", false)
("Elmish.XamarinForms.LiveUpdate/Elmish.XamarinForms.LiveUpdate.fsproj", "Elmish.XamarinForms.LiveUpdate", "F# Functional App Dev Framework Live Update", true) ]
Target "Build" (fun _ ->
// needed or else 'project.assets.json' not found'
for (projFile, _project, _summary) in projects do
for (projFile, _project, _summary, _nuget) in projects do
DotNetCli.Restore (fun p -> { p with Project = projFile })
for (projFile, _project, _summary) in projects do
!! projFile |> MSBuildRelease buildDir "Restore" |> Log "LibraryRestore-Output: "
for (projFile, _project, _summary, nuget) in projects do
!! projFile |> MSBuildRelease (buildDir nuget) "Restore" |> Log "LibraryRestore-Output: "
for (projFile, _project, _summary) in projects do
!! projFile |> MSBuildRelease buildDir "Build" |> Log "LibraryBuild-Output: "
for (projFile, _project, _summary, nuget) in projects do
!! projFile |> MSBuildRelease (buildDir nuget) "Build" |> Log "LibraryBuild-Output: "
)
Target "BuildSamples" (fun _ ->
@ -46,13 +48,13 @@ Target "BuildSamples" (fun _ ->
)
Target "Clean" (fun _ ->
CleanDir buildDir
CleanDir (buildDir true)
)
// Generate assembly info files with the right version & up-to-date information
Target "AssemblyInfo" (fun _ ->
for (projFile, projName, summary) in projects do
for (projFile, projName, summary, _nuget) in projects do
let projFolder = Path.GetDirectoryName(projFile)
let projDetails =
[ Attribute.Title projName
@ -66,14 +68,15 @@ Target "AssemblyInfo" (fun _ ->
// Build a NuGet package
Target "LibraryNuGet" (fun _ ->
for (projFile, _projName, _summary) in projects do
let projFolder = Path.GetDirectoryName(projFile)
Paket.Pack(fun p ->
{ p with
OutputPath = buildDir + "/"
TemplateFile = projFolder + "/paket.template"
Version = release.NugetVersion
ReleaseNotes = toLines release.Notes})
for (projFile, _projName, _summary, nuget) in projects do
if nuget then
let projFolder = Path.GetDirectoryName(projFile)
Paket.Pack(fun p ->
{ p with
OutputPath = buildDir nuget + "/"
TemplateFile = projFolder + "/paket.template"
Version = release.NugetVersion
ReleaseNotes = toLines release.Notes})
)
// Build a NuGet package
@ -82,7 +85,7 @@ Target "TemplatesNuGet" (fun _ ->
NuGetHelper.NuGetPack (fun p ->
{ p with
WorkingDir = "templates"
OutputPath = buildDir + "/"
OutputPath = buildDir true + "/"
Version = release.NugetVersion
ReleaseNotes = toLines release.Notes}) @"templates/Elmish.XamarinForms.Templates.nuspec"
)
@ -93,14 +96,14 @@ let exec exe args =
Target "TestTemplatesNuGet" (fun _ ->
// Globally install the templates from the template nuget package we just built
DotNetCli.RunCommand id ("new -i " + buildDir + "/Elmish.XamarinForms.Templates." + release.NugetVersion + ".nupkg")
DotNetCli.RunCommand id ("new -i " + buildDir true + "/Elmish.XamarinForms.Templates." + release.NugetVersion + ".nupkg")
let testAppName = "testapp2" + string (abs (hash System.DateTime.Now.Ticks) % 100)
// Instantiate the template. TODO: additional parameters and variations
CleanDir testAppName
DotNetCli.RunCommand id (sprintf "new elmish-forms-app -n %s -lang F#" testAppName)
let pkgs = Path.GetFullPath(buildDir)
let pkgs = Path.GetFullPath(buildDir true)
// When restoring, using the build_output as a package source to pick up the package we just compiled
DotNetCli.RunCommand id (sprintf "restore %s/%s/%s.fsproj --source https://api.nuget.org/v3/index.json --source %s" testAppName testAppName testAppName pkgs)

Просмотреть файл

@ -15,4 +15,5 @@
* [Extensions: OxyPlot (charting)](views-oxyplot.html)
* [Models](models.html)
* [Update and Messages](update.html)
* [Tools](tools.html)
* [Further Resources](index.html#further-resources)

Просмотреть файл

@ -3,4 +3,5 @@
* [Views](views.html)
* [Models](models.html)
* [Update and Messages](update.html)
* [Tools](tools.html)
* [Further Resources](index.html#further-resources)

122
docs/tools.md Normal file
Просмотреть файл

@ -0,0 +1,122 @@
Elmish.XamarinForms Guide
=======
{% include_relative contents.md %}
Experimental Live Update
------
There is a prototype LiveUpdate mechanism available. The aim of this is primarily to enable modifying the `view` function in order
to see the effect of adjusting of visual options.
Some manual set-up is required. The following assumes your app is called `SqueakyApp`:
1. Add a reference to nuget package `Elmish.XamarinForms.LiveUpdate` to all projects in your app. Do a clean build.
2. Add the code in the `#if` section below in `SqueakyApp\SqueakyApp\SqueayApp.fs`:
type App () =
inherit Application()
....
#if DEBUG
do runner.EnableLiveUpdate ()
#endif
3. In your core project directory (e.g. `SqueakyApp\SqueakyApp`), create `proj.args` containing the project options used to compile the core of your app. It should look something like [this](https://github.com/dsyme/Elmish.XamarinForms/blob/c2a93b2aa6fb728c038a907844ea04a7127c7381/Samples/CounterApp/CounterApp/out.args).
dotnet build -v:n SqueayApp.fsproj > proj.args
<manually edit `proj.args` to contain only the compilation arguments>
4. If running on Android, forward requests from localhost to the Android Debug Bridge:
USB:
adb -d forward tcp:9867 tcp:9867
EMULATOR:
adb -e forward tcp:9867 tcp:9867
5. Launch your app in Debug mode (you can use Release mode but must set Linking options to `None` rather than `SDK Assemblies`)
6. Run the following from your core project directory (e.g. `SqueakyApp\SqueakyApp`)
Windows:
%USERPROFILE%\.nuget\packages\Elmish.XamarinForms.LiveUpdate\0.13.0\tools\fscd.exe --watch --webhook:http://localhost:9867/update -- @proj.args
Unix and OSX (untested):
mono ~/.nuget/packages/Elmish.XamarinForms.LiveUpdate/0.13.0/tools/fscd.exe --watch --webhook:http://localhost:9867/update -- @proj.args
Now, whenever you save a file in your core project directory, the `fscd.exe` daemon will attempt to recompile your changed file and
send a representation of its contents to your app via a PUT request. The app then deserializes this representation and
adds the declarations to an F# interpreter. This interpreter will make some reflective calls into the existing libraries on device.
To take effect, your code must have a single declaration in some module called `programLiveUpdate` or `program` taking no arguments. For example:
```fsharp
module App =
...
let init() = ...
let update model msg = ...
let view model dispatch = ...
let program = Program.mkProgram init update view
```
If a declaration like this is found the `program` object replaces the currently running Elmish program and the view is updated.
The model state of the app is re-initialized.
### Known limitations:
1. The F# interpreter used on-device has some incompletnesses and behavioural differences:
1. Object expressions may not be intepreted
2. Implementations of ToString() and other overrides will be ignored
3. Some other F# constructs are not supported (e.g. address-of operations)
You can move generally move problematic constructs to a utility library, which will then be executed as compiled code.
2. Changes to the resources in a project (e.g. images) require a rebuild
3. Changes to Android and iOS require a rebuild
4. You may need to mock any platform-specific helpers you pass through, e.g.
module App =
...
let init() = ...
let update (helper1, helper2) model msg = ...
let view model dispatch = ...
#if DEBUG
// The fake program, used when LiveUpdate is activated and a program change has been made
module AppLiveUpdate =
open App
let mockHelper1 () = ...
let mockHelper2 () = ...
let programLiveUpdate = Program.mkProgram init (update (mockHelper1, mockHelper2)) view
#endif
type App (helper1, helper2) =
inherit Application()
....
// The real program, used when LiveUpdate is not activated or a program change has not been made
let program = Program.mkProgram App.init (App.update (helper1, helper2)) App.view
6. There may be issues running on networks with network policy restrictions
### Troubleshooting
The LiveUpdate mechanism is very experimental.
- Debug output is printed to console by `fscd.exe`
- Debug output is printed to app-output by the on-device web server
Please contribute documentation, updates and fixes to make the experience simpler.

Просмотреть файл

@ -1,3 +1,4 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
namespace Elmish.XamarinForms.DynamicViews
[<AutoOpen>]

Просмотреть файл

@ -1,3 +1,4 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
namespace Elmish.XamarinForms.DynamicViews
[<AutoOpen>]

Просмотреть файл

@ -1,3 +1,4 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
namespace Elmish.XamarinForms.DynamicViews
[<AutoOpen>]

79
fscd/CodeModel.fs Normal file
Просмотреть файл

@ -0,0 +1,79 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
module FSharp.Compiler.PortaCode.CodeModel
/// A representation of resolved F# expressions that can be serialized
type DExpr =
| Value of DLocalRef
| ThisValue of DType
| BaseValue of DType
| Application of DExpr * DType[] * DExpr[]
| Lambda of DType * DType * DLocalDef * DExpr
| TypeLambda of DGenericParameterDef[] * DExpr
| Quote of DExpr
| IfThenElse of DExpr * DExpr * DExpr
| DecisionTree of DExpr * (DLocalDef[] * DExpr)[]
| DecisionTreeSuccess of int * DExpr[]
| Call of DExpr option * DMemberRef * DType[] * DType[] * DExpr[]
| NewObject of DMemberRef * DType[] * DExpr[]
| LetRec of ( DLocalDef * DExpr)[] * DExpr
| Let of (DLocalDef * DExpr) * DExpr
| NewRecord of DType * DExpr[]
| ObjectExpr of DType * DExpr * DObjectExprOverrideDef[] * (DType * DObjectExprOverrideDef[])[]
| FSharpFieldGet of DExpr option * DType * DFieldRef
| FSharpFieldSet of DExpr option * DType * DFieldRef * DExpr
| NewUnionCase of DType * DUnionCaseRef * DExpr[]
| UnionCaseGet of DExpr * DType * DUnionCaseRef * DFieldRef
| UnionCaseSet of DExpr * DType * DUnionCaseRef * DFieldRef * DExpr
| UnionCaseTag of DExpr * DType
| UnionCaseTest of DExpr * DType * DUnionCaseRef
//| TraitCall of DType[] * string * Ast.MemberFlags * DType[] * DType[] * DExpr[]
| NewTuple of DType * DExpr[]
| TupleGet of DType * int * DExpr
| Coerce of DType * DExpr
| NewArray of DType * DExpr[]
| TypeTest of DType * DExpr
| AddressSet of DExpr * DExpr
| ValueSet of DLocalRef * DExpr
| Unused
| DefaultValue of DType
| Const of obj * DType
| AddressOf of DExpr
| Sequential of DExpr * DExpr
| FastIntegerForLoop of DExpr * DExpr * DExpr * bool
| WhileLoop of DExpr * DExpr
| TryFinally of DExpr * DExpr
| TryWith of DExpr * DLocalDef * DExpr * DLocalDef * DExpr
| NewDelegate of DType * DExpr
| ILFieldGet of DExpr option * DType * string
| ILFieldSet of DExpr option * DType * string * DExpr
| ILAsm of string * DType[] * DExpr[]
and DType =
| DNamedType of DEntityRef * DType[]
| DFunctionType of DType * DType
| DTupleType of bool * DType[]
| DArrayType of int * DType
| DVariableType of string
and DLocalDef =
{ Name: string; IsMutable: bool; Type: DType }
and DMemberDef =
{ EnclosingEntity: DEntityRef; Name: string; GenericParameters: DGenericParameterDef[]; IsInstance: bool; Parameters: DLocalDef[]; ReturnType: DType }
member x.Ref = DMemberRef (x.EnclosingEntity, x.Name, x.GenericParameters.Length, (x.Parameters |> Array.map (fun p -> p.Type)), x.ReturnType)
and DGenericParameterDef = { Name: string }
and DEntityDef = { Name: string; GenericParameters: DGenericParameterDef[]; UnionCases: string[] }
and DEntityRef = DEntityRef of string
and DMemberRef = DMemberRef of DEntityRef * string * int * DType[] * DType
and DLocalRef = DLocalRef of name: string * isThisValue: bool * isMutable: bool
and DFieldRef = DFieldRef of int * string
and DUnionCaseRef = DUnionCaseRef of string
and DObjectExprOverrideDef = { Name: string; GenericParameters: DGenericParameterDef[]; Parameters: DLocalDef[]; Body: DExpr }
type DDecl =
| DDeclEntity of DEntityDef * DDecl[]
| DDeclMember of DMemberDef * DExpr
| InitAction of DExpr
type DFile =
{ Code: DDecl[] }

183
fscd/FromCompilerService.fs Normal file
Просмотреть файл

@ -0,0 +1,183 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
module FSharp.Compiler.PortaCode.FromCompilerService
open FSharp.Compiler.PortaCode.CodeModel
open System.Collections.Generic
open Microsoft.FSharp.Compiler.SourceCodeServices
let map2 f g (a,b) = (f a, g b)
module List =
let mapToArray f arr = arr |> Array.ofList |> Array.map f
module Seq =
let mapToArray f arr = arr |> Array.ofSeq |> Array.map f
let rec convExpr (e:FSharpExpr) : DExpr =
match e with
| BasicPatterns.AddressOf(lvalueExpr) -> DExpr.AddressOf(convExpr lvalueExpr)
| BasicPatterns.AddressSet(lvalueExpr, rvalueExpr) -> DExpr.AddressSet(convExpr lvalueExpr, convExpr rvalueExpr)
// FCS TODO: fix FCS quirk with IsNone and IsSome on the option type
| BasicPatterns.Application( BasicPatterns.Call(Some obj, memberOrFunc, tyargs1, tyargs2, [ ]), typeArgs, [ arg ]) when memberOrFunc.CompiledName = "get_IsNone" ->
let objExprR = convExpr obj
let mrefR = convMemberRef memberOrFunc
let typeArgs1R = convTypes tyargs1
let typeArgs2R = convTypes tyargs2
DExpr.Call(None, mrefR, typeArgs1R, typeArgs2R, [| objExprR |])
| BasicPatterns.Application(funcExpr, typeArgs, argExprs) -> DExpr.Application(convExpr funcExpr, convTypes typeArgs, convExprs argExprs)
| BasicPatterns.Call(objExprOpt, memberOrFunc, typeArgs1, typeArgs2, argExprs) ->
let objExprOptR = convExprOpt objExprOpt
let mrefR = convMemberRef memberOrFunc
let typeArgs1R = convTypes typeArgs1
let typeArgs2R = convTypes typeArgs2
let argExprsR = convExprs argExprs
match objExprOptR with
// FCS TODO: Fix quirk with extension members so this isn't needed
| Some objExprR when memberOrFunc.IsExtensionMember || not memberOrFunc.IsInstanceMemberInCompiledCode ->
DExpr.Call(None, mrefR, typeArgs1R, typeArgs2R, Array.append [| objExprR |] argExprsR)
| _ ->
DExpr.Call(objExprOptR, mrefR, typeArgs1R, typeArgs2R, argExprsR)
| BasicPatterns.Coerce(targetType, inpExpr) -> DExpr.Coerce(convType targetType, convExpr inpExpr)
| BasicPatterns.FastIntegerForLoop(startExpr, limitExpr, consumeExpr, isUp) -> DExpr.FastIntegerForLoop(convExpr startExpr, convExpr limitExpr, convExpr consumeExpr, isUp)
| BasicPatterns.ILAsm(asmCode, typeArgs, argExprs) -> DExpr.ILAsm(asmCode, convTypes typeArgs, convExprs argExprs)
| BasicPatterns.ILFieldGet (objExprOpt, fieldType, fieldName) -> DExpr.ILFieldGet(convExprOpt objExprOpt, convType fieldType, fieldName)
| BasicPatterns.ILFieldSet (objExprOpt, fieldType, fieldName, valueExpr) -> DExpr.ILFieldSet (convExprOpt objExprOpt, convType fieldType, fieldName, convExpr valueExpr)
| BasicPatterns.IfThenElse (guardExpr, thenExpr, elseExpr) -> DExpr.IfThenElse (convExpr guardExpr, convExpr thenExpr, convExpr elseExpr)
| BasicPatterns.Lambda(lambdaVar, bodyExpr) -> DExpr.Lambda(convType lambdaVar.FullType, convType bodyExpr.Type, convLocalDef lambdaVar, convExpr bodyExpr)
| BasicPatterns.Let((bindingVar, bindingExpr), bodyExpr) -> DExpr.Let((convLocalDef bindingVar, convExpr bindingExpr), convExpr bodyExpr)
| 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.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)
| BasicPatterns.Quote(quotedExpr) -> DExpr.Quote(convExpr quotedExpr)
| BasicPatterns.FSharpFieldGet(objExprOpt, recordOrClassType, fieldInfo) -> DExpr.FSharpFieldGet(convExprOpt objExprOpt, convType recordOrClassType, convFieldRef fieldInfo)
| BasicPatterns.FSharpFieldSet(objExprOpt, recordOrClassType, fieldInfo, argExpr) -> DExpr.FSharpFieldSet(convExprOpt objExprOpt, convType recordOrClassType, convFieldRef fieldInfo, convExpr argExpr)
| BasicPatterns.Sequential(firstExpr, secondExpr) -> DExpr.Sequential(convExpr firstExpr, convExpr secondExpr)
| BasicPatterns.TryFinally(bodyExpr, finalizeExpr) -> DExpr.TryFinally(convExpr bodyExpr, convExpr finalizeExpr)
| BasicPatterns.TryWith(bodyExpr, filterVar, filterExpr, catchVar, catchExpr) -> DExpr.TryWith(convExpr bodyExpr, convLocalDef filterVar, convExpr filterExpr, convLocalDef catchVar, convExpr catchExpr)
| BasicPatterns.TupleGet(tupleType, tupleElemIndex, tupleExpr) -> DExpr.TupleGet(convType tupleType, tupleElemIndex, convExpr tupleExpr)
| BasicPatterns.DecisionTree(decisionExpr, decisionTargets) -> DExpr.DecisionTree(convExpr decisionExpr, List.mapToArray (map2 (List.mapToArray convLocalDef) convExpr) decisionTargets)
| BasicPatterns.DecisionTreeSuccess (decisionTargetIdx, decisionTargetExprs) -> DExpr.DecisionTreeSuccess (decisionTargetIdx, convExprs decisionTargetExprs)
| BasicPatterns.TypeLambda(genericParams, bodyExpr) -> DExpr.TypeLambda(Array.map convGenericParamDef (Array.ofList genericParams), convExpr bodyExpr)
| BasicPatterns.TypeTest(ty, inpExpr) -> DExpr.TypeTest(convType ty, convExpr inpExpr)
| BasicPatterns.UnionCaseSet(unionExpr, unionType, unionCase, unionCaseField, valueExpr) -> DExpr.UnionCaseSet(convExpr unionExpr, convType unionType, convUnionCase unionCase, convUnionCaseField unionCase unionCaseField, convExpr valueExpr)
| BasicPatterns.UnionCaseGet(unionExpr, unionType, unionCase, unionCaseField) -> DExpr.UnionCaseGet(convExpr unionExpr, convType unionType, convUnionCase unionCase, convUnionCaseField unionCase unionCaseField)
| BasicPatterns.UnionCaseTest(unionExpr, unionType, unionCase) -> DExpr.UnionCaseTest(convExpr unionExpr, convType unionType, convUnionCase unionCase)
| BasicPatterns.UnionCaseTag(unionExpr, unionType) -> DExpr.UnionCaseTag(convExpr unionExpr, convType unionType)
| BasicPatterns.ObjectExpr(objType, baseCallExpr, overrides, interfaceImplementations) -> DExpr.ObjectExpr(convType objType, convExpr baseCallExpr, Array.map convObjMemberDef (Array.ofList overrides), Array.map (map2 convType (Array.ofList >> Array.map convObjMemberDef)) (Array.ofList interfaceImplementations))
//| BasicPatterns.TraitCall(sourceTypes, traitName, typeArgs, typeInstantiation, argTypes, argExprs) -> DExpr.TraitCall(sourceTypes, traitName, typeArgs, typeInstantiation, argTypes, argExprs)
| BasicPatterns.ValueSet(valToSet, valueExpr) -> DExpr.ValueSet(convLocalRef valToSet, convExpr valueExpr)
| BasicPatterns.WhileLoop(guardExpr, bodyExpr) -> DExpr.WhileLoop(convExpr guardExpr, convExpr bodyExpr)
| BasicPatterns.BaseValue baseType -> DExpr.BaseValue (convType baseType)
| BasicPatterns.DefaultValue defaultType -> DExpr.DefaultValue (convType defaultType)
| BasicPatterns.ThisValue thisType -> DExpr.ThisValue (convType thisType)
| BasicPatterns.Const(constValueObj, constType) -> DExpr.Const (constValueObj, convType constType)
| BasicPatterns.Value(valueToGet) -> DExpr.Value(convLocalRef valueToGet)
| _ -> failwith (sprintf "unrecognized %+A" e)
and convExprs exprs =
Array.map convExpr (Array.ofList exprs)
and convExprOpt exprs =
Option.map convExpr exprs
and convObjArg f objOpt =
Option.map convExpr objOpt
and convObjMemberDef (memb: FSharpObjectExprOverride) : DObjectExprOverrideDef =
{ //Signature: DAbstractSignature
GenericParameters = convGenericParamDefs memb.GenericParameters
Name = memb.Signature.Name
Parameters = memb.CurriedParameterGroups |> convParamDefs2
Body = convExpr memb.Body }
and convFieldRef (field: FSharpField) : DFieldRef =
match field.DeclaringEntity.FSharpFields |> Seq.tryFindIndex (fun field2 -> field2.Name = field.Name) with
| Some index -> DFieldRef (index, field.Name)
| None -> failwithf "couldn't find field %s in type %A" field.Name field.DeclaringEntity
and convUnionCase (ucase: FSharpUnionCase) : DUnionCaseRef =
DUnionCaseRef (ucase.CompiledName)
and convUnionCaseField (ucase: FSharpUnionCase) (field: FSharpField) : DFieldRef =
match ucase.UnionCaseFields |> Seq.tryFindIndex (fun field2 -> field2.Name = field.Name) with
| Some index -> DFieldRef (index, field.Name)
| None -> failwithf "couldn't find field %s in type %A" field.Name field.DeclaringEntity
and convLocalDef (memb: FSharpMemberOrFunctionOrValue) : DLocalDef =
{ Name = memb.CompiledName; IsMutable = memb.IsMutable; Type = convType memb.FullType }
and convLocalRef (value: FSharpMemberOrFunctionOrValue) : DLocalRef =
DLocalRef (value.CompiledName, (value.IsMemberThisValue || value.IsConstructorThisValue || value.IsBaseValue), value.IsMutable)
and convMemberDef (memb: FSharpMemberOrFunctionOrValue) : DMemberDef =
assert (memb.IsMember || memb.IsModuleValueOrMember)
{ EnclosingEntity = convEntityRef memb.DeclaringEntity.Value
Name = memb.CompiledName
GenericParameters = convGenericParamDefs memb.GenericParameters
Parameters = convParamDefs memb.CurriedParameterGroups
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
if memb.IsExtensionMember && memb.ApparentEnclosingEntity.GenericParameters.Count > 0 then failwithf "NYI: extension of generic type, needs FCS support: %A" memb
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 convParamDefs2 (parameters: FSharpMemberOrFunctionOrValue list list) =
parameters |> Seq.concat |> Array.ofSeq |> Array.map (fun p -> { Name = p.DisplayName; IsMutable = false; Type = convType p.FullType })
and convReturnType (memb: FSharpMemberOrFunctionOrValue) =
convType memb.ReturnParameter.Type
and convEntityDef (entity: FSharpEntity) : DEntityDef =
if entity.IsNamespace then failwith "convEntityDef: can't convert a namespace"
if entity.IsArrayType then failwith "convEntityDef: can't convert an array"
if entity.IsFSharpAbbreviation then failwith "convEntityDef: can't convert a type abbreviation"
{ Name = entity.QualifiedName
GenericParameters = convGenericParamDefs entity.GenericParameters
UnionCases = entity.UnionCases |> Seq.mapToArray (fun uc -> uc.Name) }
and convEntityRef (entity: FSharpEntity) : DEntityRef =
if entity.IsNamespace then failwith "convEntityRef: can't convert a namespace"
if entity.IsArrayType then failwith "convEntityRef: can't convert an array"
if entity.IsFSharpAbbreviation then failwith "convEntityRef: can't convert a type abbreviation"
DEntityRef entity.QualifiedName
and convType (typ: FSharpType) =
if typ.IsAbbreviation then convType typ.AbbreviatedType
elif typ.IsFunctionType then DFunctionType (convType typ.GenericArguments.[0], convType typ.GenericArguments.[1])
elif typ.IsTupleType then DTupleType (false, convTypes typ.GenericArguments)
elif typ.IsStructTupleType then DTupleType (true, convTypes typ.GenericArguments)
elif typ.IsGenericParameter then DVariableType typ.GenericParameter.Name
elif typ.TypeDefinition.IsArrayType then DArrayType (typ.TypeDefinition.ArrayRank, convType typ.GenericArguments.[0])
else DNamedType (convEntityRef typ.TypeDefinition, convTypes typ.GenericArguments)
and convTypes (typs: seq<FSharpType>) = typs |> Seq.toArray |> Array.map convType
and convGenericParamDef (gp: FSharpGenericParameter) : DGenericParameterDef = { Name = gp.Name }
and convGenericParamDefs (gps: seq<FSharpGenericParameter>) = gps |> Seq.toArray |> Array.map convGenericParamDef
let rec convDecl d =
[| match d with
| FSharpImplementationFileDeclaration.Entity (e, subDecls) ->
if e.IsFSharpAbbreviation then ()
elif e.IsNamespace then yield! convDecls subDecls
elif e.IsArrayType then ()
else yield DDeclEntity (convEntityDef e, convDecls subDecls)
| FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(v, vs, e) ->
yield DDeclMember (convMemberDef v, convExpr e)
| FSharpImplementationFileDeclaration.InitAction(e) ->
yield DDecl.InitAction (convExpr e) |]
and convDecls decls =
decls |> Array.ofList |> Array.collect convDecl

807
fscd/Interpreter.fs Normal file
Просмотреть файл

@ -0,0 +1,807 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
module FSharp.Compiler.PortaCode.Interpreter
open System
open System.Reflection
open System.Collections.Generic
open FSharp.Compiler.PortaCode.CodeModel
type ResolvedEntity =
| REntity of Type
| UEntity of DEntityDef
and ResolvedType =
| RType of Type
| UNamedType of DEntityDef * Type[]
and ResolvedTypes =
| RTypes of Type[]
| UTypes of ResolvedType[]
and ResolvedMember =
| RPrim_float
| RPrim_float32
| RPrim_double
| RPrim_single
| RPrim_int32
| RPrim_int16
| RPrim_int64
| RPrim_byte
| RPrim_uint16
| RPrim_uint32
| RPrim_uint64
| RPrim_decimal
| RPrim_unativeint
| RPrim_nativeint
| RPrim_char
| RPrim_neg
| RPrim_pos
| RPrim_minus
| RPrim_divide
| RPrim_mod
| RPrim_shiftleft
| RPrim_shiftright
| RPrim_land
| RPrim_lor
| RPrim_lxor
| RPrim_lneg
| RMethod of System.Reflection.MemberInfo
| UMember of Value
and ResolvedUnionCase =
| RUnionCase of FSharp.Reflection.UnionCaseInfo * (obj -> int) * (obj[] -> obj) * (obj -> obj[])
| UUnionCase of int * string
and ResolvedField =
| RField of MemberInfo
| UField of int * ResolvedType * string
and [<Struct>] Value = Value of obj
and RecordValue = RecordValue of obj[]
and UnionValue = UnionValue of int * string * obj[]
and MethodLambdaValue = MethodLambdaValue of (Type[] * obj[] -> obj)
let getVal (Value v) = v
let bindAll = BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance ||| BindingFlags.Static
let (|RTypeOrObj|) xR = match xR with RType xV -> xV | _ -> typeof<obj>
let (|RTypesOrObj|) xR = match xR with RTypes xV -> xV | UTypes us -> Array.map (|RTypeOrObj|) us
type Env =
{ Vals: Map<string, Value>
Types: Map<string,Type>
Targets: (DLocalDef[] * DExpr)[]}
let envEmpty =
{ Vals = Map.empty; Types = Map.empty; Targets = Array.empty }
let bindByName (env: Env) varName value =
{ env with Vals = env.Vals.Add(varName, value) }
let bind (env: Env) (var: DLocalDef) value =
let value2 =
if var.IsMutable then
Value (ref (getVal value))
else
value
bindByName env var.Name value2
let bindty (env: Env) (var : DGenericParameterDef) value =
{ env with Types = env.Types.Add(var.Name, value) }
let inline binOp (argsV: obj[]) i8 i16 i32 i64 u8 u16 u32 u64 f32 f64 d =
match argsV.[0] with
| (:? int32 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i32 v1 v2)) | _ -> failwith "type match: operator"
| (:? double as v1) -> match argsV.[1] with (:? double as v2) -> Value (box (f64 v1 v2)) | _ -> failwith "type match: operator"
| (:? single as v1) -> match argsV.[1] with (:? single as v2) -> Value (box (f32 v1 v2)) | _ -> failwith "type match: operator"
| (:? int64 as v1) -> match argsV.[1] with (:? int64 as v2) -> Value (box (i64 v1 v2)) | _ -> failwith "type match: operator"
| (:? int16 as v1) -> match argsV.[1] with (:? int16 as v2) -> Value (box (i16 v1 v2)) | _ -> failwith "type match: operator"
| (:? sbyte as v1) -> match argsV.[1] with (:? sbyte as v2) -> Value (box (i8 v1 v2)) | _ -> failwith "type match: operator"
| (:? uint32 as v1) -> match argsV.[1] with (:? uint32 as v2) -> Value (box (u32 v1 v2)) | _ -> failwith "type match: operator"
| (:? uint64 as v1) -> match argsV.[1] with (:? uint64 as v2) -> Value (box (u64 v1 v2)) | _ -> failwith "type match: operator"
| (:? uint16 as v1) -> match argsV.[1] with (:? uint16 as v2) -> Value (box (u16 v1 v2)) | _ -> failwith "type match: operator"
| (:? byte as v1) -> match argsV.[1] with (:? byte as v2) -> Value (box (u8 v1 v2)) | _ -> failwith "type match: operator"
| (:? decimal as v1) -> match argsV.[1] with (:? decimal as v2) -> Value (box (d v1 v2)) | _ -> failwith "type match: operator"
| _ -> failwith "a construct used a type instantiation of an F# operator that is not yet supported in intepreted F# code"
let inline shiftOp (argsV: obj[]) i8 i16 i32 i64 u8 u16 u32 u64 =
match argsV.[0] with
| (:? int32 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i32 v1 v2)) | _ -> failwith "type match: operator"
| (:? int64 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i64 v1 v2)) | _ -> failwith "type match: operator"
| (:? int16 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i16 v1 v2)) | _ -> failwith "type match: operator"
| (:? sbyte as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i8 v1 v2)) | _ -> failwith "type match: operator"
| (:? uint32 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (u32 v1 v2)) | _ -> failwith "type match: operator"
| (:? uint64 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (u64 v1 v2)) | _ -> failwith "type match: operator"
| (:? uint16 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (u16 v1 v2)) | _ -> failwith "type match: operator"
| (:? byte as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (u8 v1 v2)) | _ -> failwith "type match: operator"
| _ -> failwith "a construct used a type instantiation of an F# operator that is not yet supported in intepreted F# code"
let inline logicBinOp (argsV: obj[]) i8 i16 i32 i64 u8 u16 u32 u64 =
match argsV.[0] with
| (:? int32 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i32 v1 v2)) | _ -> failwith "type match: operator"
| (:? int64 as v1) -> match argsV.[1] with (:? int64 as v2) -> Value (box (i64 v1 v2)) | _ -> failwith "type match: operator"
| (:? int16 as v1) -> match argsV.[1] with (:? int16 as v2) -> Value (box (i16 v1 v2)) | _ -> failwith "type match: operator"
| (:? sbyte as v1) -> match argsV.[1] with (:? sbyte as v2) -> Value (box (i8 v1 v2)) | _ -> failwith "type match: operator"
| (:? uint32 as v1) -> match argsV.[1] with (:? uint32 as v2) -> Value (box (u32 v1 v2)) | _ -> failwith "type match: operator"
| (:? uint64 as v1) -> match argsV.[1] with (:? uint64 as v2) -> Value (box (u64 v1 v2)) | _ -> failwith "type match: operator"
| (:? uint16 as v1) -> match argsV.[1] with (:? uint16 as v2) -> Value (box (u16 v1 v2)) | _ -> failwith "type match: operator"
| (:? byte as v1) -> match argsV.[1] with (:? byte as v2) -> Value (box (u8 v1 v2)) | _ -> failwith "type match: operator"
| _ -> failwith "a construct used a type instantiation of an F# operator that is not yet supported in intepreted F# code"
let inline logicUnOp (argsV: obj[]) i8 i16 i32 i64 u8 u16 u32 u64 =
match argsV.[0] with
| (:? int32 as v1) -> Value (box (i32 v1))
| (:? int64 as v1) -> Value (box (i64 v1))
| (:? int16 as v1) -> Value (box (i16 v1))
| (:? sbyte as v1) -> Value (box (i8 v1))
| (:? uint32 as v1) -> Value (box (u32 v1))
| (:? uint64 as v1) -> Value (box (u64 v1))
| (:? uint16 as v1) -> Value (box (u16 v1))
| (:? byte as v1) -> Value (box (u8 v1))
| _ -> failwith "a construct used a type instantiation of an F# operator that is not yet supported in intepreted F# code"
type EvalContext () =
let members = Dictionary<(ResolvedEntity * string * ResolvedTypes),Value>(HashIdentity.Structural)
let entityResolutions = Dictionary<DEntityRef,ResolvedEntity>(HashIdentity.Structural)
//let unionCaseResolutions = Dictionary<(DType * DUnionCaseRef),ResolvedUnionCase>(HashIdentity.Structural)
//let fieldResolutions = Dictionary<(DType * DFieldRef),ResolvedField>(HashIdentity.Structural)
//let methodResolutions = Dictionary<DMemberRef,ResolvedMember>(HashIdentity.Structural)
let methinfoof q = match q with Quotations.DerivedPatterns.Lambdas(_, Quotations.Patterns.Call(_,minfo,_)) -> minfo.GetGenericMethodDefinition() | _ -> failwith "unexpected"
let op_double = methinfoof <@ double @>
let op_single = methinfoof <@ single @>
let op_float = methinfoof <@ float @>
let op_float32 = methinfoof <@ float32 @>
let op_int32 = methinfoof <@ int32 @>
let op_int = methinfoof <@ int @>
let op_int16 = methinfoof <@ int16 @>
let op_int64 = methinfoof <@ int64 @>
let op_byte = methinfoof <@ byte @>
let op_uint16 = methinfoof <@ uint16 @>
let op_uint32 = methinfoof <@ uint32 @>
let op_uint64 = methinfoof <@ uint64 @>
let op_decimal = methinfoof <@ decimal @>
let op_unativeint = methinfoof <@ unativeint @>
let op_nativeint = methinfoof <@ nativeint @>
let op_char = methinfoof <@ char @>
let op_neg = methinfoof <@ (~-) @>
let op_pos = methinfoof <@ (~+) @>
let op_minus = methinfoof <@ (-) @>
let op_divide = methinfoof <@ (/) @>
let op_mod = methinfoof <@ (%) @>
let op_shiftleft = methinfoof <@ (<<<) @>
let op_shiftright = methinfoof <@ (>>>) @>
let op_land = methinfoof <@ (&&&) @>
let op_lor = methinfoof <@ (|||) @>
let op_lxor = methinfoof <@ (^^^) @>
let op_lneg = methinfoof <@ (~~~) @>
(*
TODO: + Checked versions of operators
TODO:
let inline absImpl (x: ^T) : ^T =
let inline acosImpl(x: ^T) : ^T =
let inline asinImpl(x: ^T) : ^T =
let inline atanImpl(x: ^T) : ^T =
let inline atan2Impl(x: ^T) (y: ^T) : 'U =
let inline ceilImpl(x: ^T) : ^T =
let inline expImpl(x: ^T) : ^T =
let inline floorImpl (x: ^T) : ^T =
let inline truncateImpl (x: ^T) : ^T =
let inline roundImpl (x: ^T) : ^T =
let inline signImpl (x: ^T) : int =
let inline logImpl(x: ^T) : ^T =
let inline log10Impl(x: ^T) : ^T =
let inline sqrtImpl(x: ^T) : ^U =
let inline cosImpl(x: ^T) : ^T =
let inline coshImpl(x: ^T) : ^T =
let inline sinImpl(x: ^T) : ^T =
let inline sinhImpl(x: ^T) : ^T =
let inline tanImpl(x: ^T) : ^T =
let inline tanhImpl(x: ^T) : ^T =
let inline powImpl (x: ^T) (y: ^U) : ^T =
*)
member ctxt.ResolveEntity(entityRef) =
match entityResolutions.TryGetValue(entityRef) with
| true, v -> v
| _ ->
let (DEntityRef typeName) = entityRef
let res =
match System.Type.GetType(typeName) with
| null -> failwithf "couldn't resolve type %A" typeName
| t -> REntity t
entityResolutions.Add(entityRef, res)
res
member ctxt.ResolveTypes(env, tys: DType[]) =
let res = tys |> Array.map (fun ty -> ctxt.ResolveType (env, ty))
if res |> Array.forall (function RType _ -> true | _ -> false) then
RTypes (res |> Array.map (function RType x -> x | _ -> failwith "unreachable"))
else
UTypes res
member ctxt.ResolveType(env, ty: DType) =
match ty with
| DArrayType(1, elemType) ->
match ctxt.ResolveType (env, elemType) with
| RTypeOrObj t -> RType (t.MakeArrayType())
| DArrayType(n, elemType) ->
match ctxt.ResolveType (env, elemType) with
| RTypeOrObj t -> RType (t.MakeArrayType(n))
| DNamedType((DEntityRef nm as n), argTypes) ->
// TODO: FCS quirk this is a hack to do with the fact that float<1> is being reported as a type by FCS and PortaCode
if nm.StartsWith "Microsoft.FSharp.Core.float`1" then
RType typeof<float>
elif nm.StartsWith "Microsoft.FSharp.Core.decimal`1" then
RType typeof<decimal>
elif nm.StartsWith "Microsoft.FSharp.Core.float32`1" then
RType typeof<float32>
elif nm.StartsWith "Microsoft.FSharp.Core.int32`1" then
RType typeof<int32>
else
let (RTypesOrObj argTypesR) = ctxt.ResolveTypes (env, argTypes)
match ctxt.ResolveEntity n, argTypesR with
| REntity e, [| |] -> RType e
| REntity e, tys -> RType (e.MakeGenericType(tys))
| UEntity u1, u2 -> UNamedType (u1, u2)
| DFunctionType (t1, t2) ->
let (RTypeOrObj t1R) = ctxt.ResolveType (env, t1)
let (RTypeOrObj t2R) = ctxt.ResolveType (env, t2)
RType (typedefof<int -> int>.MakeGenericType(t1R, t2R))
| DTupleType(isStruct, argTypes) ->
let (RTypesOrObj tys) = ctxt.ResolveTypes (env, argTypes)
RType (if isStruct then failwith "struct tuple NYI" (* FSharp.Reflection.FSharpType.MakeStructTupleType(Array.ofList tys) *) else FSharp.Reflection.FSharpType.MakeTupleType(tys))
| DVariableType v ->
match env.Types.TryGetValue v with
| true, res -> RType res
| _ ->
printfn "variable type %s not found" v
RType typeof<obj>
member ctxt.ResolveUnionCase(unionType, unionCaseRef) =
let (DUnionCaseRef unionCaseName) = unionCaseRef
// TODO: create formal type environment
let env = envEmpty
let unionTypeR = ctxt.ResolveType (env, unionType)
match unionTypeR with
| RType unionTypeV ->
let ucases = Reflection.FSharpType.GetUnionCases(unionTypeV, bindAll)
let ucase = ucases |> Array.find (fun uc -> uc.Name = unionCaseName)
let make = Reflection.FSharpValue.PreComputeUnionConstructor(ucase, bindAll)
let tag = Reflection.FSharpValue.PreComputeUnionTagReader(unionTypeV, bindAll)
let get = Reflection.FSharpValue.PreComputeUnionReader(ucase, bindAll)
RUnionCase (ucase, tag, make, get)
| UNamedType (unionTypeDef, _) ->
let tag = unionTypeDef.UnionCases |> Array.findIndex (fun x -> x = unionCaseName)
UUnionCase (tag, unionCaseName)
member ctxt.ResolveField(classOrRecordType,fieldRef) =
let (DFieldRef (index, fieldName)) = fieldRef
// TODO: create formal type environment
let env = envEmpty
let classOrRecordTypeR = ctxt.ResolveType(env, classOrRecordType)
match classOrRecordTypeR with
| RType classOrRecordTypeV ->
match classOrRecordTypeV.GetField(fieldName, bindAll) with
| null ->
match classOrRecordTypeV.GetProperty(fieldName, bindAll) with
| null -> failwithf "couldn't find field %s in type %A" fieldName classOrRecordType
| pinfo -> RField pinfo
| finfo -> RField finfo
| ty ->
UField (index, ty, fieldName)
member ctxt.ResolveILField(fieldType, fieldName) =
// TODO: create formal type environment
let env = envEmpty
let fieldTypeR = ctxt.ResolveType (env, fieldType)
match fieldTypeR with
| RType classOrRecordTypeV ->
let field = classOrRecordTypeV.GetField(fieldName, bindAll)
RField field
| _ty ->
failwithf "unexpected resolve of ILField %s in interpreted type %A" fieldName fieldType
member ctxt.MakeRMethod(m: MethodInfo) =
if m = op_float then RPrim_float
elif m = op_float32 then RPrim_float32
elif m = op_double then RPrim_double
elif m = op_single then RPrim_single
elif m = op_int32 then RPrim_int32
elif m = op_int then RPrim_int32
elif m = op_byte then RPrim_byte
elif m = op_int16 then RPrim_int16
elif m = op_int64 then RPrim_int64
elif m = op_uint16 then RPrim_uint16
elif m = op_uint32 then RPrim_uint32
elif m = op_uint64 then RPrim_uint64
elif m = op_decimal then RPrim_decimal
elif m = op_unativeint then RPrim_unativeint
elif m = op_nativeint then RPrim_nativeint
elif m = op_char then RPrim_char
elif m = op_neg then RPrim_neg
elif m = op_pos then RPrim_pos
elif m = op_minus then RPrim_minus
elif m = op_divide then RPrim_divide
elif m = op_mod then RPrim_mod
elif m = op_shiftleft then RPrim_shiftleft
elif m = op_shiftright then RPrim_shiftright
elif m = op_land then RPrim_land
elif m = op_lor then RPrim_lor
elif m = op_lxor then RPrim_lxor
elif m = op_lneg then RPrim_lneg
else RMethod m
member ctxt.InterpMethod(env, eR, nm, paramTys) =
let paramTysR = ctxt.ResolveTypes (env, paramTys)
let key = (eR, nm, paramTysR)
if not (members.ContainsKey(key)) then failwithf "No member found for key %A" key
let minfo = members.[key]
UMember minfo
member ctxt.ResolveMethod(v: DMemberRef) =
// TODO: create formal type environment
let env = envEmpty
let (DMemberRef(entity, nm, genericParams, paramTys, _retTy)) = v
match ctxt.ResolveEntity entity with
| REntity entityType as eR ->
let n = paramTys.Length
if nm = ".ctor" || nm = ".cctor" then
match entityType.GetConstructors(bindAll) |> Array.filter (fun m -> m.Name = nm && m.GetParameters().Length = n) with
| [| cinfo |] -> RMethod cinfo
| _res ->
// TODO: create formal type environment
let (RTypesOrObj paramTysV) = ctxt.ResolveTypes (env, paramTys)
match entityType.GetConstructor(bindAll, null, paramTysV, null) with
| null -> ctxt.InterpMethod(env, 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 ->
// TODO: cleanup FCS and portacode so names of properties are never used
match entityType.GetProperty(nm, bindAll) with
| null -> ctxt.InterpMethod(env, eR, nm, paramTys)
| pinfo -> ctxt.MakeRMethod pinfo.GetMethod
| _res ->
// TODO: create formal type environment
let (RTypesOrObj paramTysV) = ctxt.ResolveTypes (env, paramTys)
match entityType.GetMethod(nm, bindAll, null, paramTysV, null) with
| null -> ctxt.InterpMethod(env, eR, nm, paramTys)
| minfo -> RMethod minfo
| eR ->
ctxt.InterpMethod(env, eR, nm, paramTys)
member ctxt.AddDecls(decls: DDecl[]) =
// TODO: create formal type environment
let env = envEmpty
for decl in decls do
match decl with
| DDeclEntity (entityDef, subDecls) ->
let entityName = entityDef.Name
// Override any existing resolution
entityResolutions.[DEntityRef entityName] <- UEntity entityDef
ctxt.AddDecls(subDecls)
| DDeclMember (membDef, _body) when 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 thunk = ctxt.EvalMethodLambda (envEmpty, membDef.IsInstance, membDef.GenericParameters, membDef.Parameters, body)
members.Add((ty, membDef.Name, paramTypesR), Value thunk)
| _ -> ()
member ctxt.EvalMethodLambda(env, isInstance, typeParameters, parameters: DLocalDef[], body) =
MethodLambdaValue
(FuncConvert.FromFunc<Type[] * obj[],obj>(fun (tyargs, args) ->
if parameters.Length + (if isInstance then 1 else 0) <> args.Length then failwithf "arg/parameter mismatch for method with arguments %A" parameters
let env = if isInstance then bindByName env "$this" (Value args.[0]) else env
let env = (env, parameters, (if isInstance then args.[1..] else args)) |||> Array.fold2 (fun env p a -> bind env p (Value a))
let env = (env, typeParameters, tyargs) |||> Array.fold2 (fun env p a -> bindty env p a)
box (ctxt.EvalExpr(env, body) |> getVal)))
member ctxt.EvalDecls(env, decls: DDecl[]) =
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 ->
let ty = ctxt.ResolveEntity(membDef.EnclosingEntity)
let res = ctxt.EvalExpr (env, body)
members.Add ((ty, membDef.Name, RTypes [| |]), res)
| DDeclMember _->
()
| DDecl.InitAction expr ->
ctxt.EvalExpr (env, expr) |> ignore
member ctxt.GetExprDeclResult(ty, memberName) =
members.[(ty, memberName, RTypes [| |])]
member ctxt.EvalExpr(env, expr: DExpr) : Value =
match expr with
| DExpr.Application(funcExpr, typeArgs, argExprs) -> ctxt.EvalApplication(env, funcExpr, typeArgs, argExprs)
| DExpr.Call(objExprOpt, memberOrFunc, typeArgs1, typeArgs2, argExprs) -> ctxt.EvalCall(env, objExprOpt, memberOrFunc, typeArgs1, typeArgs2, argExprs)
| DExpr.Coerce(_targetType, inpExpr) -> ctxt.EvalExpr(env, inpExpr)
| DExpr.Lambda(domainTy, rangeTy, lambdaVar, bodyExpr) -> ctxt.EvalLambda(env, domainTy, rangeTy, lambdaVar, bodyExpr)
| DExpr.Let((bindingVar, bindingExpr), bodyExpr) -> ctxt.EvalLet(env, (bindingVar, bindingExpr), bodyExpr)
| DExpr.NewObject(objCtor, typeArgs, argExprs) -> ctxt.EvalNewObject(env, objCtor, typeArgs, argExprs)
| DExpr.NewRecord(recordType, argExprs) -> ctxt.EvalNewRecord(env, recordType, argExprs)
| DExpr.NewUnionCase(unionType, unionCase, argExprs) -> ctxt.EvalNewUnionCase(env, unionType, unionCase, argExprs)
| DExpr.FSharpFieldGet(objExprOpt, recordOrClassType, fieldInfo) -> ctxt.EvalFieldGet(env, objExprOpt, recordOrClassType, fieldInfo)
| DExpr.ILFieldGet(objExprOpt, fieldType, fieldName) -> ctxt.EvalILFieldGet(env, objExprOpt, fieldType, fieldName)
| DExpr.NewTuple(tupleType, argExprs) -> ctxt.EvalNewTuple(env, tupleType, argExprs)
| DExpr.DecisionTree(decisionExpr, decisionTargets) -> ctxt.EvalDecisionTree(env, decisionExpr, decisionTargets)
| DExpr.DecisionTreeSuccess(decisionTargetIdx, decisionTargetExprs) -> ctxt.EvalDecisionTreeSuccess(env, decisionTargetIdx, decisionTargetExprs)
| DExpr.Sequential(firstExpr, secondExpr) -> ctxt.EvalSequential(env, firstExpr, secondExpr)
| DExpr.NewArray(arrayType, argExprs) -> ctxt.EvalNewArray(env, arrayType, argExprs)
| DExpr.IfThenElse (guardExpr, thenExpr, elseExpr) -> ctxt.EvalIfThenElse (env, guardExpr, thenExpr, elseExpr)
| DExpr.TryFinally(bodyExpr, finallyExpr) -> ctxt.EvalTryFinally(env, bodyExpr, finallyExpr)
| DExpr.TupleGet(_tupleType, tupleElemIndex, tupleExpr) -> ctxt.EvalTupleGet(env, tupleElemIndex, tupleExpr)
| DExpr.TryWith(bodyExpr, filterVar, filterExpr, catchVar, catchExpr) -> ctxt.EvalTryWith(env, bodyExpr, filterVar, filterExpr, catchVar, catchExpr)
| DExpr.WhileLoop(guardExpr, bodyExpr) -> ctxt.EvalWhileLoop(env, guardExpr, bodyExpr)
| DExpr.UnionCaseTest(unionExpr, unionType, unionCase) -> ctxt.EvalUnionCaseTest(env, unionExpr, unionType, unionCase)
| DExpr.UnionCaseGet(unionExpr, unionType, unionCase, unionCaseField) -> ctxt.EvalUnionCaseGet(env, unionExpr, unionType, unionCase, unionCaseField)
| DExpr.UnionCaseTag(unionExpr, unionType) -> ctxt.EvalUnionCaseTag(env, unionExpr, unionType)
(*
// TODO:
| DExpr.AddressOf(lvalueExpr) -> ctxt.EvalAddressOf(convExpr lvalueExpr)
| DExpr.AddressSet(lvalueExpr, rvalueExpr) -> ctxt.EvalAddressSet(convExpr lvalueExpr, convExpr rvalueExpr)
| DExpr.FastIntegerForLoop(startExpr, limitExpr, consumeExpr, isUp) -> ctxt.EvalFastIntegerForLoop(convExpr startExpr, convExpr limitExpr, convExpr consumeExpr, isUp)
| DExpr.LetRec(recursiveBindings, bodyExpr) -> ctxt.EvalLetRec(List.map (map2 convValue convExpr) recursiveBindings, convExpr bodyExpr)
| DExpr.NewDelegate(delegateType, delegateBodyExpr) -> ctxt.EvalNewDelegate(convType delegateType, convExpr delegateBodyExpr)
| DExpr.Quote(quotedExpr) -> ctxt.EvalQuote(convExpr quotedExpr)
| DExpr.FSharpFieldSet(objExprOpt, recordOrClassType, fieldInfo, argExpr) -> ctxt.EvalFSharpFieldSet(convExprOpt objExprOpt, convType recordOrClassType, convField fieldInfo, convExpr argExpr)
| DExpr.TypeLambda(genericParams, bodyExpr) -> ctxt.EvalTypeLambda(List.map convGenericParam genericParams, convExpr bodyExpr)
| DExpr.TypeTest(ty, inpExpr) -> ctxt.EvalTypeTest(convType ty, convExpr inpExpr)
| DExpr.ObjectExpr(objType, baseCallExpr, overrides, interfaceImplementations) -> ctxt.EvalObjectExpr(convType objType, convExpr baseCallExpr, List.map convObjMember overrides, List.map (map2 convType (List.map convObjMember)) interfaceImplementations)
| DExpr.DefaultValue defaultType -> ctxt.EvalDefaultValue (convType defaultType)
//| DExpr.TraitCall(sourceTypes, traitName, typeArgs, typeInstantiation, argTypes, argExprs) -> ctxt.EvalTraitCall(sourceTypes, traitName, typeArgs, typeInstantiation, argTypes, argExprs)
| DExpr.UnionCaseSet(unionExpr, unionType, unionCase, unionCaseField, valueExpr) -> ctxt.EvalUnionCaseSet(convExpr unionExpr, convType unionType, convUnionCase unionCase, convField unionCaseField, convExpr valueExpr)
| DExpr.ILAsm(asmCode, typeArgs, argExprs) -> ctxt.EvalILAsm(asmCode, convTypes typeArgs, convExprs argExprs)
| DExpr.ILFieldSet (objExprOpt, fieldType, fieldName, valueExpr) -> ctxt.EvalILFieldSet (convExprOpt objExprOpt, convType fieldType, fieldName, convExpr valueExpr)
*)
| DExpr.BaseValue _thisType
| DExpr.ThisValue _thisType ->
match env.Vals.TryGetValue "$this" with
| true, res -> res
| _ -> failwithf "didn't find this value in the environment"
| DExpr.Value(DLocalRef (v, isThisValue, isMutable)) ->
if isThisValue then
match env.Vals.TryGetValue "$this" with
| true, res -> res
| _ -> failwithf "didn't find this value in the environment"
elif isMutable then
match env.Vals.TryGetValue v with
| true, Value (:? ref<obj> as rv) -> Value rv.Value
| _ -> failwithf "didn't find mutable value in the environment"
else
match env.Vals.TryGetValue v with
| true, res -> res
| _ -> failwithf "didn't find value '%s' in the environment" v
| DExpr.ValueSet(DLocalRef (valToSet, _, _), valueExpr) ->
let valueExprV : obj = ctxt.EvalExpr(env, valueExpr) |> getVal
match env.Vals.TryGetValue valToSet with
| true, Value (:? ref<obj> as rv) ->
rv := valueExprV
Value null
| _ -> failwithf "didn't find mutable value in the environment"
| DExpr.Const(constValueObj, _constType) ->
Value constValueObj
| _ -> failwithf "unrecognized %+A" expr
member ctxt.EvalExprs(env, argExprs) =
let argsV = argExprs |> Array.map (fun argExpr -> ctxt.EvalExpr(env, argExpr))
argsV |> Array.map getVal
member ctxt.EvalExprOpt(env, objExprOpt) =
let objValOpt = objExprOpt |> Option.map (fun objExpr -> ctxt.EvalExpr(env, objExpr))
objValOpt |> Option.map getVal |> Option.toObj
member ctxt.EvalNewObject(env, objCtor, typeArgs, argExprs) =
let argsV = ctxt.EvalExprs(env, argExprs)
let typeArgsR = ctxt.ResolveTypes (env, typeArgs)
let methR = ctxt.ResolveMethod objCtor
match methR, typeArgsR with
| RMethod (:? ConstructorInfo as cinfo), RTypesOrObj typeArgsV ->
let icinfo =
if cinfo.DeclaringType.IsGenericType then
let tinfo = cinfo.DeclaringType.MakeGenericType(typeArgsV)
tinfo.GetConstructors(bindAll) |> Array.find (fun cinfo2 -> cinfo2.MetadataToken = cinfo.MetadataToken)
else cinfo
try icinfo.Invoke(argsV) |> Value
with :? TargetInvocationException as e ->
raise e.InnerException
| UMember (Value (:? MethodLambdaValue as fM )), RTypesOrObj typeArgsV ->
let (MethodLambdaValue f) = fM
f (typeArgsV, argsV) |> Value
| _ ->
failwithf "unexpected constructor %A at types %A" methR typeArgsR
member ctxt.EvalApplication(env, funcExpr, _typeArgs, argExprs) =
let funcV = ctxt.EvalExpr(env, funcExpr)
let argsV = ctxt.EvalExprs(env, argExprs)
ctxt.EvalApplicationOfArg(env, funcV, argsV)
member ctxt.EvalApplicationOfArg(env, funcV, argsV) =
match getVal funcV, argsV with
| :? (obj -> obj) as f, [| obj |] -> f obj |> Value
| f, _ ->
if argsV.Length = 0 then
failwithf "unexpected empty arguments in application of %A" f
else
let t = f.GetType()
let i = t.GetMethod("Invoke")
let res =
try i.Invoke(f, [| argsV.[0] |]) |> Value
with :? TargetInvocationException as e ->
raise e.InnerException
if argsV.Length > 1 then
ctxt.EvalApplicationOfArg(env, res, argsV.[1..])
else
res
member ctxt.EvalLet(env, (bindingVar, bindingExpr), bodyExpr) =
let bindingExprV = ctxt.EvalExpr(env, bindingExpr)
let env = bind env bindingVar bindingExprV
ctxt.EvalExpr (env, bodyExpr)
member ctxt.EvalCall(env, objExprOpt, memberOrFunc, typeArgs1, typeArgs2, argExprs) =
let objOptV = ctxt.EvalExprOpt (env, objExprOpt)
let argsV = ctxt.EvalExprs (env, argExprs)
let methR = ctxt.ResolveMethod memberOrFunc
// These primitives don't have dynamic invocation implementations
match methR with
| RPrim_float -> Value (Convert.ToDouble argsV.[0])
| RPrim_double -> Value (Convert.ToDouble argsV.[0])
| RPrim_single -> Value (Convert.ToSingle argsV.[0])
| RPrim_int32 -> Value (Convert.ToInt32 argsV.[0])
| RPrim_int16 -> Value (Convert.ToInt16 argsV.[0])
| RPrim_int64 -> Value (Convert.ToInt64 argsV.[0])
| RPrim_byte -> Value (Convert.ToByte argsV.[0])
| RPrim_uint16 -> Value (Convert.ToUInt16 argsV.[0])
| RPrim_uint32 -> Value (Convert.ToUInt32 argsV.[0])
| RPrim_uint64 -> Value (Convert.ToUInt64 argsV.[0])
| RPrim_decimal -> Value (Convert.ToDecimal argsV.[0])
//| RPrim_unativeint -> Value (Convert.ToUIntPtr argsV.[0])
//| RPrim_nativeint -> Value (Convert.ToIntPtr argsV.[0])
| RPrim_char -> Value (Convert.ToChar argsV.[0])
| RPrim_neg -> Value (match argsV.[0] with :? int32 as v -> -v | _ -> failwith "nyi:neg")
| RPrim_pos -> Value argsV.[0]
| RPrim_minus -> binOp argsV (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-)
| RPrim_divide -> binOp argsV (/) (/) (/) (/) (/) (/) (/) (/) (/) (/) (/)
| RPrim_mod -> binOp argsV (%) (%) (%) (%) (%) (%) (%) (%) (%) (%) (%)
| RPrim_shiftleft -> shiftOp argsV (<<<) (<<<) (<<<) (<<<) (<<<) (<<<) (<<<) (<<<)
| RPrim_shiftright -> shiftOp argsV (>>>) (>>>) (>>>) (>>>) (>>>) (>>>) (>>>) (>>>)
| RPrim_land -> logicBinOp argsV (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&)
| RPrim_lor -> logicBinOp argsV (|||) (|||) (|||) (|||) (|||) (|||) (|||) (|||)
| RPrim_lxor -> logicBinOp argsV (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^)
| RPrim_lneg -> logicUnOp argsV (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) (~~~)
| _ ->
let typeArgs1R = ctxt.ResolveTypes (env, typeArgs1)
let typeArgs2R = ctxt.ResolveTypes (env, typeArgs2)
match methR, typeArgs1R, typeArgs2R with
| RMethod (:? MethodInfo as minfo), RTypesOrObj typeArgs1V, RTypesOrObj typeArgs2V ->
let iminfo =
if minfo.DeclaringType.IsGenericType then
let cinfo = minfo.DeclaringType.MakeGenericType(typeArgs1V)
match cinfo.GetMethods(bindAll) |> Array.tryFind (fun m -> m.MetadataToken = minfo.MetadataToken) with
| Some minfo2 ->
if minfo.IsGenericMethod then
minfo2.MakeGenericMethod (typeArgs2V)
else
minfo2
| None ->
failwithf "didn't find a matching method for %A with the right token" minfo
elif minfo.IsGenericMethod then
minfo.MakeGenericMethod(typeArgs2V)
else minfo
try iminfo.Invoke(objOptV, argsV) |> Value
with :? TargetInvocationException as e ->
raise e.InnerException
| RMethod (:? ConstructorInfo as cinfo), RTypesOrObj _typeArgs1V, RTypesOrObj _typeArgs2V ->
try cinfo.Invoke(argsV) |> Value
with :? TargetInvocationException as e ->
raise e.InnerException
| UMember (Value (:? MethodLambdaValue as fM )), RTypesOrObj typeArgs1V, RTypesOrObj typeArgs2V ->
let (MethodLambdaValue f) = fM
let callArgsV = (match objOptV with null -> argsV | objV -> Array.append [| objV |] argsV)
let callTypeArgsV = Array.append typeArgs1V typeArgs2V
f (callTypeArgsV, callArgsV) |> Value
| UMember (Value v), RTypes [| |], RTypes [| |] when argExprs.Length = 0 ->
v |> Value
| _ ->
failwithf "unexpected member %A at types %A %A" methR typeArgs1R typeArgs2R
member ctxt.EvalFieldGet(env, objExprOpt, recordOrClassType, fieldInfo) =
let objOptV = ctxt.EvalExprOpt(env, objExprOpt)
let fieldR = ctxt.ResolveField (recordOrClassType, fieldInfo)
match fieldR with
| RField (:? FieldInfo as finfo) -> finfo.GetValue(objOptV) |> Value
| RField (:? PropertyInfo as pinfo) -> pinfo.GetValue(objOptV) |> Value
| RField _ -> failwith "unexpected field resolution"
| UField (i, _ty, nm) ->
match objOptV with
| :? RecordValue as recdV ->
let (RecordValue argsV) = recdV
argsV.[i] |> Value
| _ -> failwithf "unexpected kind of interpreted value %A while getting field %s" objOptV nm
member ctxt.EvalILFieldGet(env, objExprOpt, recordOrClassType, fieldInfo) =
let objOptV = ctxt.EvalExprOpt(env, objExprOpt)
let fieldR = ctxt.ResolveILField (recordOrClassType, fieldInfo)
match fieldR with
| RField (:? FieldInfo as finfo) -> finfo.GetValue(objOptV) |> Value
| RField (:? PropertyInfo as pinfo) -> pinfo.GetValue(objOptV) |> Value
| RField _ -> failwith "unexpected field resolution"
| UField (_i, _ty, nm) -> failwithf "unexpected ILFieldGet %s in interpreted type %A" nm recordOrClassType
member ctxt.EvalLambda(env, domainType, rangeType, lambdaVar, bodyExpr) =
let domainTypeR = ctxt.ResolveType (env, domainType)
let rangeTypeR = ctxt.ResolveType (env, rangeType)
match domainTypeR, rangeTypeR with
| RTypeOrObj domainTypeV, RTypeOrObj rangeTypeV ->
let funcTypeV = typedefof<int -> int>.MakeGenericType(domainTypeV, rangeTypeV)
FSharp.Reflection.FSharpValue.MakeFunction(funcTypeV, (fun (arg: obj) ->
let env = bind env lambdaVar (Value arg)
ctxt.EvalExpr(env, bodyExpr) |> getVal)) |> box |> Value
member ctxt.EvalNewArray(env, arrayType, argExprs) =
let arrayTypeR = ctxt.ResolveType (env, arrayType)
let argsV = ctxt.EvalExprs(env, argExprs)
match arrayTypeR with
| RType arrayTypeV ->
let arr = Array.CreateInstance(arrayTypeV, argsV.Length)
argsV |> Array.iteri (fun i argV -> arr.SetValue(argV, i))
Value arr
| _ ->
failwithf "unexpected failure to resolve array type %A" arrayType
member ctxt.EvalNewRecord(env, recordType, argExprs) =
let recordTypeR = ctxt.ResolveType (env, recordType)
let argsV = ctxt.EvalExprs(env, argExprs)
match recordTypeR with
| RType recordTypeV ->
Reflection.FSharpValue.MakeRecord(recordTypeV, argsV, bindAll) |> Value
| _ ->
let recdV = RecordValue argsV
Value recdV
member ctxt.EvalNewUnionCase(env, unionType, unionCase, argExprs) =
let unionCaseR = ctxt.ResolveUnionCase (unionType, unionCase)
let argsV = ctxt.EvalExprs (env, argExprs)
match unionCaseR with
| RUnionCase (_ucase, _tag, make, _get) -> make argsV |> Value
| UUnionCase (tag, unionCaseName) ->
let unionV = UnionValue(tag, unionCaseName, argsV)
unionV |> box |> Value
member ctxt.EvalNewTuple(env, tupleType, argExprs) =
let tupleTypeR = ctxt.ResolveType (env, tupleType)
let argsV = ctxt.EvalExprs (env, argExprs)
match tupleTypeR with
| RType t -> Reflection.FSharpValue.MakeTuple(argsV, t) |> Value
| _ -> failwith "unresolve tuple type"
member ctxt.EvalDecisionTree(env, decisionExpr, decisionTargets) =
let env = { env with Targets = decisionTargets }
ctxt.EvalExpr (env, decisionExpr)
member ctxt.EvalDecisionTreeSuccess(env, decisionTargetIdx, decisionTargetExprs) =
let (locals, expr) = env.Targets.[decisionTargetIdx]
let env = (env, locals, decisionTargetExprs) |||> Array.fold2 (fun env p a -> bind env p (Value a))
ctxt.EvalExpr (env, expr)
member ctxt.EvalSequential(env, firstExpr, secondExpr) =
let _ = ctxt.EvalExpr (env, firstExpr)
ctxt.EvalExpr (env, secondExpr)
member ctxt.EvalIfThenElse(env, guardExpr, thenExpr, elseExpr) =
if ctxt.EvalBool(env, guardExpr) then
ctxt.EvalExpr (env, thenExpr)
else
ctxt.EvalExpr (env, elseExpr)
member ctxt.EvalBool(env, expr) =
match ctxt.EvalExpr (env, expr) |> getVal with
| :? bool as v -> v
| _ -> failwith "unexpected result type from bool expr"
member ctxt.EvalTryFinally(env, bodyExpr, finallyExpr) =
try
ctxt.EvalExpr (env, bodyExpr)
finally
ctxt.EvalExpr (env, finallyExpr) |> ignore
member ctxt.EvalTryWith(env, bodyExpr, filterVar, filterExpr, catchVar, catchExpr) =
try
ctxt.EvalExpr (env, bodyExpr)
with e when ctxt.EvalBool (bind env filterVar (Value e), filterExpr) ->
ctxt.EvalExpr (bind env catchVar (Value e), catchExpr)
member ctxt.EvalTupleGet(env, tupleElemIndex, tupleExpr) =
let tupleExprV = ctxt.EvalExpr(env, tupleExpr) |> getVal
Reflection.FSharpValue.GetTupleField(tupleExprV, tupleElemIndex) |> Value
member ctxt.EvalWhileLoop(env, guardExpr, bodyExpr) =
if ctxt.EvalBool(env, guardExpr) then
ctxt.EvalExpr (env, bodyExpr) |> ignore
ctxt.EvalWhileLoop(env, guardExpr, bodyExpr)
else
Value (box ())
member ctxt.EvalUnionCaseTest(env, unionExpr, unionType, unionCase) =
let unionCaseR = ctxt.ResolveUnionCase (unionType, unionCase)
let unionV : obj = ctxt.EvalExpr (env, unionExpr) |> getVal
let res =
match unionCaseR with
| RUnionCase (ucase, tag, _make, _get) -> (tag unionV = ucase.Tag)
| UUnionCase (tag, _unionCaseName) ->
match unionV with
| :? UnionValue as p ->
let (UnionValue(tag2, _nm, _fields)) = p
tag = tag2
| _ -> failwithf "unexpected value '%A' in EvalUnionCaseTest" unionV
Value (box res)
member ctxt.EvalUnionCaseGet(env, unionExpr, unionType, unionCase, unionCaseField) =
let unionCaseR = ctxt.ResolveUnionCase (unionType, unionCase)
let unionCaseFieldR = ctxt.ResolveField (unionType, unionCaseField)
let unionV : obj = ctxt.EvalExpr (env, unionExpr) |> getVal
let res =
match unionCaseR with
| RUnionCase _ ->
match unionCaseFieldR with
| RField (:? FieldInfo as finfo) -> finfo.GetValue(unionV)
| RField (:? PropertyInfo as pinfo) -> pinfo.GetValue(unionV)
| _ -> failwithf "unexpected field resolution %A in EvalUnionCaseGet" unionCaseFieldR
| UUnionCase (_tag, _unionCaseName) ->
match unionV with
| :? UnionValue as unionV ->
let (UnionValue(_tag, _unionCaseName, fields)) = unionV
match unionCaseFieldR with
| UField (index, _, _) ->
fields.[index]
| RField _ ->
failwithf "unexpected field resolution %A in EvalUnionCaseGet" unionCaseFieldR
| _ -> failwithf "unexpected value '%A' in EvalUnionCaseGet" unionV
Value (box res)
member ctxt.EvalUnionCaseTag(env, unionExpr, unionType) =
let unionTypeR = ctxt.ResolveType (env, unionType)
let unionV : obj = ctxt.EvalExpr (env, unionExpr) |> getVal
let res =
match unionTypeR with
| RType unionTypeV ->
let tag = Reflection.FSharpValue.PreComputeUnionTagReader(unionTypeV, bindAll)
tag unionV
| _ ->
match unionV with
| :? (int * string * obj[]) as p ->
let (tag, _nm, _fields) = p
tag
| _ -> failwithf "unexpected value '%A' in EvalUnionCaseTag" unionV
Value (box res)

208
fscd/fscd.fs Normal file
Просмотреть файл

@ -0,0 +1,208 @@
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
// cd C:\GitHub\dsyme\Elmish.XamarinForms\Samples\CounterApp\CounterApp
// adb -d forward tcp:9867 tcp:9867
// dotnet run --project ..\..\..\fscd\fscd.fsproj -- --eval @out.args
// dotnet run --project ..\..\..\fscd\fscd.fsproj -- --watch --webhook:http://localhost:9867/update @out.args
module fscd.Driver
open FSharp.Compiler.PortaCode.CodeModel
open FSharp.Compiler.PortaCode.Interpreter
open FSharp.Compiler.PortaCode.FromCompilerService
open System
open System.IO
open System.Collections.Generic
open Microsoft.FSharp.Compiler.SourceCodeServices
open System.Net
#if TEST
module MockForms =
open Xamarin.Forms
open Xamarin.Forms.Internals
type MockPlatformServices() =
interface IPlatformServices with
member __. GetMD5Hash(input) = raise (NotImplementedException())
member __.GetNamedSize(size, targetElement, useOldSizes) = 10.0
member __.OpenUriAction(uri) = raise (NotImplementedException())
member __.IsInvokeRequired = false
member __.get_RuntimePlatform() = Unchecked.defaultof<_>
member __.BeginInvokeOnMainThread(action: Action) = action.Invoke()
member __.CreateTicker() = raise (NotImplementedException())
member __.StartTimer(interval, callback) = raise (NotImplementedException())
member __.GetStreamAsync(uri, cancellationToken) = raise (NotImplementedException())
member __.GetAssemblies() = raise (NotImplementedException())
member __.GetUserStoreForApplication() = raise (NotImplementedException())
member __.QuitApplication() = raise (NotImplementedException())
type MockDeserializer() =
interface IDeserializer with
member __.DeserializePropertiesAsync() = raise (NotImplementedException())
member __.SerializePropertiesAsync(properties: IDictionary<string, obj>) = raise (NotImplementedException())
type MockResourcesProvider() =
interface ISystemResourcesProvider with
member __.GetSystemResources() = raise (NotImplementedException())
type MockDeviceInfo() =
inherit DeviceInfo()
override __.PixelScreenSize = raise (NotImplementedException())
override __.ScaledScreenSize = raise (NotImplementedException())
override __.ScalingFactor = raise (NotImplementedException())
let Init() =
Device.Info <- new MockDeviceInfo()
Device.PlatformServices <- new MockPlatformServices()
DependencyService.Register<MockResourcesProvider>()
DependencyService.Register<MockDeserializer>()
#endif
let checker = FSharpChecker.Create(keepAssemblyContents = true)
#if !TEST
[<EntryPoint>]
#endif
let main (argv: string[]) =
try
printfn "hello! argv = %A" argv
#if TEST
MockForms.Init()
#endif
let mutable eval = false
let mutable watch = false
let mutable webhook = None
let args =
let mutable haveDashes = false
[| for arg in argv do
if arg.StartsWith("@") then
for line in File.ReadAllLines(arg.[1..]) do
if not (String.IsNullOrWhiteSpace line) then
yield line
elif arg = "--" then haveDashes <- true
elif arg = "--watch" then watch <- true
elif arg = "--eval" then eval <- true
elif arg.StartsWith "--webhook:" then webhook <- Some arg.["--webhook:".Length ..]
else yield arg |]
for arg in args do
printfn "arg %s" arg
let sourceFiles, otherFlags = args |> Array.partition (fun arg -> arg.EndsWith(".fs") || arg.EndsWith(".fsi") || arg.EndsWith(".fsx"))
let sourceFiles = sourceFiles |> Array.map Path.GetFullPath
printfn "curr = %s" Environment.CurrentDirectory
let options = checker.GetProjectOptionsFromCommandLineArgs("tmp.fsproj", otherFlags)
let options = { options with SourceFiles = sourceFiles }
printfn "options = %A" options
let rec checkFile count sourceFile =
try
let _, checkResults = checker.ParseAndCheckFileInProject(sourceFile, 0, File.ReadAllText(sourceFile), options) |> Async.RunSynchronously
match checkResults with
| FSharpCheckFileAnswer.Aborted ->
printfn "aborted"
Result.Error ()
| FSharpCheckFileAnswer.Succeeded res ->
let mutable hasErrors = false
for error in res.Errors do
printfn "%s" (error.ToString())
if error.Severity = FSharpErrorSeverity.Error then
hasErrors <- true
if hasErrors then
Result.Error ()
else
Result.Ok res.ImplementationFile
with
| :? System.IO.IOException when count = 0 -> System.Threading.Thread.Sleep 500; checkFile 1 sourceFile
| exn ->
printfn "%s" (exn.ToString())
Result.Error ()
let convFile (i: FSharpImplementationFileContents) =
//(i.QualifiedName, i.FileName
{ Code = convDecls i.Declarations }
let jsonFile (i: FSharpImplementationFileContents) =
let data = convFile i
let serializer = MBrace.FsPickler.Json.FsPickler.CreateJsonSerializer( (* indent=true *) )
let json = serializer.PickleToString(data)
json
if watch then
let watchers =
[ for sourceFile in sourceFiles do
let path = Path.GetDirectoryName(sourceFile)
let fileName = Path.GetFileName(sourceFile)
printfn "fscd: WATCHING %s in %s" fileName path
let watcher = new FileSystemWatcher(path, fileName)
watcher.NotifyFilter <- NotifyFilters.Attributes ||| NotifyFilters.CreationTime ||| NotifyFilters.FileName ||| NotifyFilters.LastAccess ||| NotifyFilters.LastWrite ||| NotifyFilters.Size ||| NotifyFilters.Security;
let changed = (fun (ev: FileSystemEventArgs) ->
printfn "fscd: CHANGE DETECTED for %s, COMPILING...." sourceFile
match checkFile 0 ev.FullPath with
| Result.Error () ->
printfn "fscd: ERRORS for %s" sourceFile
| Result.Ok iopt ->
printfn "fscd: COMPILED %s" sourceFile
match iopt with
| None -> ()
| Some i ->
printfn "fscd: GOT PortaCode for %s" sourceFile
let json = jsonFile i
printfn "fscd: GOT JSON for %s, length = %d" sourceFile json.Length
match webhook with
| Some hook ->
try
use webClient = new WebClient()
printfn "fscd: SENDING TO WEBHOOK... " // : <<<%s>>>... --> %s" json.[0 .. min (json.Length - 1) 100] hook
let resp = webClient.UploadString(hook,"Put",json)
printfn "fscd: RESP FROM WEBHOOK: %s" resp
with err ->
printfn "fscd: ERROR SENDING TO WEBHOOK: %A" (err.ToString())
| None ->
())
watcher.Changed.Add changed
//watcher.Created.Add changed
//watcher.Deleted.Add changed
yield watcher ]
for watcher in watchers do
watcher.EnableRaisingEvents <- true
printfn "Waiting for changes..."
System.Console.ReadLine() |> ignore
for watcher in watchers do
watcher.EnableRaisingEvents <- true
else
let fileContents =
[| for sourceFile in sourceFiles do
match checkFile 0 sourceFile with
| Result.Error _ -> failwith "errors"
| Result.Ok iopt ->
match iopt with
| None -> () // signature file
| Some i -> yield i |]
printfn "#ImplementationFiles = %d" fileContents.Length
if eval then
let ctxt = EvalContext()
let fileConvContents = [| for i in fileContents -> convFile i |]
for ds in fileConvContents do
ctxt.AddDecls(ds.Code)
for ds in fileConvContents do
//printfn "eval %A" a
ctxt.EvalDecls (envEmpty, ds.Code)
else
let fileConvContents = [| for i in fileContents -> jsonFile i |]
printfn "%A" fileConvContents
0
with e ->
printfn "Error: %s" (e.ToString())
1

22
fscd/fscd.fsproj Normal file
Просмотреть файл

@ -0,0 +1,22 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net472</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="CodeModel.fs" />
<Compile Include="Interpreter.fs" />
<Compile Include="FromCompilerService.fs" />
<Compile Include="fscd.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="FSharp.Compiler.Service" Version="23.0.3" />
<PackageReference Include="FsPickler" Version="5.2.0" />
<PackageReference Include="FsPickler.Json" Version="5.2.0" />
<PackageReference Update="FSharp.Core" Version="4.5.0" />
</ItemGroup>
</Project>

Просмотреть файл

@ -58,4 +58,4 @@ group macos
framework: xamarinmac20
source https://www.nuget.org/api/v2
nuget FSharp.Core 4.5.0
nuget Xamarin.Forms 3.0.0.482510
nuget Xamarin.Forms 3.0.0.482510

Просмотреть файл

@ -59,10 +59,11 @@ module App =
yield Xaml.Button(text="Reset", horizontalOptions=LayoutOptions.Center, command=fixf(fun () -> dispatch Reset), canExecute = (model <> initModel))
]))
let program = Program.mkProgram App.init App.update App.view
type App () as app =
inherit Application ()
let program = Program.mkProgram App.init App.update App.view
let runner =
program
#if DEBUG