Type inference breaks when class is not sealed

gusty commented 6 years ago

There are cases when using SRTP with overloads where a class that is not sealed is not resolved, when in fact the compiler has a good candidate.

Repro steps

Try this script

//[<Sealed>]
type Id<'t>(v:'t) = member __.getValue = v

type Interface<'t> = abstract member getValue : 't

type Monad =
    static member inline InvokeReturn (x:'T) : '``Monad<'T>`` =
        let inline call (mthd : ^M, output : ^R) = ((^M or ^R) : (static member Return: _ -> _) output)
        call (Unchecked.defaultof<Monad>, Unchecked.defaultof<'``Monad<'T>``>) x
    static member Return (_:Interface<'a>) = fun (_:'a) -> Unchecked.defaultof<Interface<'a>> : Interface<'a>
    static member Return (_:seq<'a>      ) = fun x -> Seq.singleton x                         : seq<'a>
    static member Return (_:option<'a>   ) = fun x -> Some x                                  : option<'a>
    static member Return (_:Id<'a>       ) = fun x -> Id x                                    : Id<'a>

    static member inline InvokeBind (source : '``Monad<'T>``) (binder : 'T -> '``Monad<'U>``) : '``Monad<'U>`` =
        let inline call (mthd : 'M, input : 'I, _output : 'R, f) = ((^M or ^I or ^R) : (static member Bind: _*_ -> _) input, f)
        call (Unchecked.defaultof<Monad>, source, Unchecked.defaultof<'``Monad<'U>``>, binder)
    static member Bind (source : Interface<'T>, f : 'T -> Interface<'U>) = f source.getValue    : Interface<'U>
    static member Bind (source : seq<'T>      , f : 'T -> seq<'U>      ) = Seq.collect f source : seq<'U>
    static member Bind (source : Id<'T>       , f : 'T -> Id<'U>       ) = f source.getValue    : Id<'U>
    static member Bind (source :option<'T>    , f : 'T -> _            ) = Option.bind f source : option<'U>

let inline result (x:'T)                                   = Monad.InvokeReturn x :'``Monad<'T>``
let inline (>>=) (x:'``Monad<'T>``) (f:'T->'``Monad<'U>``) = Monad.InvokeBind x f :'``Monad<'U>``

type ReaderT<'R,'``monad<'T>``> = ReaderT of ('R -> '``monad<'T>``)
let runReaderT (ReaderT x) = x : 'R -> '``Monad<'T>``
type ReaderT<'R,'``monad<'T>``> with
    static member inline Return _ = fun (x : 'T) -> ReaderT (fun _ -> result x)                                                   : ReaderT<'R, '``Monad<'T>``> 
    static member inline Bind (ReaderT (m:_->'``Monad<'T>``), f:'T->_) = ReaderT (fun r -> m r >>= (fun a -> runReaderT (f a) r)) : ReaderT<'R, '``Monad<'U>``>

let test1 : ReaderT<string, option<_>> = ReaderT result >>= result
let test2 : ReaderT<string, Id<_>>     = ReaderT result >>= result
let test3 : ReaderT<string, seq<_>>    = ReaderT result >>= result

Expected behavior

Compile fine, inferring test1, test2, test3

Actual behavior

Only test1 is inferred, since it's an option type (sealed). Then we get this error:

error FS0332: Could not resolve the ambiguity inherent in the use of the operator 'Return' at or near this program point. Consider using type annotations to resolve the ambiguity.

Which doesn't add any useful information.

Known workarounds

Uncomment the first line and test2 will be inferred. However for test3 there's no workaround without fixing the compiler.

Related information

I submitted a very easy fix for this issue

Basically we don't fail, because:

If type inference comes with a candidate (other than the default inferred ie. obj) we use it.
Even in the case where this is really an error, this error message is not telling us anything interesting, in turn it "hides" the real error message, which tell us that a default type obj was used and it doesn't match this (very useful to debug) list of candidate methods.

Another option would be to check if the candidate was inferred using a default type, but again, that error message is more useful than just 'Could not resolve the ambiguity'.

gusty commented 6 years ago

Closing as the PR that removes this error was accepted and merged. Thanks !

gusty commented 5 years ago

The above script is working now.

However there are other cases where type inference is not working for non-sealed types and at the moment I don't have a fix for that, but trying to get closer on https://github.com/dotnet/fsharp/pull/7458

Here's a new repro that still fails:

open System
open System.Threading.Tasks

// [<Sealed>]
type Id<'t> (v: 't) =
   let value = v
   member __.getValue = value

[<RequireQualifiedAccess>]
module Id =
    let run   (x: Id<_>) = x.getValue
    let map f (x: Id<_>) = Id (f x.getValue)
    let create x = Id x

type Bind =
    static member        (>>=) (source: Lazy<'T>   , f: 'T -> Lazy<'U>    ) = lazy (f source.Value).Value                                   : Lazy<'U>
    static member        (>>=) (source: Task<'T>   , f: 'T -> Task<'U>    ) = source.ContinueWith(fun (x: Task<_>) -> f x.Result).Unwrap () : Task<'U>
    static member        (>>=) (source             , f: 'T -> _           ) = Option.bind   f source                                        : option<'U>
    static member        (>>=) (source             , f: 'T -> _           ) = async.Bind (source, f)  
    static member        (>>=) (source : Id<_>     , f: 'T -> _           ) = f source.getValue                                 : Id<'U>

    static member inline Invoke (source: '``Monad<'T>``) (binder: 'T -> '``Monad<'U>``) : '``Monad<'U>`` =
        let inline call (_mthd: 'M, input: 'I, _output: 'R, f) = ((^M or ^I or ^R) : (static member (>>=) : _*_ -> _) input, f)
        call (Unchecked.defaultof<Bind>, source, Unchecked.defaultof<'``Monad<'U>``>, binder)

let inline (>>=) (x: '``Monad<'T>``) (f: 'T->'``Monad<'U>``) : '``Monad<'U>`` = Bind.Invoke x f

type Return =
    static member inline Invoke (x: 'T) : '``Applicative<'T>`` =
        let inline call (mthd: ^M, output: ^R) = ((^M or ^R) : (static member Return : _*_ -> _) output, mthd)
        call (Unchecked.defaultof<Return>, Unchecked.defaultof<'``Applicative<'T>``>) x

    static member        Return (_: Lazy<'a>       , _: Return  ) = fun x -> Lazy<_>.CreateFromValue x : Lazy<'a>
    static member        Return (_: 'a Task        , _: Return  ) = fun x -> Task.FromResult x : 'a Task
    static member        Return (_: option<'a>     , _: Return  ) = fun x -> Some x                : option<'a>
    static member        Return (_: 'a Async       , _: Return  ) = fun (x: 'a) -> async.Return x
    static member        Return (_: 'a Id          , _: Return  ) = fun (x: 'a) -> Id x

let inline result (x: 'T) : '``Functor<'T>`` = Return.Invoke x

type TypeT<'``monad<'t>``> = TypeT of obj
type Node<'``monad<'t>``,'t> = A | B of 't * TypeT<'``monad<'t>``>

let inline wrap (mit: 'mit) =
        let _mnil  = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_:'t) -> (result Node<'mt,'t>.A ) : 'mit
        TypeT mit : TypeT<'mt>

let inline unwrap (TypeT mit : TypeT<'mt>) =
    let _mnil  = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_:'t) ->  (result Node<'mt,'t>.A ) : 'mit
    unbox mit : 'mit

let inline empty () = wrap ((result Node<'mt,'t>.A) : 'mit) : TypeT<'mt>

let inline concat l1 l2 =
        let rec loop (l1: TypeT<'mt>) (lst2: TypeT<'mt>) =
            let (l1, l2) = unwrap l1, unwrap lst2
            TypeT (l1 >>= function A ->  l2 | B (x: 't, xs) -> ((result (B (x, loop xs lst2))) : 'mit))
        loop l1 l2 : TypeT<'mt>

let inline bind f (source: TypeT<'mt>) : TypeT<'mu> =
    // let _mnil = (result Unchecked.defaultof<'t> : 'mt) >>= fun (_: 't) -> (result Unchecked.defaultof<'u>) : 'mu
    let rec loop f input =
        TypeT (
            (unwrap input : 'mit) >>= function
                    | A -> result <| (A : Node<'mu,'u>) : 'miu
                    | B (h:'t, t: TypeT<'mt>) ->
                        let res = concat (f h: TypeT<'mu>) (loop f t)
                        unwrap res  : 'miu) 
    loop f source : TypeT<'mu>

let inline map (f: 'T->'U) (x: '``Monad<'T>`` ) = Bind.Invoke x (f >> Return.Invoke) : '``Monad<'U>``

let inline unfold (f:'State -> '``M<('T * 'State) option>``) (s:'State) : TypeT<'MT> =
        let rec loop f s = f s |> map (function
                | Some (a, s) -> B (a, loop f s)
                | None -> A) |> wrap
        loop f s

let inline create (al: '``Monad<list<'T>>``) : TypeT<'``Monad<'T>``> =
        unfold (fun i -> map (fun (lst:list<_>) -> if lst.Length > i then Some (lst.[i], i+1) else None) al) 0

let inline run (lst: TypeT<'MT>) : '``Monad<list<'T>>`` =
    let rec loop acc x = unwrap x >>= function
        | A         -> result (List.rev acc)
        | B (x, xs) -> loop (x::acc) xs
    loop [] lst

let c0 = create (Id ([1..10]))
let res0 = c0 |> run |> create |> run

dotnet / fsharp