Uncurrying breaks comparisons

[intellifactory-bb]

To reproduce:

let f (x: int * int) =
    Set.singleton x
    |> Set.remove x

let test () =
    Set.isEmpty (f (0, 0))

Original message from Paul Blair:

I seem to have come across a bug in the way WebSharper handles sets.

I have fairly simple code I can send you that reproduces the bug. I've been coding a Conway's Game of Life, and the code in the browser does not perform the way the F# code does when I run unit tests against it. I wound up debugging using alert statements, and discovered two things:

1. In the first loop through the code, the Set.remove function doesn't seem to work. At least, the alert shows me the set and the item I want to remove is in there, but after I call remove the returned set still has the item in there.
2. In the second loop, it appears that Set.contains isn't working either, though it seems to have worked on the first loop through. Again, I can see the set, and it clearly contains the member, but I get a return value of false.

The items that are contained in the sets are tuples of integers.

I've tried to take a look at the generated Javascript but once it gets into tree manipulation it's a little too cryptic for me to follow.

I would be happy to supply the code for you to review. The game code itself is 59 lines, of which 19 were the statements I put in for debugging.  The sitelet code is 155 lines of code.

---

• Bitbucket: https://bitbucket.org/intellifactory/websharper/issue/69
• Originally reported by: Adam Granicz
• Originally created at: 2012-06-10T17:56:19.628

[intellifactory-bb]

This is the Life.fs module where I'm seeing the strange behavior: The Set.remove that isn't working is in the neighbors function, and the Set.contains problem is in the cellState function. This code works properly when driven by NUnit in F#.

I didn't have a JS debugger easily to hand when I wrote this, hence all the debugging code.

