How does non idiomatic global operator overloading work? - f#

I want to understand the code from this answer
type Mult = Mult with
static member inline ($) (Mult, v1: 'a list) = fun (v2: 'b list) ->
v1 |> List.collect (fun x -> v2 |> List.map (fun y -> (x, y))) : list<'a * 'b>
static member inline ($) (Mult, v1:'a ) = fun (v2:'a) -> v1 * v2 :'a
let inline (*) v1 v2 = (Mult $ v1) v2
F# can resolve overloaded members. (Because it doesn't support currying of members). So, I supposed, it should work for methods as well
But it doesn't:
type Mult = Mult with
static member inline Do (Mult, v1: 'a list) = fun (v2: 'b list) ->
v1 |> List.collect (fun x -> v2 |> List.map (fun y -> (x, y))) : list<'a * 'b>
static member inline Do (Mult, v1:'a ) = fun (v2:'a) -> v1 * v2 :'a
let inline (<.>) v1 v2 = (Mult.Do (Mult,v1)) v2
A unique overload for method 'Do' could not be determined based on
type information prior to this program point. A type annotation may be
needed. Candidates: static member Mult.Do : Mult:Mult * v1: ^a -> ( ^a
-> ^a) when ^a : (static member ( * ) : ^a * ^a -> ^a), static member Mult.Do : Mult:Mult * v1:'a list -> ('b list -> ('a * 'b)
list)
The syntax in which operator $ is defined is confusing. It accepts upper case identifier as first argument of operator and Visual Studio doesn't complain about it
Mult is inferred to be of type mult, but surprisingly this doesn't work:
type Mult = Mult with
static member inline (!!) (mlt:Mult, v1: 'a list) = fun (v2: 'b list) ->
v1 |> List.collect (fun x -> v2 |> List.map (fun y -> (x, y))) : list<'a * 'b>
static member inline (!!) (mlt:Mult, v1:'a ) = fun (v2:'a) -> v1 * v2 :'a
let inline (<!>) v1 v2 = (Mult !! v1) v2
error FS0003: This value is not a function and cannot be applied

Your second example doesn't work because F# doesn't automatically infer static member constraints with methods as it does with operators.
So yes, it's possible but you will have to write the constraints by hand, the compiler will not infer them for you:
type Mult = Mult with
static member inline Do (Mult, v1: 'a list) = fun (v2: 'b list) ->
v1 |> List.collect (fun x -> v2 |> List.map (fun y -> (x, y))) : list<'a * 'b>
static member inline Do (Mult, v1:'a ) = fun (v2:'a) -> v1 * v2 :'a
let inline impl m v1 v2 = ((^T or ^a) : (static member Do:^T* ^a->(^b-> ^c)) (m,v1)) v2
let inline (<.>) a b = impl Mult a b
The upper-case identifier you mentioned is matching a Discriminated Union of only one single case, so it will always succeed and the name of the case is the same name of the type. All this is to shorten just a bit the amount of code since that DU is a dummy type. If it's confusing here's an example with a normal class:
type Mult() = class end with
static member inline ($) (_:Mult, v1: 'a list) = fun (v2: 'b list) ->
v1 |> List.collect (fun x -> v2 |> List.map (fun y -> (x, y))) : list<'a * 'b>
static member inline ($) (_:Mult, v1:'a ) = fun (v2:'a) -> v1 * v2 :'a
let inline (*) v1 v2 = (Mult() $ v1) v2
Your third example doesn't work because (!!) is an unary operator, not binary like ($)
More information about this old technique in this old blog.

Related

Getting error FS0192: internal error: unexpected non-generation of witness when executing class definition in interactive

