search

fable-compiler / Fable

F# to JavaScript, TypeScript, Python, Rust and Dart Compiler
http://fable.io/
MIT License
2.93k stars 301 forks source link

Recursive trait calls not working #2473

Open gusty opened 3 years ago

gusty commented 3 years ago

Description

It seems a stack overflow happens internally in presence of recursive (but finite) trait calls.

Repro code

open System

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

let inline retype (x: 'T) : 'U =
#if !FABLE_COMPILER
    (# "" x: 'U #)
#else
    unbox<'U> x
#endif

module Constraints =
    /// Constrain 't to be a nested tuple of <'t1,'t2,'t3,'t4,'t5,'t6,'t7,'tr>
    let inline whenNestedTuple (t: 't) = 
        (^t: (member Item1: 't1) t), (^t: (member Item2: 't2) t), (^t: (member Item3: 't3) t), (^t: (member Item4: 't4) t), (^t: (member Item5: 't5) t), (^t: (member Item6: 't6) t), (^t: (member Item7: 't7) t), (^t: (member Rest: 'tr) t)

type Curry =
    static member inline Invoke f =
        let inline call_2 (a: ^a, b: ^b) = ((^a or ^b) : (static member Curry: _*_ -> _) b, a)
        call_2 (Unchecked.defaultof<Curry>, Unchecked.defaultof<'t>) (f: 't -> 'r) : 'args

    static member inline Curry (t: 't, _: Curry) = fun f t1 t2 t3 t4 t5 t6 t7 ->
        Curry.Invoke (fun tr ->
            let _f _ = Constraints.whenNestedTuple t : ('t1*'t2*'t3*'t4*'t5*'t6*'t7*'tr)
            f (Tuple<'t1,'t2,'t3,'t4,'t5,'t6,'t7,'tr> (t1, t2, t3, t4, t5, t6, t7, tr) |> retype))

    static member Curry (_: Tuple<'t1>        , _: Curry) = fun f t1                   -> f (Tuple<_> t1)
    static member Curry ((_, _)               , _: Curry) = fun f t1 t2                -> f (t1, t2)
    static member Curry ((_, _, _)            , _: Curry) = fun f t1 t2 t3             -> f (t1, t2, t3)
    static member Curry ((_, _, _, _)         , _: Curry) = fun f t1 t2 t3 t4          -> f (t1, t2, t3, t4)
    static member Curry ((_, _, _, _, _)      , _: Curry) = fun f t1 t2 t3 t4 t5       -> f (t1, t2, t3, t4, t5)
    static member Curry ((_, _, _, _, _, _)   , _: Curry) = fun f t1 t2 t3 t4 t5 t6    -> f (t1, t2, t3, t4, t5, t6)
    static member Curry ((_, _, _, _, _, _, _), _: Curry) = fun f t1 t2 t3 t4 t5 t6 t7 -> f (t1, t2, t3, t4, t5, t6, t7)

type Uncurry =
    static member inline Invoke f t =
        let inline call_2 (a: ^a, b: ^b) = ((^a or ^b) : (static member Uncurry: _*_ -> _) b, a) f
        call_2 (Unchecked.defaultof<Uncurry>, t) : 'r

    static member inline Uncurry (t: 't, _: Uncurry) = fun f  ->
        let (tr: 'tr) = (^t : (member Rest  : 'tr) t)
        let (t7: 't7) = (^t : (member Item7 : 't7) t)
        let (t6: 't6) = (^t : (member Item6 : 't6) t)
        let (t5: 't5) = (^t : (member Item5 : 't5) t)
        let (t4: 't4) = (^t : (member Item4 : 't4) t)
        let (t3: 't3) = (^t : (member Item3 : 't3) t)
        let (t2: 't2) = (^t : (member Item2 : 't2) t)
        let (t1: 't1) = (^t : (member Item1 : 't1) t)
        Uncurry.Invoke (f t1 t2 t3 t4 t5 t6 t7) tr

    static member Uncurry (x: Tuple<'t1>               , _: Uncurry) = fun f -> f x.Item1
    static member Uncurry ((t1, t2)                    , _: Uncurry) = fun f -> f t1 t2
    static member Uncurry ((t1, t2, t3)                , _: Uncurry) = fun f -> f t1 t2 t3
    static member Uncurry ((t1, t2, t3, t4)            , _: Uncurry) = fun f -> f t1 t2 t3 t4
    static member Uncurry ((t1, t2, t3, t4, t5)        , _: Uncurry) = fun f -> f t1 t2 t3 t4 t5
    static member Uncurry ((t1, t2, t3, t4, t5, t6)    , _: Uncurry) = fun f -> f t1 t2 t3 t4 t5 t6
    static member Uncurry ((t1, t2, t3, t4, t5, t6, t7), _: Uncurry) = fun f -> f t1 t2 t3 t4 t5 t6 t7

let inline curryN (f: (^``T1 * ^T2 * ... * ^Tn``) -> 'Result) : 'T1 -> '``T2 -> ... -> 'Tn -> 'Result`` = fun t -> Curry.Invoke f t
let inline uncurryN (f: 'T1 -> '``T2 -> ... -> 'Tn -> 'Result``) (t: (^``T1 * ^T2 * ... * ^Tn``)) = Uncurry.Invoke f t : 'Result

// test

let f1  (x: Tuple<_>) = [x.Item1]
let f2  (x, y)    = [x + y]
let f3  (x, y, z) = [x + y + z]
let f7  (t1, t2, t3, t4, t5, t6, t7) = [t1+t2+t3+t4+t5+t6+t7]
let f8  (t1, t2, t3, t4, t5, t6, t7: float, t8: char) = [t1+t2+t3+t4+t5+t6+ int t7 + int t8]
let f9  (t1, t2, t3, t4, t5, t6, t7: float, t8: char, t9: decimal) = [t1+t2+t3+t4+t5+t6+ int t7 + int t8+ int t9]
let f15 (t1, t2, t3, t4, t5, t6, t7: float, t8: char, t9: decimal, t10, t11, t12, t13, t14, t15) = [t1+t2+t3+t4+t5+t6+ int t7 + int t8+ int t9+t10+t11+t12+t13+t14+t15]
let f16 (t1, t2, t3, t4, t5, t6, t7: float, t8: char, t9: decimal, t10, t11, t12, t13, t14, t15, t16) = [t1+t2+t3+t4+t5+t6+ int t7 + int t8+ int t9+t10+t11+t12+t13+t14+t15+t16]
let f17 (t1, t2, t3, t4, t5, t6, t7: float, t8: char, t9: decimal, t10, t11, t12, t13, t14, t15, t16, t17) = [t1+t2+t3+t4+t5+t6+ int t7 + int t8+ int t9+t10+t11+t12+t13+t14+t15+t16+t17]

let _x1  = curryN f1 100
let _x2  = curryN f2 1 2
let _x3  = curryN f3 1 2 3
let _x7  = curryN f7 1 2 3 4 5 6 7
let _x8  = curryN f8 1 2 3 4 5 6 7. '8'
let _x9  = curryN f9 1 2 3 4 5 6 7. '8' 9M
let _x15 = curryN f15 1 2 3 4 5 6 7. '8' 9M 10 11 12 13 14 15
let _x16 = curryN f16 1 2 3 4 5 6 7. '8' 9M 10 11 12 13 14 15 16
let _x17 = curryN f17 1 2 3 4 5 6 7. '8' 9M 10 11 12 13 14 15 16 17

let g2  x y   = [x + y]
let g3  x y z = [x + y + z]
let g7  a b c d e f g = [a + b + c + d + e + f + g]        

let g8  t1 t2 t3 t4 t5 t6 (t7: float) (t8: char) = [t1+t2+t3+t4+t5+t6+ int t7 + int t8]
let g9  t1 t2 t3 t4 t5 t6 (t7: float) (t8: char) (t9: decimal)  = [t1+t2+t3+t4+t5+t6+ int t7 + int t8+ int t9]
let g12 t1 t2 t3 t4 t5 t6 (t7: float) (t8: char) (t9: decimal) t10 t11 t12 = [t1+t2+t3+t4+t5+t6+ int t7 + int t8+ int t9+t10+t11+t12]
let g15 t1 t2 t3 t4 t5 t6 (t7: float) (t8: char) (t9: decimal) t10 t11 t12 t13 t14 t15 = [t1+t2+t3+t4+t5+t6+ int t7 + int t8+ int t9+t10+t11+t12+t13+t14+t15]
let g16 t1 t2 t3 t4 t5 t6 (t7: float) (t8: char) (t9: decimal) t10 t11 t12 t13 t14 t15 t16 = [t1+t2+t3+t4+t5+t6+ int t7 + int t8+ int t9+t10+t11+t12+t13+t14+t15+t16]

let _y1  = uncurryN string (Tuple<_> 1)

let _y2  = uncurryN g2 (1, 2)
let _y3  = uncurryN g3 (1, 2, 3)
let _y7  = uncurryN g7 (1, 2, 3, 4, 5, 6, 7)

let _y8  = uncurryN g8 (1, 2, 3, 4, 5, 6, 7. , '8')
let _y9  = uncurryN g9 (1, 2, 3, 4, 5, 6, 7. , '8', 9M)
let _y12 = uncurryN g12 (1, 2, 3, 4, 5, 6, 7. , '8', 9M, 10 , 11, 12)
let _y15 = uncurryN g15 (1, 2, 3, 4, 5, 6, 7. , '8', 9M, 10 , 11, 12, 13, 14, 15)
let _y16 = uncurryN g16 (1, 2, 3, 4, 5, 6, 7. , '8', 9M, 10 , 11, 12, 13, 14, 15, 16)

Expected and actual results

Compile and work but it fails compilation with an error stating "Maximum call stack exceeded"

Related information

Note: this code also depends on fixing #2472 but still can be tested by removing the tests for Tuple<_>.

Also consider as alternative as incorporating it as a fable test, to test F#+ tests, where this it is already included (but disabled of course).

gusty commented 3 years ago

Here's a smaller repro:

open System.Collections.Generic

type [<Struct>]MemoizationKeyWrapper<'a> = MemoizationKeyWrapper of 'a

type MemoizeN =
    static member getOrAdd (cd: Dictionary<MemoizationKeyWrapper<'a>,'b>) (f: 'a -> 'b) k =
        match cd.TryGetValue (MemoizationKeyWrapper k) with
        | (true , v) -> v
        | (false, _) ->
            let v = f k
            cd.Add (MemoizationKeyWrapper k, v)
            v

let inline memoizeN (f:'``(T1 -> T2 -> ... -> Tn)``): '``(T1 -> T2 -> ... -> Tn)`` =
    let inline call_2 (a: ^MemoizeN, b: ^b) = ((^MemoizeN or ^b) : (static member MemoizeN : ^MemoizeN * 'b -> _ ) (a, b))
    call_2 (Unchecked.defaultof<MemoizeN>, Unchecked.defaultof<'``(T1 -> T2 -> ... -> Tn)``>) f

type MemoizeN with
    static member        MemoizeN (_: obj     , _:      'a -> 'b) = MemoizeN.getOrAdd (Dictionary ())
    static member inline MemoizeN (_: MemoizeN, _:'t -> 'a -> 'b) = MemoizeN.getOrAdd (Dictionary ()) << (<<) memoizeN

and some tests

let effs = ResizeArray ()

let f x                       = effs.Add "f"; string x
let g x (y:string) z : uint32 = effs.Add "g"; uint32 (x * int y + int z)
let h x y z                   = effs.Add "h"; new System.DateTime (x, y, z)
let sum2 (a:int)       = effs.Add "sum2"; (+) a
let sum3 a (b:int) c   = effs.Add "sum3"; a + b + c
let sum4 a b c d : int = effs.Add "sum4"; a + b + c + d

// memoize them
let msum2 = memoizeN sum2
let msum3 = memoizeN sum3
let msum4 = memoizeN sum4
let mf    = memoizeN f
let mg    = memoizeN g
let mh    = memoizeN h

// check memoization really happens
let _v1  = msum2 1 1
let _v2  = msum2 1 1
let _v3  = msum2 2 1
let _v4  = msum3 1 2 3
let _v5  = msum3 1 2 3
let _v6  = msum4 3 1 2 3
let _v7  = msum4 3 1 2 3
let _v8  = msum4 3 5 2 3
let _v9  = mf 3M
let _v10 = mf 3M
let _v11 = mg 4 "2" 3M
let _v12 = mg 4 "2" 3M
let _v13 = mh 2010 1 1
let _v14 = mh 2010 1 1

Assert.AreEqual ([|"sum2"; "sum2"; "sum3"; "sum4"; "sum4"; "f"; "g"; "h"|], effs.ToArray ()))
alfonsogarciacaro commented 3 years ago

Thanks for isolating the issue @gusty. I debugged the code and noticed witnesses are not helpful here so it comes down to Fable's own trait-call resolution. If I understand the sample correctly memoizeN will be calling MemoizeN.MemoizeN(_: MemoizeN, _:'t -> 'a -> 'b) until the arity of the second argument is reduced to 1 in which case it will call the first overload and recursivity will stop. The (dead simple) resolution mechanism of Fable to find the correct member is here: https://github.com/fable-compiler/Fable/blob/d94e94cc1eb07dcf73be43f4e883321453377f71/src/Fable.Transforms/FSharp2Fable.Util.fs#L924-L942

The interesting part is the typeEquals function which is called in non-strict mode and whose implementation is this: https://github.com/fable-compiler/Fable/blob/d94e94cc1eb07dcf73be43f4e883321453377f71/src/Fable.Transforms/Transforms.Util.fs#L542-L570

If I change the implementation as in the diff below now the code compiles but the test doesn't pass because the first overload is always being picked.

image

So I'm assuming when there are multiple candidates we somehow must pick the one with the arity closer to the expected one. Do you know what's the exact algorithm for this resolution? Is there any scoring mechanism to match the argument types?

gusty commented 3 years ago

Is there any scoring mechanism to match the argument types?

F# compiler has a tie breaker for deciding over multiple candidates.

But there are many problems to that approach. The tie breaker, in case of trait calls, does some incrementing constraint solving recursively, which is very complicated and far from perfect.

I think here we can make Fable smarter.

We can certainly apply some rules like the arity, and stuff like pick the less generic one, but it won't be the same as the F# compiler.

I did propose in an F# suggestion an attribute based priority resolution. If Fable can interpret that attribute we can decorate our overloads with it and hint Fable about priorities.

gusty commented 3 years ago

So I'm assuming when there are multiple candidates we somehow must pick the one with the arity closer to the expected one.

Actually, in this (and many other of my repros) case, what tie breaks is the first dummy parameter.

The second overload has type MemoizeN which is exactly what is being sent while the first overload has obj which matches MemoizeN as it is a super-class, so when both matches the closest one in the type hierarchy is preferred, which in this code is the second one.

alfonsogarciacaro commented 3 years ago

I've checked the F# of your example and although there seems to be an issue with the witness passing in Fable because when debugging I don't see any witness in the context at the time of resolving the trait call, unfortunately the witness won't help either because F# only passes it once in the top call of msum4 for example, but here we need to have different resolutions as memoizeN is being called recursively.

image