fable-compiler / repl

Fable online REPL
http://fable.io/repl
MIT License
64 stars 37 forks source link

Compilation breaks silently #117

Closed gusty closed 4 years ago

gusty commented 4 years ago

Here's a standalone repro, including code from F#+

It prints the first message, and everything behind the following line doesn't seem to execute at all.

open System

let inline konst (k: 'T) = fun (_: 'Ignored) -> k
let inline either fOk fError (source: Result<'T,'Error>) : 'U = match source with Ok x -> fOk x | Error x -> fError x
let inline option f n = function Some x -> f x | None -> n

type Return = Return with
    static member inline InvokeOnInstance (x: 'T) = (^``Applicative<'T>`` : (static member Return : ^T -> ^``Applicative<'T>``) x)

type Map = Map with
    static member inline InvokeOnInstance (mapping: 'T->'U) (source: '``Functor<'T>``) : '``Functor<'U>`` = 
        (^``Functor<'T>`` : (static member Map : _ * _ -> _) source, mapping)

[<Struct>]
type Identity<'t> = Identity of 't with
    static member Return x = Identity x                                             : Identity<'T>
    static member (>>=) (Identity x, f :'T -> Identity<'U>) = f x                   : Identity<'U>
    static member (<*>) (Identity (f : 'T->'U), Identity (x : 'T)) = Identity (f x) : Identity<'U>
    static member Lift2 (f, Identity (x: 'T), Identity (y: 'U)) = Identity (f x y)  : Identity<'V>
    static member Map   (Identity x, f : 'T->'U) = Identity (f x)                   : Identity<'U>
    static member Zip   (Identity x, Identity y) = Identity (x, y)                  : Identity<'T * 'U>

/// Basic operations on Identity
[<RequireQualifiedAccess>]
module Identity = 
    let run (Identity x) = x  : 'T

/// Boolean monoid under conjunction.
[<Struct>]
type All = All of bool with
    static member Zero = All true
    static member (+) (All x, All y) = All (x && y)

/// Boolean monoid under disjunction.
[<Struct>]
type Any = Any of bool with
    static member Zero = Any false
    static member (+) (Any x, Any y) = Any (x || y)

[<Struct>]
type Const<'t,'u> = Const of 't with

    // Functor
    static member Map (Const x: Const<_,'T>, _: 'T->'U) = Const x : Const<'C,'U>
    static member inline Return (_: 'U) = Const LanguagePrimitives.GenericZero : Const<'T,'U>

/// Basic operations on Const
[<RequireQualifiedAccess>]
module Const =
    let run (Const t) = t

/// Option<'T> monoid returning the leftmost non-None value.
[<Struct>]
type First<'t> = First of Option<'t> with
    static member get_Zero () = First None                                    : First<'t>
    static member (+) (x, y) = match x, y with First None, r -> r | l, _ -> l : First<'t>
    static member run (First a) = a                                           : 't option

/// Lens functions and operators
module Lens =

    let dimap' ab cd  p = ab >> p >> cd

    let setl optic value (source: 's) : 't = Identity.run (optic (fun _ -> Identity value) source)

    let over optic updater (source: 's) : 't = Identity.run (optic (Identity << updater) source)

    let view (optic: ('a -> Const<_,'b>) -> _ -> Const<_,'t>) (source: 's) : 'a = Const.run (optic Const source)

    let preview (optic: ('a -> Const<_,'b>) -> _ -> Const<_,'t>) (source: 's) : 'a option = source |> optic (fun x -> Const (First (Some x))) |> Const.run |> First.run

    let inline lens (getter: 's -> 'a) (setter: 's -> 'b -> 't) (f: 'a -> '``F<'b>``) = fun s -> setter s </Map.InvokeOnInstance/> f (getter s) : '``F<'t>``

    let inline prism (constructor: 'b -> 't) (getter: 's -> Result<'a,'t>) (f: 'a -> '``F<'b>``) = f |> (fun g -> either (Ok << g) Error) |> dimap' getter (either (Map.InvokeOnInstance constructor) Return.InvokeOnInstance) : 's -> '``F<'t>``

    let inline prism' (constructor: 'b -> 's) (getter: 's -> Option<'a>) (f: 'a -> '``F<'b>``) = prism constructor (fun s -> option Ok (Error s) (getter s)) f : 's -> '``F<'t>``

    // Prism

    /// Prism providing a Traversal for targeting the 'Ok' part of a Result<'T,'Error>
    let inline _Ok    x = (prism Ok    <| either Ok (Error << Error)) x

    /// Prism providing a Traversal for targeting the 'Error' part of a Result<'T,'Error>
    let inline _Error x = (prism Error <| either (Error << Ok) Ok) x

    /// Prism providing a Traversal for targeting the 'Some' part of an Option<'T>
    let inline _Some x = (prism Some <| option Ok (Error None)) x

    /// Prism providing a Traversal for targeting the 'None' part of an Option<'T>
    let inline _None x = (prism' (konst None) <| option (konst None) (Some ())) x

    let inline (<&>) (x: '``F<'t>``) (f: 't -> 'u) : '``F<'u>`` = Map.InvokeOnInstance f x

open Lens

let equal x  y = x = y

let t3 = equal (Some 1) (preview _Ok (Ok 1))
let t4 = equal (Some 1) (preview _Error (Error 1))

printfn "So far so good"

let t2 = equal None (preview _Ok (Error 1))

printfn "It doesn't print anything"

let t5 = equal None (preview _Error (Ok 1))

let t6 = equal true (Option.isNone (preview _Some None))
let t7 = equal (Some 1) (preview _Some (Some 1))
let t8 = equal (Some ()) (preview _None None)
let t9 = equal true (Option.isNone (preview _None (Some 1)))

printfn "%A" t2
printfn "%A" t3
printfn "%A" t4
printfn "%A" t5
printfn "%A" t6
printfn "%A" t7
printfn "%A" t8
printfn "%A" t9
gusty commented 4 years ago

I just came with a way smaller repro:

type First<'t> = First of Option<'t> with
    static member get_Zero () = First None : First<'t>
    static member run (First a) = a        : 't option

type Const<'t,'u> = Const of 't with
    static member inline Return (_: 'U) = Const LanguagePrimitives.GenericZero : Const<'T,'U>
    static member run (Const a) = a

let t2: int option =
    Error 1
    |> fun x ->  (^``Applicative<'T>`` : (static member Return : ^T -> ^``Applicative<'T>``) x)
    |> Const.run 
    |> First.run

printfn "t2"

If you exchange the trait-call line for |> Const.Return it works, but otherwise compilation seems to break silently as the last line (the printfn) is not executed.

MangelMaxime commented 4 years ago

If you open the console of your browser you will see that an error is reported there.

In the "Console" section of the REPL, we only report calls to error/warn/log that are called with strings. If you have an uncatch exception at runtime like you does here you will see it in your browser console.

image

gusty commented 4 years ago

Fair enough, now can you tell me why do I have that runtime error? This code works just fine in fsi.

gusty commented 4 years ago

Looking at the javascript being generated, there is a difference right at the end:

This is the version with the trait-call:

export const t2 = (() => {
  let arg00$$1;
  let arg00;
  const x = new Result(1, "Error", 1);
  arg00 = new Const$00602(0, "Const", null);
  arg00$$1 = Const$00602$$$run$$43814500(arg00);
  return First$00601$$$run$$Z4DCCCC0(arg00$$1);
})();
toConsole(printf("t2"));

And this is the version replacing the trait-call with the actual call

export const t2 = (() => {
  let arg00$$2;
  let arg00$$1;
  const arg00 = new Result(1, "Error", 1);
  arg00$$1 = new Const$00602(0, "Const", First$00601$$$get_Zero());
  arg00$$2 = Const$00602$$$run$$43814500(arg00$$1);
  return First$00601$$$run$$Z4DCCCC0(arg00$$2);
})();
toConsole(printf("t2"));

Note that the trait-call generates new Const$00602(0, "Const", null); instead of new Const$00602(0, "Const", First$00601$$$get_Zero());

That null seems to be the problem.

I guess this should be reported to the Fable compiler, right?

MangelMaxime commented 4 years ago

Yes, you did right reporting the problem in Fable repository.

I am closing this issue as the bug is in Fable compiler.