I have a class with minimal reproducible implementation looking like that:
type Piecewise<'U, 'V when 'U: comparison
and 'V : (static member (+): 'V * 'V -> 'V)
and 'V : (static member (*): 'V * 'V -> 'V)>
([<System.ParamArray>] pwArr: ('U * 'U * 'V) array) =
member inline this.definition = pwArr
static member inline map (mapping: 'V -> 'W) (pw: Piecewise2<'U, 'V>) =
pw.definition
|> Array.map (fun (b1, b2, v) -> b1, b2, mapping v )
|> fun x -> Piecewise x
and map member definition causes the error mentioned above when I try to commit this to F# interactive.
This class overloads (+) and (*) operators in dowstream members so I had to include them in type constraints.
If I set a weaker contraints on types for map member like that:
static member inline map (mapping: _ -> _) (pw: Piecewise<_, _>) = ...
it commits well up to map member but I'm having errors on overloads of (+) operator:
static member inline (+) (pw: Piecewise<'U, 'V>, u: 'V) =
Piecewise.map ((+) u) pw
//Polynom.fsx(120,28): warning FS0193: A type parameter is missing a constraint 'when ( ^V or ^?17597) : (static member (+) : ^V * ^?17597 -> ^?17598)'
//Polynom.fsx(120,9): error FS0071: Type constraint mismatch when applying the default type 'obj' for a type inference variable. The type 'obj' does not support the operator '+' Consider adding further type constraints
I'm using F# 6.0 in VS 17.05 on Win 10
When I calculate the value for definition field in the let binding first and then assign it to the field the class executes well:
type Piecewise<'U, 'V when 'U: comparison
and 'V : (static member (+): 'V * 'V -> 'V)
and 'V : (static member (*): 'V * 'V -> 'V)>
([<System.ParamArray>] pwArr: ('U * 'U * 'V) array) =
let definition' =
pwArr
|> Array.map (fun (b1, b2, v) ->
if b1 > b2 then b2, b1, v else b1, b2, v )
|> Array.sortBy (fun (b1, _, _) -> b1)
member inline this.definition =
definition'
member inline this.Evaluate(u: 'U) =
this.definition
|> Array.choose(fun (b1, b2, v) ->
if b1 <= u && u < b2 then Some v else None
)
static member inline map (mapping: 'V -> 'W) (pw: Piecewise<'U, 'V>) =
pw.definition
|> Array.map (fun (b1, b2, v) -> b1, b2, mapping v )
|> fun x -> Piecewise x
Still don't really understanding why this works while the direct assignment doesn't

Church encoded Free monad in F#

I am trying to express the Church encoding of the Free monad in F#. Free is specialized to a particular functor, Effect.
I am able to write both return_ : 'T -> Free<'T> and bind: ('T -> Free<'U>) -> Free<'T> -> Free<'U> without any problems.
A sketch of my implementation is given below.
type Effect<'T>
= GetStr of (string -> 'T)
| PutStr of string * 'T
module Effect =
let map (f: 'a -> 'b) : Effect<'a> -> Effect<'b> = function
| GetStr k ->
GetStr(f << k)
| PutStr (s,t) ->
PutStr(s, f t)
type Free<'T> =
abstract Apply : ('T -> 'R) -> (Effect<'R> -> 'R) -> 'R
module Free =
let inline runFree (f:Free<'T>) (kp: 'T -> 'R) (kf: Effect<'R> -> 'R) : 'R =
f.Apply kp kf
let return_ (x: 'a) : Free<'a> =
{ new Free<'a>
with
member __.Apply kp _ =
kp x
}
let bind (f: 'a -> Free<'b>) (m: Free<'a>) : Free<'b> =
{ new Free<'b>
with
member __.Apply kp kf =
runFree m
(fun a ->
runFree (f a) kp kf
)
kf
}
When I try to write an interpreter for this encoding, I hit a problem.
Given the following code:
module Interpret =
let interpretEffect = function
| GetStr k ->
let s = System.Console.ReadLine()
(k s , String.length s)
| PutStr(s,t) ->
do System.Console.WriteLine s
(t , 0)
let rec interpret (f: Free<string * int>) =
Free.runFree
f
(fun (str,len) -> (str,len))
(fun (a: Effect<Free<string*int>>) ->
let (b,n) = interpretEffect a
let (c,n') = interpret b
(c, n + n')
)
I get a type error in the third argument to Free.runFree within the interpret function:
...
(fun (a: Effect<Free<string*int>>) ->
^^^^^^^^^^^^^^^^^^ ------ Expecting a Effect<string * int> but given a Effect<Free<string*int>>
I understand why this is happening (the result type of the first function determines 'R === string*int) and suspect that can be solved using a rank-2 function (which can be encoded in F# e.g. http://eiriktsarpalis.github.io/typeshape/#/33) but I am not sure how to apply it.
Any pointers would be much appreciated.
Michael
You do not need to do anything there, the compiler suggested type is in fact correct (and in line with the type of runFree).
It seems that what you're thinking of there is Scott encoding (ripped from this Haskell question):
runFree :: Functor f => (a -> r) -> (f (F f a) -> r) -> F f a -> r
where F f a would be your Effect-specialised Free<'a>, and f (F f a) would be Effect<Free<'a>>, which is what you're trying to use.
Whereas Church encoding would be:
runFree :: Functor f => (a -> r) -> (f r -> r) -> F f a -> r
where f r is Effect<'a> - thus making it easier to express in F# (which is why I assume you're using it in the first place.
This is what I had for interpret:
let rec interpret (f: Free<string * int>) =
Free.runFree
f
(fun (str,len) -> (str,len))
(fun (a: Effect<_>) ->
let (b,n) = interpretEffect a
let (c,n') = interpret (Free.pureF b)
(c, n + n')
)
where pureF is
let pureF (x: 'a) : Free<'a> =
{ new Free<'a> with member __.Apply kp _ = kp x }
i.e. your return_ function.
I think defining the corresponding freeF function would clear some things (like why is Effect<'a> a functor - you're not making use of this fact anywhere in the code you pasted).

How to declare a generic conversion operator that preserves units of measure?

The built-in conversion operators in F# eliminate units of measure. I'd like to define ones that preserve them. I can do it fine for one specific conversion, e.g. int to float:
let inline intToFloat (x:int<'u>) =
x |> float |> LanguagePrimitives.FloatWithMeasure<'u>
But I don't know what would be the syntax for a generic ((anything with an op_Implicit ^m -> float) -> float) operator:
let inline floatM (x:^m<'u>) =
x |> float |> LanguagePrimitives.FloatWithMeasure<'u>
// FS0712: Type parameter cannot be used as type constructor
Is it possible at all to do this?
I did it as such:
let inline toIntWithMeasure<[<Measure>] 'a> (x:obj) =
match x with
| :? int as i -> i |> LanguagePrimitives.Int32WithMeasure<'a>
| _ -> failwith "Not an int!"
A workaround is to use overloading rather than generics:
type Conv =
static member inline toDouble<[<Measure>] 'u> (x: float32<'u>) =
x |> float |> LanguagePrimitives.FloatWithMeasure<'u>
static member inline toDouble<[<Measure>] 'u> (x: sbyte<'u>) =
x |> float |> LanguagePrimitives.FloatWithMeasure<'u>
static member inline toDouble<[<Measure>] 'u> (x: int16<'u>) =
x |> float |> LanguagePrimitives.FloatWithMeasure<'u>
static member inline toDouble<[<Measure>] 'u> (x: int<'u>) =
x |> float |> LanguagePrimitives.FloatWithMeasure<'u>
static member inline toDouble<[<Measure>] 'u> (x: int64<'u>) =
x |> float |> LanguagePrimitives.FloatWithMeasure<'u>
And now:
let f = Conv.toDouble (45<second>) // f is a float<second>
I'd love to be able to declare an operator to hide away the static class, something like:
let inline floatM< ^m, [<Measure>]'u when (^m) : (static member toFloat: ^m<'u> -> float<'u>)> (x:^m) =
Conv.toDouble x
But that still runs into the same limitation that a generic type cannot have a generic unit of measure.
I'll accept my own answer until someone comes up with a better solution.

F# pattern match using type constraints

Is it possible to do an F# type test pattern with a member constraint?
Such as:
let f x =
match x with
| :? (^T when ^T : (static member IsInfinity : ^T -> bool)) as z -> Some z
| _ -> None
or
let g x =
match x with
| (z : ^T when ^T : (static member IsInfinity : ^T -> bool)) -> Some z
| _ -> None
Neither which work.
You cannot do this, as Petr said, statically resolved type parameters are resolved at compile time. They're actually a feature of the F# compiler rather than being a .NET feature, hence why this kind of information isn't available at runtime.
If you wish to check this at runtime, you could use reflection.
let hasIsInfinity (x : 'a) =
typeof<'a>.GetMethod("IsInfinity", [|typeof<'a>|])
|> Option.ofObj
|> Option.exists (fun mi -> mi.ReturnType = typeof<bool> && mi.IsStatic)
This will check for a static method called IsInfinity with type sig: 'a -> bool

f# interface with type constraint infinite when unifying

I'm having problems getting an interface with type constraints to work generically.
Here's the type
type LeftistHeap<'a when 'a : comparison> =
...
interface IHeap<LeftistHeap<'a>, 'a> with
...
member this.Insert (x : 'a) = LeftistHeap.insert x this
and the interface
type IHeap<'a when 'a : comparison> =
inherit System.Collections.IEnumerable
inherit System.Collections.Generic.IEnumerable<'a>
...
type IHeap<'c, 'a when 'c :> IHeap<'c, 'a> and 'a : comparison> =
inherit IHeap<'a>
...
abstract member Insert : 'a -> 'c
this code works no problem
let insertThruList l h =
List.fold (fun (h' : LeftistHeap<'a>) x -> h'.Insert x ) h l
but if I try to genralize the code for the interface
let insertThruList l h =
List.fold (fun (h' : IHeap<_,'a>) x -> h'.Insert x ) h l
I get this error at h'.Insert
Type mismatch. Expecting a
'b
but given a
IHeap<'b,'a>
The resulting type would be infinite when unifying ''b' and 'IHeap<'b,'a>'
The compiler's right: you're trying to use a 'c where you need an IHeap<'c,_>. Since 'c :> IHeap<'c,_>, one solution is just to insert an upcast:
let insertThruList l h =
List.fold (fun (h' : IHeap<_,_>) x -> h'.Insert x :> _) h l
Alternatively, you can indicate that you don't want the input to be (exactly) an IHeap<_,_>, but instead some particular subtype:
let insertThruList l h =
List.fold (fun (h' : #IHeap<_,_>) x -> h'.Insert x) h l
This is probably what you really want (the type is more specific). This is equivalent to the more verbose definition:
let insertThruList<'c,'a when 'a : comparison and 'c :> IHeap<'c,'a>> l h =
List.fold (fun (h' : 'c) x -> h'.Insert x) h l
will this work for your case?
let insertThruList l (h : 'T when 'T :> IHeap<'T, 'a> ) =
List.fold (fun (h' : 'T) x -> h'.Insert x ) h l

Resources