open System
open System.Diagnostics
open System.Runtime.InteropServices
module PInvoke =
type EnumThreadDelegate= delegate of (IntPtr * IntPtr) -> bool
type ComArrayList() =
inherit System.Collections.ArrayList()
[<DllImport("user32.dll")>]
extern [<return: MarshalAs(UnmanagedType.Bool)>] bool private EnumThreadWindows(int dwThreadId, EnumThreadDelegate lpfn, IntPtr lParam);
let getThreadWindows (threadId:int) : _ list =
let items = ResizeArray()
let withData (hWnd:IntPtr, lParam:IntPtr) =
let _ = items.Add(hWnd,lParam)
true
let f = EnumThreadDelegate withData
EnumThreadWindows (threadId, f, IntPtr.Zero) |> ignore<bool>
items
|> Seq.cast<IntPtr*IntPtr>
|> List.ofSeq
let lp = Process.GetProcesses() |> Seq.filter(fun p -> p.ProcessName.StartsWith("L")) |> Seq.minBy(fun p -> p.StartTime)
lp.Threads
|> Seq.cast<ProcessThread>
|> Seq.map (fun t -> t.Id)
|> Seq.map PInvoke.getThreadWindows
|> List.ofSeq
gives System.Runtime.InteropServices.MarshalDirectiveException: Cannot marshal 'parameter #1': Generic types cannot be marshaled
but this one compiles and runs:
open System
open System.Diagnostics
open System.Runtime.InteropServices
module PInvoke =
type EnumThreadDelegate= delegate of IntPtr * IntPtr -> bool
type ComArrayList() =
inherit System.Collections.ArrayList()
[<DllImport("user32.dll")>]
extern [<return: MarshalAs(UnmanagedType.Bool)>] bool private EnumThreadWindows(int dwThreadId, EnumThreadDelegate lpfn, IntPtr lParam);
let getThreadWindows (threadId:int) : _ list =
let items = ResizeArray()
let withData (hWnd:IntPtr) (lParam:IntPtr) =
let _ = items.Add(hWnd,lParam)
true
let f = EnumThreadDelegate withData
EnumThreadWindows (threadId, f, IntPtr.Zero) |> ignore<bool>
items
|> Seq.cast<IntPtr*IntPtr>
|> List.ofSeq
let lp = Process.GetProcesses() |> Seq.filter(fun p -> p.ProcessName.StartsWith("L")) |> Seq.minBy(fun p -> p.StartTime)
lp.Threads
|> Seq.cast<ProcessThread>
|> Seq.map (fun t -> t.Id)
|> Seq.map PInvoke.getThreadWindows
|> List.ofSeq
why do both compile, but one gives an exception?
what's the difference between a delegate of (IntPtr*IntPtr) -> bool and delegate of IntPtr*IntPtr->bool?
shouldn't they be the same thing? is (IntPtr*IntPtr) not the same as IntPtr*IntPtr?
I think
delegate of (IntPtr*IntPtr) -> bool
is a one-argument delegate that takes a Tuple<IntPtr,IntPtr>, whereas
delegate of IntPtr*IntPtr -> bool
is a two-argument delegate that takes two IntPtrs as its two arguments.
Related
I defined some custom pipeline operators for Async and Task objects, but get compile error FS0002.
[<AutoOpen>]
module AsyncOperators =
type AsyncOperatorHelper = AsyncOperatorHelper with
static member (=>) (computation, AsyncOperatorHelper) =
fun cont ->
async.Bind(computation, cont)
static member (=>) (computation: Task<'a>, AsyncOperatorHelper) =
fun cont ->
async.Bind(computation |> Async.AwaitTask, cont)
static member (=>) (computation: Task, AsyncOperatorHelper) =
fun cont ->
async.Bind(computation |> Async.AwaitTask, cont)
static member (=->) (cont: 'a -> Task<'b>, AsyncOperatorHelper) =
cont >> Async.AwaitTask
static member (=->) (cont: 'a -> Task, AsyncOperatorHelper) =
cont >> Async.AwaitTask
static member (=->) (cont: 'a -> Async<'t>, AsyncOperatorHelper) =
cont
let inline (|~>) a b = (a => AsyncOperatorHelper) (b =-> AsyncOperatorHelper)
let inline (>~>) a b x = x |> (a =-> AsyncOperatorHelper) |~> (b =-> AsyncOperatorHelper)
let _test () =
let x = async.Return 0
let add1 = fun (s: int) -> (async.Return(s + 1))
// COMPILE OK !!
let y = x |~> add1
// But if I expand add1 in the expression:
// error FS0002: This function takes too many arguments, or is used in a context where a function is not expected
let z = x |~> (fun (s: int) -> (async.Return(s + 1)))
()
The two expressions look the same, but why the second one get FS0002 error? How can I fix the problem?
[<ReflectedDefinition>]
module Foo =
let x = 5
let y () = 6
let z a = a
I tried to find out how to get the AST in this situation a couple of times now and keep failing. Time to ask the question here.
So far, I thought that a module would be mappped to a class with static members internally and as such, it should be the equivalent of:
[<ReflectedDefinition>]
type Foo =
static member x = 5
static member y () = 6
static member z a = a
let bar_members =
typeof<Bar>.GetMethods()
|> Array.filter (fun mi -> match mi with | MethodWithReflectedDefinition x -> true | _ -> false)
|> Array.map (fun m -> sprintf "%s: %A" (m.Name) (Expr.TryGetReflectedDefinition(m :> MethodBase) ) )
In the latter case, I could use typeof<Foo>.GetMembers() (or GetMethods()?!), cast it to Reflection.MethodBase and use this as an argument for Expr.TryGetReflectedDefinition().
But unfortunately, this is not working with the module version.
So, how to do it?
If you want to play with the code, you might want to open some namespaces:
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.DerivedPatterns
open Microsoft.FSharp.Reflection
open System.Reflection
The problem comes go down to actually getting the type of the Module. In order to do that, there's a great answer here by Phillip Trelford: https://stackoverflow.com/a/14706890/5438433
Basically, you add a helper value to your module which returns the type of that module:
[<ReflectedDefinition>]
module Foo =
type internal IMarker = interface end
let fooType = typeof<IMarker>.DeclaringType
let x = 5
let y () = 6
let z a = a
You can then use fooType to retrieve the reflected definitions.
let foo_members =
Foo.fooType.GetMethods()
|> Array.filter (fun mi -> match mi with | MethodWithReflectedDefinition x -> true | _ -> false)
|> Array.map (fun m -> sprintf "%s: %A" (m.Name) (Expr.TryGetReflectedDefinition(m :> MethodBase) ) )
I can then, e.g. print the results:
[|"get_fooType: Some PropertyGet (Some (Call (None, TypeOf, [])), DeclaringType, [])";
"get_x: Some Value (5)";
"y: Some Lambda (unitVar0, Value (6))";
"z: Some Lambda (a, a)"|]
For the use case, when the reflected definitions are in another assembly (like an F# dll, for example), you can do without the marker interface trick, as shown below:
open System
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.DerivedPatterns
open Microsoft.FSharp.Reflection
open System.Reflection
open FSharp.Reflection.FSharpReflectionExtensions
let tryGetReflectedModules (a : Assembly) : seq<TypeInfo> =
a.DefinedTypes
|> Seq.filter
(fun dt ->
dt.CustomAttributes
|> Seq.map (fun cad -> cad.AttributeType)
|> Seq.filter ((=) (typeof<ReflectedDefinitionAttribute>))
|> Seq.isEmpty
|> not
)
let astFromReflectedDefinition (mi : MethodInfo) : Expr option =
mi :> MethodBase |> Expr.TryGetReflectedDefinition
let reflectedMethodsOfAModule (m : System.Type) : (MethodInfo * Expr) [] =
m.GetMethods()
|> Array.map (fun m -> (m,astFromReflectedDefinition m))
|> Array.filter (snd >> Option.isSome)
|> Array.map (fun (x,y) -> (x, Option.get y))
let reflectAssembly (assemblyPath : string) =
let a = System.Reflection.Assembly.LoadFile(assemblyPath)
a
|> tryGetReflectedModules
|> Seq.map (fun x -> (x,reflectedMethodsOfAModule (x.AsType())))
Where, for example, the assembly I used for testing the code above looked like this:
namespace Input
[<ReflectedDefinition>]
module Api =
let trace s =
for _ in [0..3] do System.Diagnostics.Trace.WriteLine s
[<ReflectedDefinition>]
module Foo =
let foobar (x : string) : string =
x.ToUpper()
You get the top level types in the assembly, which just so happen to be the (static) classes, representing the modules of the Fsharp assembly and test for the ReflectedDefinitionAttribute presence. Then, you take it from there.
given:
open System
open System.Linq.Expressions
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Linq.RuntimeHelpers
open FizzWare.NBuilder
let toLinq (expr: Expr<'a -> 'b>) =
let linq = LeafExpressionConverter.QuotationToExpression expr
let call = linq :?> MethodCallExpression
let lambda = call.Arguments.[0] :?> LambdaExpression
Expression.Lambda<Func<'a,'b>>(lambda.Body, lambda.Parameters)
let inline with'<'a,'b> (f:Expr<'a->'b>) (value:'b) (operable:IOperable<'a>) =
let f = toLinq f
operable.With(f,value)
let size = 20
let builderList =
Builder<dbEncounter.ServiceTypes.Patients>.CreateListOfSize(size).All()
|> with' <# fun x -> x.PatientID #> 0
|> with' <# fun x -> x.ForeignEHRID #> (Nullable 0)
|> with' <# fun x -> x.PatientInfoID #> (Nullable 0)
|> (fun b -> b.With(fun x-> x.PatientGUID <- Nullable (Guid.NewGuid()); x.PatientGUID ))
|> withf (fun x-> x.PatientGUID <- Nullable (Guid.NewGuid()); x.PatientGUID) // this line doesn't compile as a replacement for the previous line
my attempt at writing withf:
let inline withf<'a,'b> (f:Func<'a,_>) (operable:IOperable<'a>) =
operable.With(f)
the error on attempted usage of withf to replace the other option is
Found the answer thanks to #kvb 's other answer to another question
Interop between F# and C# lambdas
I just need to call the Func constructor like so:
let inline withf<'a,'b> (f:'a->'b) (operable:IOperable<'a>) =
operable.With(Func<'a,'b>(f))
so now this works:
let makePatients size =
let builderList =
Builder<dbEncounter.ServiceTypes.Patients>.CreateListOfSize(size).All()
|> with' <# fun x -> x.PatientID #> 0
|> with' <# fun x -> x.ForeignEHRID #> (Nullable 0)
|> with' <# fun x -> x.PatientInfoID #> (Nullable 0)
//|> (fun b -> b.With(fun x-> x.PatientGUID <- Nullable (Guid.NewGuid()); x.PatientGUID ))
|> withf (fun x-> x.PatientGUID <- Nullable (Guid.NewGuid()); x.PatientGUID)
I'm working on some DSL for my application and here's how I defined computation type and builder:
// expression type
type Action<'a,'b> = Action of ('a -> Async<'b>)
let runAction (Action r) ctx = r ctx
let returnF a = Action (fun _ -> async {return a})
let bind m f = Action (fun r -> async {
let! a = runAction m r in return! runAction (f a) r
})
let bindA ac f = Action (fun r -> async {
let! a = ac in return! runAction (f a) r
})
type ActionBuilder<'x>() =
member this.Return(c) = returnF c
member this.Zero() = returnF ()
member this.Delay(f) = bind (returnF ()) f
// binds both monadic and for async computations
member this.Bind(m, f) = bind m f
member this.Bind(m, f) = bindA m f
member this.Combine(r1, r2) = bind r1 (fun () -> r2)
member this.For(s:seq<_>, f) = Action (fun x -> async {
for i in s do runAction (f i) x |> ignore
})
// here's the attempt to implement 'need' operations
[<CustomOperation("need")>]
member this.Need(Action a, targets: string list) =
Action (fun x ->
let r = a x
printfn "need(%A, [%A])" a targets
r)
member this.For(a, f) = bindA a f
member this.Yield(()) =
returnF ()
let action = ActionBuilder<string>()
/////////////////////////////////////////////////////////////
// other functions for Action
/// Gets action context
let getCtx = Action (fun ctx -> async {return ctx})
let needFn res = action {
let! ctx = getCtx
printfn "need([%A]) in %A" res ctx
}
The resulting code is supposed to be:
let program1 = fun filename -> action {
let! a = async {return 123}
let f = a+1
// need ["def"; "dd"]
do! needFn ["def"; "dd"]
printfn "after need"
for i in [0..10] do
do! Async.Sleep (1)
printfn "i: %A" i
let! d = async {return f}
let! ctx = getCtx
printfn "ctx: %A, %A" ctx f
}
Async.RunSynchronously(runAction (program1 "m.c") "abc")
Now I would like to change do! needFn ["def"; "dd"] syntax to a nicer one by defining "need" custom operation, but getting various complains from compiler. Is it correct approach or I'm misusing the computation expressions?
The other issue is that for does not work if do! is used inside loop body.
After reading papers, by trial and error method I came to the following for implementation (Yield builder method is not required):
let forF (e: seq<_>) prog =
usingF (e.GetEnumerator()) (fun e ->
whileF
(fun () -> e.MoveNext())
((fun () -> prog e.Current) |> delayF)
)
Full source code for computation expression builder could be found in the target project. The whole project is a variation of Fake build system.
Note: Action was renamed to Recipe. need operator cannot be implemented at all.
Why is it that in F#, I can do this...
let s = seq { for i in 0 .. 4095 do yield i } :?> IEnumerator
... but this throws a System.InvalidCastException?
let s = Seq.init 4095 (fun i -> i) :?> IEnumerator
A sequence expression creates an object that implements IEnumerable<T> and IEnumerator<T>
let s = seq { for i in 0 .. 4095 do yield i }
printfn "%b" (s :? IEnumerable<int>) // true
printfn "%b" (s :? IEnumerator<int>) // true
But Seq.init does not:
let s = Seq.init 4095 (fun i -> i)
printfn "%b" (s :? IEnumerable<int>) // true
printfn "%b" (s :? IEnumerator<int>) // false
You could refactor your code to use IEnumerable<T> instead of IEnumerator since both constructs produce an IEnumerable<T>.
Alternatively, if you really want an IEnumerator, you could simply call GetEnumerator to return an Enumerator from an Enumerable:
let s = (Seq.init 4095 (fun i -> i)).GetEnumerator()
printfn "%b" (s :? IEnumerable<int>) // false
printfn "%b" (s :? IEnumerator<int>) // true
If you look at the specification, you sequence expression is converted to:
Seq.collect (fun pat -> Seq.singleton(pat)) (0 .. 4095)
if you look at the source for the definition of Seq.collect it is:
let collect f sources = map f sources |> concat
and if you look at the definition for concat it is:
let concat sources =
checkNonNull "sources" sources
mkConcatSeq sources
mkConcatSeq is defined as:
let mkConcatSeq (sources: seq<'U :> seq<'T>>) =
mkSeq (fun () -> new ConcatEnumerator<_,_>(sources) :> IEnumerator<'T>)
so you can see that the returned sequence implements IEnumerator<'T> and therefore IEnumerator.
Now Seq.init is defined as:
let init count f =
if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative))
mkSeq (fun () -> IEnumerator.upto (Some (count-1)) f)
and mkSeq is defined as:
let mkSeq f =
{ new IEnumerable<'U> with
member x.GetEnumerator() = f()
interface IEnumerable with
member x.GetEnumerator() = (f() :> IEnumerator) }
so it only implements IEnumerable<'T> and not IEnumerator.