{{{

!F

module Life open IntelliFactory.WebSharper open IntelliFactory.WebSharper.Html5

[] let stringifySet (set:Set<int*int>) = //For debugging with Alerts (Window.Self.Alert) let stringifyPairAndAdd (accum:string) (x:int,y:int) = accum + "(" + x.ToString() + "," + y.ToString() + ")" Set.fold stringifyPairAndAdd "" set

[] let neighborhood (a:int,b:int) = let f = [ for i in -1..1 do for j in -1..1 do yield a+i, b+j ] |> Set.ofList // Window.Self.Alert("Neighbors of: (" + a.ToString() + "," + b.ToString() + ") : " + stringifySet(f)) f

[] let neighbors cell = neighborhood cell |> Set.remove cell (* // The following doesn't work either... seems even worse: let setOfMe = Set.empty |> Set.add cell neighborhood cell |> Set.difference setOfMe *)

[] let cellState liveCells cell = // Window.Self.Alert("Cell is: " + (fst cell).ToString() + "," + (snd cell).ToString()) let neighboringCells = neighbors cell let liveNeighborCount = neighboringCells |> Set.intersect liveCells |> Set.count // Window.Self.Alert("Live cells is: " + (stringifySet liveCells)) // Window.Self.Alert("Neighbors is: " + (stringifySet neighborsWithoutItself)) // Window.Self.Alert("Live neighbors is: " + (stringifySet (Set.intersect liveCells neighborsWithoutItself))) // Window.Self.Alert("Live neighbor count is: " + liveNeighborCount.ToString()) let isCellAlive = Set.contains cell liveCells // Window.Self.Alert("Live cells is: " + (stringifySet liveCells)) // Window.Self.Alert("Cell is: " + (fst cell).ToString() + "," + (snd cell).ToString()) // Window.Self.Alert("Is cell alive is: " + isCellAlive.ToString()) (cell, isCellAlive, liveNeighborCount)

[] let survivalRules = function | , , 3 -> true | , true, 2 -> true | -> false

[] let nextGeneration livingCells : Set<int*int> = //Window.Self.Alert("Before: " + (stringifySet livingCells)) let newState = livingCells|> Set.map neighborhood |> Set.unionMany |> Set.map (cellState livingCells) |> Set.filter survivalRules |> Set.map (fun (a1,b1,c1) -> a1) //Window.Self.Alert("After: " + (stringifySet newState)) newState

}}}

---

Original comment by: Anonymous

[intellifactory-bb]

Here is Main.fs which calls Life.fs for display on a canvas element. I thought the problem with set removal might have something to do with the way I was calling the code from an async block; I tried with JS setTimeout and still had the same problem.

{{{

!F

namespace LifeHtmlSite

open System open System.IO open System.Web open IntelliFactory.WebSharper.Sitelets

module LifeSite = open IntelliFactory.WebSharper open IntelliFactory.Html open IntelliFactory.WebSharper.Formlet

type Action =
    | Index

module Skin =
    type Page =  { Title : string ; Body : list<Content.HtmlElement> }

    let MainTemplate =
        let path = Path.Combine(__SOURCE_DIRECTORY__, "Main.html")
        Content.Template<Page>(path)
            .With("title", fun x -> x.Title)
            .With("body", fun x -> x.Body)

    let WithTemplate title body : Content<Action> =
        Content.WithTemplate MainTemplate <| fun context ->  { Title = title;  Body = body context }

module Canvas =
    open IntelliFactory.WebSharper.Html
    open IntelliFactory.WebSharper.Html5
    open Life

     // Since IE does not support canvas natively. Initialization of the 
    // canvas element is done through the excanvas.js library.
    [<Inline "G_vmlCanvasManager.initElement($elem)">]
    let Initialize (elem: CanvasElement) : unit = ()

    [<JavaScript>]
    let CANVAS_WIDTH = 800
    [<JavaScript>]
    let CANVAS_HEIGHT = 600
    [<JavaScript>]
    let CELL_SIDE_PIXELS = 10
    [<JavaScript>]
    let mutable context = None

    [<JavaScript>]
    let mutable initialState =  Set.empty

    [<JavaScript>]
    let drawSmallCircleAtPoint (ctx: CanvasRenderingContext2D) (x,y) =
        let radius = (float(CELL_SIDE_PIXELS) - 2.0) / 2.0
        let startAngle = 0.0
        let endAngle = Math.PI * 2.
        let centerX = float ((x * CELL_SIDE_PIXELS) + (CELL_SIDE_PIXELS / 2)) 
        let centerY = float ((y * CELL_SIDE_PIXELS) + (CELL_SIDE_PIXELS / 2)) 
        ctx.BeginPath()
        ctx.Arc(centerX, centerY, radius, startAngle, endAngle, true)
        ctx.ClosePath()
        ctx.Stroke()

    [<JavaScript>]
    let drawLife (ctx: CanvasRenderingContext2D) (gameState: Set<int*int>) =
        ctx.Save()
        ctx.ClearRect(0., 0., float(CANVAS_WIDTH), float(CANVAS_HEIGHT))
        ctx.Save()

        ctx.StrokeStyle <- "black"
        ctx.FillStyle <- "black"
        ctx.LineWidth <- 1.

        Set.iter (drawSmallCircleAtPoint ctx) gameState      
        ctx.Save()

    [<JavaScript>]
    let adjustInitArrayAndRedraw (evt:Dom.Event) =
        let event = evt :?> Dom.MouseEvent
        let x = (event.ClientX / CELL_SIDE_PIXELS) - 1  // For some reason we have crazy offsets here
        let y = (event.ClientY / CELL_SIDE_PIXELS) - 11
        if Set.contains (x,y) initialState then
            initialState <- Set.remove (x,y) initialState
        else 
            initialState <- Set.add (x, y) initialState
        drawLife (Option.get context) initialState 

    [<JavaScript>]
    let StarterFormlet () : Formlet<int> =
        Controls.Button("Go")

    [<JavaScript>]
    let AnimatedCanvas width height caption =
        let element = HTML5.Tags.Canvas []
        let canvas  = As<CanvasElement> element.Dom
        // Conditional initialization for the case of IE.
        if (JavaScript.Get "getContext" canvas = JavaScript.Undefined) then
            Initialize canvas

        canvas.Width  <- width
        canvas.Height <- height

        let ctx = canvas.GetContext "2d"
        ctx.Canvas.AddEventListener("click", adjustInitArrayAndRedraw, false)

        context <- Some(ctx)

        drawLife ctx initialState
        Div [ Width (string width); Attr.Style "float:left" ] -< [
            Div [ Attr.Style "float:center" ] -< [
                element
                P [Align "center"] -< [
                    I [Text <| "Life" ]
                ]
            ]
        ]

    [<JavaScript>]
    let rec generationLoop oldState  =
        async {
            do! Async.Sleep 500
            //Window.Self.Alert("Before: " + (stringifySet oldState))
            let newState = nextGeneration oldState
           // Window.Self.Alert("After: " + (stringifySet newState))
            do drawLife (Option.get context) newState
            do! generationLoop newState
        }

    [<JavaScript>]
    let startDrawing s =
        Async.Start (generationLoop initialState)

    (* // This doesn't work either:
    [<JavaScript>]
    let rec generationLoop currentState () =
        let newState = nextGeneration currentState
        drawLife (Option.get context) newState
        JavaScript.SetTimeout (generationLoop newState) 500 |> ignore

    [<JavaScript>]
    let startDrawing s = 
        JavaScript.SetTimeout (generationLoop initialState) 500 |> ignore
    *)

    [<JavaScript>]
    let Main () =
        Div [
            Div [ StarterFormlet().Run (fun s -> startDrawing s) ]                                              
            AnimatedCanvas CANVAS_WIDTH CANVAS_HEIGHT "1"
            Div [Attr.Style "clear:both"]
        ]

module Client =
    type CanvasViewer() = 
        inherit IntelliFactory.WebSharper.Web.Control()

        [<JavaScript>]
        override this.Body = Canvas.Main () :> _

let Index = Skin.WithTemplate "Index page" <| fun ctx -> [  Div [new Client.CanvasViewer()] ]

let MySitelet = [ Sitelet.Content "/index" Action.Index Index ] |> Sitelet.Sum
let MyActions = [ Action.Index ]

type MySampleWebsite() = interface IWebsite with member this.Sitelet = LifeSite.MySitelet member this.Actions = LifeSite.MyActions

[<assembly: WebsiteAttribute(typeof)>] do ()

}}}

---

Original comment by: Anonymous

[intellifactory-bb]

Compiler injects an "uncurry" literal in the code, probably there for debugging purposes from a long time ago, and this literal breaks comparisons on arrays (that represent tuples). Fixing in the upcoming release.

---

Original comment by: Anton Tayanovskyy

[intellifactory-bb]

Fix #69

→ <<cset 165b046d1fb2>>

---

Original comment by: Anton Tayanovskyy

[intellifactory-bb]

Thanks!

---

Original comment by: Anonymous