Merge remote-tracking branch 'origin/main' into roc-dev-inline-expects

crates/cli_testing_examples/benchmarks/.gitignore

@@ -0,0 +1,12 @@
+cfold
+closure
+deriv
+issue2279
+nqueens
+quicksortapp
+rbtree-ck
+rbtree-del
+rbtree-insert
+test-astar
+test-base64
+*.wasm

crates/cli_testing_examples/benchmarks/AStar.roc

@@ -0,0 +1,124 @@
+interface AStar
+    exposes [findPath, Model, initialModel, cheapestOpen, reconstructPath]
+    imports [Quicksort]
+
+findPath = \costFn, moveFn, start, end ->
+    astar costFn moveFn end (initialModel start)
+
+Model position : {
+    evaluated : Set position,
+    openSet : Set position,
+    costs : Dict position F64,
+    cameFrom : Dict position position,
+}
+
+initialModel : position -> Model position
+initialModel = \start -> {
+    evaluated: Set.empty,
+    openSet: Set.single start,
+    costs: Dict.single start 0,
+    cameFrom: Dict.empty,
+}
+
+cheapestOpen : (position -> F64), Model position -> Result position {}
+cheapestOpen = \costFn, model ->
+    model.openSet
+    |> Set.toList
+    |> List.keepOks
+        (\position ->
+            when Dict.get model.costs position is
+                Err _ -> Err {}
+                Ok cost -> Ok { cost: cost + costFn position, position }
+        )
+    |> Quicksort.sortBy .cost
+    |> List.first
+    |> Result.map .position
+    |> Result.mapErr (\_ -> {})
+
+reconstructPath : Dict position position, position -> List position
+reconstructPath = \cameFrom, goal ->
+    when Dict.get cameFrom goal is
+        Err _ -> []
+        Ok next -> List.append (reconstructPath cameFrom next) goal
+
+updateCost : position, position, Model position -> Model position
+updateCost = \current, neighbor, model ->
+    newCameFrom =
+        Dict.insert model.cameFrom neighbor current
+
+    newCosts =
+        Dict.insert model.costs neighbor distanceTo
+
+    distanceTo =
+        reconstructPath newCameFrom neighbor
+        |> List.len
+        |> Num.toFrac
+
+    newModel =
+        { model &
+            costs: newCosts,
+            cameFrom: newCameFrom,
+        }
+
+    when Dict.get model.costs neighbor is
+        Err _ ->
+            newModel
+
+        Ok previousDistance ->
+            if distanceTo < previousDistance then
+                newModel
+            else
+                model
+
+astar : (position, position -> F64), (position -> Set position), position, Model position -> Result (List position) {}
+astar = \costFn, moveFn, goal, model ->
+    when cheapestOpen (\source -> costFn source goal) model is
+        Err {} -> Err {}
+        Ok current ->
+            if current == goal then
+                Ok (reconstructPath model.cameFrom goal)
+            else
+                modelPopped =
+                    { model &
+                        openSet: Set.remove model.openSet current,
+                        evaluated: Set.insert model.evaluated current,
+                    }
+
+                neighbors =
+                    moveFn current
+
+                newNeighbors =
+                    Set.difference neighbors modelPopped.evaluated
+
+                modelWithNeighbors : Model position
+                modelWithNeighbors =
+                    { modelPopped &
+                        openSet: Set.union modelPopped.openSet newNeighbors,
+                    }
+
+                walker : Model position, position -> Model position
+                walker = \amodel, n -> updateCost current n amodel
+
+                modelWithCosts =
+                    Set.walk newNeighbors modelWithNeighbors walker
+
+                astar costFn moveFn goal modelWithCosts
+
+# takeStep = \moveFn, _goal, model, current ->
+#     modelPopped =
+#         { model &
+#             openSet: Set.remove model.openSet current,
+#             evaluated: Set.insert model.evaluated current,
+#         }
+#
+#     neighbors = moveFn current
+#
+#     newNeighbors = Set.difference neighbors modelPopped.evaluated
+#
+#     modelWithNeighbors = { modelPopped & openSet: Set.union modelPopped.openSet newNeighbors }
+#
+#     # a lot goes wrong here
+#     modelWithCosts =
+#         Set.walk newNeighbors modelWithNeighbors (\n, m -> updateCost current n m)
+#
+#     modelWithCosts

crates/cli_testing_examples/benchmarks/Base64.roc

@@ -0,0 +1,35 @@
+interface Base64 exposes [fromBytes, fromStr, toBytes, toStr] imports [Base64.Decode, Base64.Encode]
+
+# base 64 encoding from a sequence of bytes
+fromBytes : List U8 -> Result Str [InvalidInput]*
+fromBytes = \bytes ->
+    when Base64.Decode.fromBytes bytes is
+        Ok v ->
+            Ok v
+
+        Err _ ->
+            Err InvalidInput
+
+# base 64 encoding from a string
+fromStr : Str -> Result Str [InvalidInput]*
+fromStr = \str ->
+    fromBytes (Str.toUtf8 str)
+
+# base64-encode bytes to the original
+toBytes : Str -> Result (List U8) [InvalidInput]*
+toBytes = \str ->
+    Ok (Base64.Encode.toBytes str)
+
+toStr : Str -> Result Str [InvalidInput]*
+toStr = \str ->
+    when toBytes str is
+        Ok bytes ->
+            when Str.fromUtf8 bytes is
+                Ok v ->
+                    Ok v
+
+                Err _ ->
+                    Err InvalidInput
+
+        Err _ ->
+            Err InvalidInput

crates/cli_testing_examples/benchmarks/Base64/Decode.roc

@@ -0,0 +1,120 @@
+interface Base64.Decode exposes [fromBytes] imports [Bytes.Decode.{ ByteDecoder, DecodeProblem }]
+
+fromBytes : List U8 -> Result Str DecodeProblem
+fromBytes = \bytes ->
+    Bytes.Decode.decode bytes (decodeBase64 (List.len bytes))
+
+decodeBase64 : Nat -> ByteDecoder Str
+decodeBase64 = \width -> Bytes.Decode.loop loopHelp { remaining: width, string: "" }
+
+loopHelp : { remaining : Nat, string : Str } -> ByteDecoder (Bytes.Decode.Step { remaining : Nat, string : Str } Str)
+loopHelp = \{ remaining, string } ->
+    if remaining >= 3 then
+        x, y, z <- Bytes.Decode.map3 Bytes.Decode.u8 Bytes.Decode.u8 Bytes.Decode.u8
+
+        a : U32
+        a = Num.intCast x
+        b : U32
+        b = Num.intCast y
+        c : U32
+        c = Num.intCast z
+        combined = Num.bitwiseOr (Num.bitwiseOr (Num.shiftLeftBy a 16) (Num.shiftLeftBy b 8)) c
+
+        Loop {
+            remaining: remaining - 3,
+            string: Str.concat string (bitsToChars combined 0),
+        }
+    else if remaining == 0 then
+        Bytes.Decode.succeed (Done string)
+    else if remaining == 2 then
+        x, y <- Bytes.Decode.map2 Bytes.Decode.u8 Bytes.Decode.u8
+
+        a : U32
+        a = Num.intCast x
+        b : U32
+        b = Num.intCast y
+        combined = Num.bitwiseOr (Num.shiftLeftBy a 16) (Num.shiftLeftBy b 8)
+
+        Done (Str.concat string (bitsToChars combined 1))
+    else
+        # remaining = 1
+        x <- Bytes.Decode.map Bytes.Decode.u8
+
+        a : U32
+        a = Num.intCast x
+
+        Done (Str.concat string (bitsToChars (Num.shiftLeftBy a 16) 2))
+
+bitsToChars : U32, Int * -> Str
+bitsToChars = \bits, missing ->
+    when Str.fromUtf8 (bitsToCharsHelp bits missing) is
+        Ok str -> str
+        Err _ -> ""
+
+# Mask that can be used to get the lowest 6 bits of a binary number
+lowest6BitsMask : Int *
+lowest6BitsMask = 63
+
+bitsToCharsHelp : U32, Int * -> List U8
+bitsToCharsHelp = \bits, missing ->
+    # The input is 24 bits, which we have to partition into 4 6-bit segments. We achieve this by
+    # shifting to the right by (a multiple of) 6 to remove unwanted bits on the right, then `Num.bitwiseAnd`
+    # with `0b111111` (which is 2^6 - 1 or 63) (so, 6 1s) to remove unwanted bits on the left.
+    # any 6-bit number is a valid base64 digit, so this is actually safe
+    p =
+        Num.shiftRightZfBy bits 18
+        |> Num.intCast
+        |> unsafeToChar
+
+    q =
+        Num.bitwiseAnd (Num.shiftRightZfBy bits 12) lowest6BitsMask
+        |> Num.intCast
+        |> unsafeToChar
+
+    r =
+        Num.bitwiseAnd (Num.shiftRightZfBy bits 6) lowest6BitsMask
+        |> Num.intCast
+        |> unsafeToChar
+
+    s =
+        Num.bitwiseAnd bits lowest6BitsMask
+        |> Num.intCast
+        |> unsafeToChar
+
+    equals : U8
+    equals = 61
+
+    when missing is
+        0 -> [p, q, r, s]
+        1 -> [p, q, r, equals]
+        2 -> [p, q, equals, equals]
+        _ ->
+            # unreachable
+            []
+
+# Base64 index to character/digit
+unsafeToChar : U8 -> U8
+unsafeToChar = \n ->
+    if n <= 25 then
+        # uppercase characters
+        65 + n
+    else if n <= 51 then
+        # lowercase characters
+        97 + (n - 26)
+    else if n <= 61 then
+        # digit characters
+        48 + (n - 52)
+    else
+        # special cases
+        when n is
+            62 ->
+                # '+'
+                43
+
+            63 ->
+                # '/'
+                47
+
+            _ ->
+                # anything else is invalid '\u{0000}'
+                0

crates/cli_testing_examples/benchmarks/Base64/Encode.roc

@@ -0,0 +1,176 @@
+interface Base64.Encode
+    exposes [toBytes]
+    imports [Bytes.Encode.{ ByteEncoder }]
+
+InvalidChar : U8
+
+# State : [None, One U8, Two U8, Three U8]
+toBytes : Str -> List U8
+toBytes = \str ->
+    str
+    |> Str.toUtf8
+    |> encodeChunks
+    |> Bytes.Encode.sequence
+    |> Bytes.Encode.encode
+
+encodeChunks : List U8 -> List ByteEncoder
+encodeChunks = \bytes ->
+    List.walk bytes { output: [], accum: None } folder
+    |> encodeResidual
+
+coerce : Nat, a -> a
+coerce = \_, x -> x
+
+# folder : { output : List ByteEncoder, accum : State }, U8 -> { output : List ByteEncoder, accum : State }
+folder = \{ output, accum }, char ->
+    when accum is
+        Unreachable n -> coerce n { output, accum: Unreachable n }
+        None -> { output, accum: One char }
+        One a -> { output, accum: Two a char }
+        Two a b -> { output, accum: Three a b char }
+        Three a b c ->
+            when encodeCharacters a b c char is
+                Ok encoder ->
+                    {
+                        output: List.append output encoder,
+                        accum: None,
+                    }
+
+                Err _ ->
+                    { output, accum: None }
+
+#  SGVs bG8g V29y bGQ=
+# encodeResidual : { output : List ByteEncoder, accum : State } -> List ByteEncoder
+encodeResidual = \{ output, accum } ->
+    when accum is
+        Unreachable _ -> output
+        None -> output
+        One _ -> output
+        Two a b ->
+            when encodeCharacters a b equals equals is
+                Ok encoder -> List.append output encoder
+                Err _ -> output
+
+        Three a b c ->
+            when encodeCharacters a b c equals is
+                Ok encoder -> List.append output encoder
+                Err _ -> output
+
+equals : U8
+equals = 61
+
+# Convert 4 characters to 24 bits (as an ByteEncoder)
+encodeCharacters : U8, U8, U8, U8 -> Result ByteEncoder InvalidChar
+encodeCharacters = \a, b, c, d ->
+    if !(isValidChar a) then
+        Err a
+    else if !(isValidChar b) then
+        Err b
+    else
+        # `=` is the padding character, and must be special-cased
+        # only the `c` and `d` char are allowed to be padding
+        n1 = unsafeConvertChar a
+        n2 = unsafeConvertChar b
+
+        x : U32
+        x = Num.intCast n1
+
+        y : U32
+        y = Num.intCast n2
+
+        if d == equals then
+            if c == equals then
+                n = Num.bitwiseOr (Num.shiftLeftBy x 18) (Num.shiftLeftBy y 12)
+
+                # masking higher bits is not needed, Encode.unsignedInt8 ignores higher bits
+                b1 : U8
+                b1 = Num.intCast (Num.shiftRightBy n 16)
+
+                Ok (Bytes.Encode.u8 b1)
+            else if !(isValidChar c) then
+                Err c
+            else
+                n3 = unsafeConvertChar c
+
+                z : U32
+                z = Num.intCast n3
+
+                n = Num.bitwiseOr (Num.bitwiseOr (Num.shiftLeftBy x 18) (Num.shiftLeftBy y 12)) (Num.shiftLeftBy z 6)
+
+                combined : U16
+                combined = Num.intCast (Num.shiftRightBy n 8)
+
+                Ok (Bytes.Encode.u16 BE combined)
+        else if !(isValidChar d) then
+            Err d
+        else
+            n3 = unsafeConvertChar c
+            n4 = unsafeConvertChar d
+
+            z : U32
+            z = Num.intCast n3
+
+            w : U32
+            w = Num.intCast n4
+
+            n =
+                Num.bitwiseOr
+                    (Num.bitwiseOr (Num.shiftLeftBy x 18) (Num.shiftLeftBy y 12))
+                    (Num.bitwiseOr (Num.shiftLeftBy z 6) w)
+
+            b3 : U8
+            b3 = Num.intCast n
+
+            combined : U16
+            combined = Num.intCast (Num.shiftRightBy n 8)
+
+            Ok (Bytes.Encode.sequence [Bytes.Encode.u16 BE combined, Bytes.Encode.u8 b3])
+
+# is the character a base64 digit?
+# The base16 digits are: A-Z, a-z, 0-1, '+' and '/'
+isValidChar : U8 -> Bool
+isValidChar = \c ->
+    if isAlphaNum c then
+        Bool.true
+    else
+        when c is
+            43 ->
+                # '+'
+                Bool.true
+
+            47 ->
+                # '/'
+                Bool.true
+
+            _ ->
+                Bool.false
+
+isAlphaNum : U8 -> Bool
+isAlphaNum = \key ->
+    (key >= 48 && key <= 57) || (key >= 64 && key <= 90) || (key >= 97 && key <= 122)
+
+# Convert a base64 character/digit to its index
+# See also [Wikipedia](https://en.wikipedia.org/wiki/Base64#Base64_table)
+unsafeConvertChar : U8 -> U8
+unsafeConvertChar = \key ->
+    if key >= 65 && key <= 90 then
+        # A-Z
+        key - 65
+    else if key >= 97 && key <= 122 then
+        # a-z
+        (key - 97) + 26
+    else if key >= 48 && key <= 57 then
+        # 0-9
+        (key - 48) + 26 + 26
+    else
+        when key is
+            43 ->
+                # '+'
+                62
+
+            47 ->
+                # '/'
+                63
+
+            _ ->
+                0

crates/cli_testing_examples/benchmarks/Bytes/Decode.roc

@@ -0,0 +1,111 @@
+interface Bytes.Decode exposes [ByteDecoder, decode, map, map2, u8, loop, Step, succeed, DecodeProblem, after, map3] imports []
+
+State : { bytes : List U8, cursor : Nat }
+
+DecodeProblem : [OutOfBytes]
+
+ByteDecoder a := State -> [Good State a, Bad DecodeProblem]
+
+decode : List U8, ByteDecoder a -> Result a DecodeProblem
+decode = \bytes, @ByteDecoder decoder ->
+    when decoder { bytes, cursor: 0 } is
+        Good _ value ->
+            Ok value
+
+        Bad e ->
+            Err e
+
+succeed : a -> ByteDecoder a
+succeed = \value -> @ByteDecoder \state -> Good state value
+
+map : ByteDecoder a, (a -> b) -> ByteDecoder b
+map = \@ByteDecoder decoder, transform ->
+    @ByteDecoder
+        \state ->
+            when decoder state is
+                Good state1 value ->
+                    Good state1 (transform value)
+
+                Bad e ->
+                    Bad e
+
+map2 : ByteDecoder a, ByteDecoder b, (a, b -> c) -> ByteDecoder c
+map2 = \@ByteDecoder decoder1, @ByteDecoder decoder2, transform ->
+    @ByteDecoder
+        \state1 ->
+            when decoder1 state1 is
+                Good state2 a ->
+                    when decoder2 state2 is
+                        Good state3 b ->
+                            Good state3 (transform a b)
+
+                        Bad e ->
+                            Bad e
+
+                Bad e ->
+                    Bad e
+
+map3 : ByteDecoder a, ByteDecoder b, ByteDecoder c, (a, b, c -> d) -> ByteDecoder d
+map3 = \@ByteDecoder decoder1, @ByteDecoder decoder2, @ByteDecoder decoder3, transform ->
+    @ByteDecoder
+        \state1 ->
+            when decoder1 state1 is
+                Good state2 a ->
+                    when decoder2 state2 is
+                        Good state3 b ->
+                            when decoder3 state3 is
+                                Good state4 c ->
+                                    Good state4 (transform a b c)
+
+                                Bad e ->
+                                    Bad e
+
+                        Bad e ->
+                            Bad e
+
+                Bad e ->
+                    Bad e
+
+after : ByteDecoder a, (a -> ByteDecoder b) -> ByteDecoder b
+after = \@ByteDecoder decoder, transform ->
+    @ByteDecoder
+        \state ->
+            when decoder state is
+                Good state1 value ->
+                    (@ByteDecoder decoder1) = transform value
+
+                    decoder1 state1
+
+                Bad e ->
+                    Bad e
+
+u8 : ByteDecoder U8
+u8 = @ByteDecoder
+    \state ->
+        when List.get state.bytes state.cursor is
+            Ok b ->
+                Good { state & cursor: state.cursor + 1 } b
+
+            Err _ ->
+                Bad OutOfBytes
+
+Step state b : [Loop state, Done b]
+
+loop : (state -> ByteDecoder (Step state a)), state -> ByteDecoder a
+loop = \stepper, initial ->
+    @ByteDecoder
+        \state ->
+            loopHelp stepper initial state
+
+loopHelp = \stepper, accum, state ->
+    (@ByteDecoder stepper1) = stepper accum
+
+    when stepper1 state is
+        Good newState (Done value) ->
+            Good newState value
+
+        Good newState (Loop newAccum) ->
+            loopHelp stepper newAccum newState
+
+        Bad e ->
+            Bad e

crates/cli_testing_examples/benchmarks/Bytes/Encode.roc

@@ -0,0 +1,134 @@
+interface Bytes.Encode exposes [ByteEncoder, sequence, u8, u16, bytes, empty, encode] imports []
+
+Endianness : [BE, LE]
+
+ByteEncoder : [Signed8 I8, Unsigned8 U8, Signed16 Endianness I16, Unsigned16 Endianness U16, Sequence Nat (List ByteEncoder), Bytes (List U8)]
+
+u8 : U8 -> ByteEncoder
+u8 = \value -> Unsigned8 value
+
+empty : ByteEncoder
+empty =
+    foo : List ByteEncoder
+    foo = []
+
+    Sequence 0 foo
+
+u16 : Endianness, U16 -> ByteEncoder
+u16 = \endianness, value -> Unsigned16 endianness value
+
+bytes : List U8 -> ByteEncoder
+bytes = \bs -> Bytes bs
+
+sequence : List ByteEncoder -> ByteEncoder
+sequence = \encoders ->
+    Sequence (getWidths encoders 0) encoders
+
+getWidth : ByteEncoder -> Nat
+getWidth = \encoder ->
+    when encoder is
+        Signed8 _ -> 1
+        Unsigned8 _ -> 1
+        Signed16 _ _ -> 2
+        Unsigned16 _ _ -> 2
+        # Signed32 _ -> 4
+        # Unsigned32 _ -> 4
+        # Signed64 _ -> 8
+        # Unsigned64 _ -> 8
+        # Signed128 _ -> 16
+        # Unsigned128 _ -> 16
+        Sequence w _ -> w
+        Bytes bs -> List.len bs
+
+getWidths : List ByteEncoder, Nat -> Nat
+getWidths = \encoders, initial ->
+    List.walk encoders initial \accum, encoder -> accum + getWidth encoder
+
+encode : ByteEncoder -> List U8
+encode = \encoder ->
+    output = List.repeat 0 (getWidth encoder)
+
+    encodeHelp encoder 0 output
+    |> .output
+
+encodeHelp : ByteEncoder, Nat, List U8 -> { output : List U8, offset : Nat }
+encodeHelp = \encoder, offset, output ->
+    when encoder is
+        Unsigned8 value ->
+            {
+                output: List.set output offset value,
+                offset: offset + 1,
+            }
+
+        Signed8 value ->
+            cast : U8
+            cast = Num.intCast value
+
+            {
+                output: List.set output offset cast,
+                offset: offset + 1,
+            }
+
+        Unsigned16 endianness value ->
+            a : U8
+            a = Num.intCast (Num.shiftRightBy value 8)
+
+            b : U8
+            b = Num.intCast value
+
+            newOutput =
+                when endianness is
+                    BE ->
+                        output
+                        |> List.set (offset + 0) a
+                        |> List.set (offset + 1) b
+
+                    LE ->
+                        output
+                        |> List.set (offset + 0) b
+                        |> List.set (offset + 1) a
+
+            {
+                output: newOutput,
+                offset: offset + 2,
+            }
+
+        Signed16 endianness value ->
+            a : U8
+            a = Num.intCast (Num.shiftRightBy value 8)
+
+            b : U8
+            b = Num.intCast value
+
+            newOutput =
+                when endianness is
+                    BE ->
+                        output
+                        |> List.set (offset + 0) a
+                        |> List.set (offset + 1) b
+
+                    LE ->
+                        output
+                        |> List.set (offset + 0) b
+                        |> List.set (offset + 1) a
+
+            {
+                output: newOutput,
+                offset: offset + 1,
+            }
+
+        Bytes bs ->
+            List.walk
+                bs
+                { output, offset }
+                \accum, byte -> {
+                    offset: accum.offset + 1,
+                    output: List.set accum.output offset byte,
+                }
+
+        Sequence _ encoders ->
+            List.walk
+                encoders
+                { output, offset }
+                \accum, single ->
+                    encodeHelp single accum.offset accum.output

crates/cli_testing_examples/benchmarks/CFold.roc

@@ -0,0 +1,130 @@
+app "cfold"
+    packages { pf: "platform/main.roc" }
+    imports [pf.Task]
+    provides [main] to pf
+
+# adapted from https://github.com/koka-lang/koka/blob/master/test/bench/haskell/cfold.hs
+main : Task.Task {} []
+main =
+    Task.after
+        Task.getInt
+        \n ->
+            e = mkExpr n 1 # original koka n = 20 (set `ulimit -s unlimited` to avoid stack overflow for n = 20)
+            unoptimized = eval e
+            optimized = eval (constFolding (reassoc e))
+
+            unoptimized
+            |> Num.toStr
+            |> Str.concat " & "
+            |> Str.concat (Num.toStr optimized)
+            |> Task.putLine
+
+Expr : [
+    Add Expr Expr,
+    Mul Expr Expr,
+    Val I64,
+    Var I64,
+]
+
+mkExpr : I64, I64 -> Expr
+mkExpr = \n, v ->
+    when n is
+        0 ->
+            if v == 0 then Var 1 else Val v
+
+        _ ->
+            Add (mkExpr (n - 1) (v + 1)) (mkExpr (n - 1) (max (v - 1) 0))
+
+max : I64, I64 -> I64
+max = \a, b -> if a > b then a else b
+
+appendAdd : Expr, Expr -> Expr
+appendAdd = \e1, e2 ->
+    when e1 is
+        Add a1 a2 ->
+            Add a1 (appendAdd a2 e2)
+
+        _ ->
+            Add e1 e2
+
+appendMul : Expr, Expr -> Expr
+appendMul = \e1, e2 ->
+    when e1 is
+        Mul a1 a2 ->
+            Mul a1 (appendMul a2 e2)
+
+        _ ->
+            Mul e1 e2
+
+eval : Expr -> I64
+eval = \e ->
+    when e is
+        Var _ ->
+            0
+
+        Val v ->
+            v
+
+        Add l r ->
+            eval l + eval r
+
+        Mul l r ->
+            eval l * eval r
+
+reassoc : Expr -> Expr
+reassoc = \e ->
+    when e is
+        Add e1 e2 ->
+            x1 = reassoc e1
+            x2 = reassoc e2
+
+            appendAdd x1 x2
+
+        Mul e1 e2 ->
+            x1 = reassoc e1
+            x2 = reassoc e2
+
+            appendMul x1 x2
+
+        _ ->
+            e
+
+constFolding : Expr -> Expr
+constFolding = \e ->
+    when e is
+        Add e1 e2 ->
+            x1 = constFolding e1
+            x2 = constFolding e2
+
+            when Pair x1 x2 is
+                Pair (Val a) (Val b) ->
+                    Val (a + b)
+
+                Pair (Val a) (Add (Val b) x) ->
+                    Add (Val (a + b)) x
+
+                Pair (Val a) (Add x (Val b)) ->
+                    Add (Val (a + b)) x
+
+                Pair y1 y2 ->
+                    Add y1 y2
+
+        Mul e1 e2 ->
+            x1 = constFolding e1
+            x2 = constFolding e2
+
+            when Pair x1 x2 is
+                Pair (Val a) (Val b) ->
+                    Val (a * b)
+
+                Pair (Val a) (Mul (Val b) x) ->
+                    Mul (Val (a * b)) x
+
+                Pair (Val a) (Mul x (Val b)) ->
+                    Mul (Val (a * b)) x
+
+                Pair y1 y2 ->
+                    Add y1 y2
+
+        _ ->
+            e

crates/cli_testing_examples/benchmarks/Closure.roc

@@ -0,0 +1,51 @@
+app "closure"
+    packages { pf: "platform/main.roc" }
+    imports [pf.Task]
+    provides [main] to pf
+
+# see https://github.com/roc-lang/roc/issues/985
+main : Task.Task {} []
+main = closure1 {}
+# |> Task.after (\_ -> closure2 {})
+# |> Task.after (\_ -> closure3 {})
+# |> Task.after (\_ -> closure4 {})
+# ---
+closure1 : {} -> Task.Task {} []
+closure1 = \_ ->
+    Task.succeed (foo toUnitBorrowed "a long string such that it's malloced")
+    |> Task.map \_ -> {}
+
+toUnitBorrowed = \x -> Str.countGraphemes x
+
+foo = \f, x -> f x
+
+# ---
+# closure2 : {} -> Task.Task {} []
+# closure2 = \_ ->
+#     x : Str
+#     x = "a long string such that it's malloced"
+#
+#     Task.succeed {}
+#         |> Task.map (\_ -> x)
+#         |> Task.map toUnit
+#
+# toUnit = \_ -> {}
+#
+# # ---
+# closure3 : {} -> Task.Task {} []
+# closure3 = \_ ->
+#     x : Str
+#     x = "a long string such that it's malloced"
+#
+#     Task.succeed {}
+#         |> Task.after (\_ -> Task.succeed x |> Task.map (\_ -> {}))
+#
+# # ---
+# closure4 : {} -> Task.Task {} []
+# closure4 = \_ ->
+#     x : Str
+#     x = "a long string such that it's malloced"
+#
+#     Task.succeed {}
+#         |> Task.after (\_ -> Task.succeed x)
+#         |> Task.map (\_ -> {})

crates/cli_testing_examples/benchmarks/Deriv.roc

@@ -0,0 +1,167 @@
+app "deriv"
+    packages { pf: "platform/main.roc" }
+    imports [pf.Task]
+    provides [main] to pf
+
+# based on: https://github.com/koka-lang/koka/blob/master/test/bench/haskell/deriv.hs
+IO a : Task.Task a []
+
+main : Task.Task {} []
+main =
+    Task.after
+        Task.getInt
+        \n ->
+            x : Expr
+            x = Var "x"
+
+            f : Expr
+            f = pow x x
+
+            nest deriv n f # original koka n = 10
+            |> Task.map \_ -> {}
+
+nest : (I64, Expr -> IO Expr), I64, Expr -> IO Expr
+nest = \f, n, e -> Task.loop { s: n, f, m: n, x: e } nestHelp
+
+State : { s : I64, f : I64, Expr -> IO Expr, m : I64, x : Expr }
+
+nestHelp : State -> IO [Step State, Done Expr]
+nestHelp = \{ s, f, m, x } ->
+    when m is
+        0 -> Task.succeed (Done x)
+        _ ->
+            w <- Task.after (f (s - m) x)
+
+            Task.succeed (Step { s, f, m: (m - 1), x: w })
+
+Expr : [Val I64, Var Str, Add Expr Expr, Mul Expr Expr, Pow Expr Expr, Ln Expr]
+
+divmod : I64, I64 -> Result { div : I64, mod : I64 } [DivByZero]*
+divmod = \l, r ->
+    when Pair (Num.divTruncChecked l r) (Num.remChecked l r) is
+        Pair (Ok div) (Ok mod) -> Ok { div, mod }
+        _ -> Err DivByZero
+
+pown : I64, I64 -> I64
+pown = \a, n ->
+    when n is
+        0 -> 1
+        1 -> a
+        _ ->
+            when divmod n 2 is
+                Ok { div, mod } ->
+                    b = pown a div
+
+                    b * b * (if mod == 0 then 1 else a)
+
+                Err DivByZero ->
+                    -1
+
+add : Expr, Expr -> Expr
+add = \a, b ->
+    when Pair a b is
+        Pair (Val n) (Val m) ->
+            Val (n + m)
+
+        Pair (Val 0) f ->
+            f
+
+        Pair f (Val 0) ->
+            f
+
+        Pair f (Val n) ->
+            add (Val n) f
+
+        Pair (Val n) (Add (Val m) f) ->
+            add (Val (n + m)) f
+
+        Pair f (Add (Val n) g) ->
+            add (Val n) (add f g)
+
+        Pair (Add f g) h ->
+            add f (add g h)
+
+        Pair f g ->
+            Add f g
+
+mul : Expr, Expr -> Expr
+mul = \a, b ->
+    when Pair a b is
+        Pair (Val n) (Val m) ->
+            Val (n * m)
+
+        Pair (Val 0) _ ->
+            Val 0
+
+        Pair _ (Val 0) ->
+            Val 0
+
+        Pair (Val 1) f ->
+            f
+
+        Pair f (Val 1) ->
+            f
+
+        Pair f (Val n) ->
+            mul (Val n) f
+
+        Pair (Val n) (Mul (Val m) f) ->
+            mul (Val (n * m)) f
+
+        Pair f (Mul (Val n) g) ->
+            mul (Val n) (mul f g)
+
+        Pair (Mul f g) h ->
+            mul f (mul g h)
+
+        Pair f g ->
+            Mul f g
+
+pow : Expr, Expr -> Expr
+pow = \a, b ->
+    when Pair a b is
+        Pair (Val m) (Val n) -> Val (pown m n)
+        Pair _ (Val 0) -> Val 1
+        Pair f (Val 1) -> f
+        Pair (Val 0) _ -> Val 0
+        Pair f g -> Pow f g
+
+ln : Expr -> Expr
+ln = \f ->
+    when f is
+        Val 1 -> Val 0
+        _ -> Ln f
+
+d : Str, Expr -> Expr
+d = \x, expr ->
+    when expr is
+        Val _ -> Val 0
+        Var y -> if x == y then Val 1 else Val 0
+        Add f g -> add (d x f) (d x g)
+        Mul f g -> add (mul f (d x g)) (mul g (d x f))
+        Pow f g ->
+            mul (pow f g) (add (mul (mul g (d x f)) (pow f (Val (-1)))) (mul (ln f) (d x g)))
+
+        Ln f ->
+            mul (d x f) (pow f (Val (-1)))
+
+count : Expr -> I64
+count = \expr ->
+    when expr is
+        Val _ -> 1
+        Var _ -> 1
+        Add f g -> count f + count g
+        Mul f g -> count f + count g
+        Pow f g -> count f + count g
+        Ln f -> count f
+
+deriv : I64, Expr -> IO Expr
+deriv = \i, f ->
+    fprime = d "x" f
+    line =
+        Num.toStr (i + 1)
+        |> Str.concat " count: "
+        |> Str.concat (Num.toStr (count fprime))
+
+    Task.putLine line
+    |> Task.after \_ -> Task.succeed fprime

crates/cli_testing_examples/benchmarks/Issue2279.roc

@@ -0,0 +1,13 @@
+app "issue2279"
+    packages { pf: "platform/main.roc" }
+    imports [Issue2279Help, pf.Task]
+    provides [main] to pf
+
+main =
+    text =
+        if Bool.true then
+            Issue2279Help.text
+        else
+            Issue2279Help.asText 42
+
+    Task.putLine text

crates/cli_testing_examples/benchmarks/Issue2279Help.roc

@@ -0,0 +1,7 @@
+interface Issue2279Help
+    exposes [text, asText]
+    imports []
+
+text = "Hello, world!"
+
+asText = Num.toStr

crates/cli_testing_examples/benchmarks/NQueens.roc

@@ -0,0 +1,53 @@
+app "nqueens"
+    packages { pf: "platform/main.roc" }
+    imports [pf.Task]
+    provides [main] to pf
+
+main : Task.Task {} []
+main =
+    Task.after
+        Task.getInt
+        \n ->
+            queens n # original koka 13
+            |> Num.toStr
+            |> Task.putLine
+
+ConsList a : [Nil, Cons a (ConsList a)]
+
+queens = \n -> length (findSolutions n n)
+
+length : ConsList a -> I64
+length = \xs -> lengthHelp xs 0
+
+lengthHelp : ConsList a, I64 -> I64
+lengthHelp = \foobar, acc ->
+    when foobar is
+        Cons _ lrest -> lengthHelp lrest (1 + acc)
+        Nil -> acc
+
+safe : I64, I64, ConsList I64 -> Bool
+safe = \queen, diagonal, xs ->
+    when xs is
+        Nil -> Bool.true
+        Cons q t ->
+            queen != q && queen != q + diagonal && queen != q - diagonal && safe queen (diagonal + 1) t
+
+appendSafe : I64, ConsList I64, ConsList (ConsList I64) -> ConsList (ConsList I64)
+appendSafe = \k, soln, solns ->
+    if k <= 0 then
+        solns
+    else if safe k 1 soln then
+        appendSafe (k - 1) soln (Cons (Cons k soln) solns)
+    else
+        appendSafe (k - 1) soln solns
+
+extend = \n, acc, solutions ->
+    when solutions is
+        Nil -> acc
+        Cons soln rest -> extend n (appendSafe n soln acc) rest
+
+findSolutions = \n, k ->
+    if k == 0 then
+        Cons Nil Nil
+    else
+        extend n Nil (findSolutions n (k - 1))

crates/cli_testing_examples/benchmarks/Quicksort.roc

@@ -0,0 +1,75 @@
+interface Quicksort exposes [sortBy, sortWith, show] imports []
+
+show : List I64 -> Str
+show = \list ->
+    if List.isEmpty list then
+        "[]"
+    else
+        content =
+            list
+            |> List.map Num.toStr
+            |> Str.joinWith ", "
+
+        "[\(content)]"
+
+sortBy : List a, (a -> Num *) -> List a
+sortBy = \list, toComparable ->
+    sortWith list (\x, y -> Num.compare (toComparable x) (toComparable y))
+
+Order a : a, a -> [LT, GT, EQ]
+
+sortWith : List a, (a, a -> [LT, GT, EQ]) -> List a
+sortWith = \list, order ->
+    n = List.len list
+
+    quicksortHelp list order 0 (n - 1)
+
+quicksortHelp : List a, Order a, Nat, Nat -> List a
+quicksortHelp = \list, order, low, high ->
+    if low < high then
+        when partition low high list order is
+            Pair partitionIndex partitioned ->
+                partitioned
+                |> quicksortHelp order low (Num.subSaturated partitionIndex 1)
+                |> quicksortHelp order (partitionIndex + 1) high
+    else
+        list
+
+partition : Nat, Nat, List a, Order a -> [Pair Nat (List a)]
+partition = \low, high, initialList, order ->
+    when List.get initialList high is
+        Ok pivot ->
+            when partitionHelp low low initialList order high pivot is
+                Pair newI newList ->
+                    Pair newI (swap newI high newList)
+
+        Err _ ->
+            Pair low initialList
+
+partitionHelp : Nat, Nat, List c, Order c, Nat, c -> [Pair Nat (List c)]
+partitionHelp = \i, j, list, order, high, pivot ->
+    if j < high then
+        when List.get list j is
+            Ok value ->
+                when order value pivot is
+                    LT | EQ ->
+                        partitionHelp (i + 1) (j + 1) (swap i j list) order high pivot
+
+                    GT ->
+                        partitionHelp i (j + 1) list order high pivot
+
+            Err _ ->
+                Pair i list
+    else
+        Pair i list
+
+swap : Nat, Nat, List a -> List a
+swap = \i, j, list ->
+    when Pair (List.get list i) (List.get list j) is
+        Pair (Ok atI) (Ok atJ) ->
+            list
+            |> List.set i atJ
+            |> List.set j atI
+
+        _ ->
+            []

crates/cli_testing_examples/benchmarks/RBTreeCk.roc

@@ -0,0 +1,131 @@
+app "rbtree-ck"
+    packages { pf: "platform/main.roc" }
+    imports [pf.Task]
+    provides [main] to pf
+
+Color : [Red, Black]
+
+Tree a b : [Leaf, Node Color (Tree a b) a b (Tree a b)]
+
+Map : Tree I64 Bool
+
+ConsList a : [Nil, Cons a (ConsList a)]
+
+makeMap : I64, I64 -> ConsList Map
+makeMap = \freq, n ->
+    makeMapHelp freq n Leaf Nil
+
+makeMapHelp : I64, I64, Map, ConsList Map -> ConsList Map
+makeMapHelp = \freq, n, m, acc ->
+    when n is
+        0 -> Cons m acc
+        _ ->
+            powerOf10 =
+                n % 10 == 0
+
+            m1 = insert m n powerOf10
+
+            isFrequency =
+                n % freq == 0
+
+            x = (if isFrequency then Cons m1 acc else acc)
+
+            makeMapHelp freq (n - 1) m1 x
+
+fold : (a, b, omega -> omega), Tree a b, omega -> omega
+fold = \f, tree, b ->
+    when tree is
+        Leaf -> b
+        Node _ l k v r -> fold f r (f k v (fold f l b))
+
+main : Task.Task {} []
+main =
+    Task.after
+        Task.getInt
+        \n ->
+            # original koka n = 4_200_000
+            ms : ConsList Map
+            ms = makeMap 5 n
+
+            when ms is
+                Cons head _ ->
+                    val = fold (\_, v, r -> if v then r + 1 else r) head 0
+
+                    val
+                    |> Num.toStr
+                    |> Task.putLine
+
+                Nil ->
+                    Task.putLine "fail"
+
+insert : Tree (Num k) v, Num k, v -> Tree (Num k) v
+insert = \t, k, v -> if isRed t then setBlack (ins t k v) else ins t k v
+
+setBlack : Tree a b -> Tree a b
+setBlack = \tree ->
+    when tree is
+        Node _ l k v r -> Node Black l k v r
+        _ -> tree
+
+isRed : Tree a b -> Bool
+isRed = \tree ->
+    when tree is
+        Node Red _ _ _ _ -> Bool.true
+        _ -> Bool.false
+
+lt = \x, y -> x < y
+
+ins : Tree (Num k) v, Num k, v -> Tree (Num k) v
+ins = \tree, kx, vx ->
+    when tree is
+        Leaf -> Node Red Leaf kx vx Leaf
+        Node Red a ky vy b ->
+            if lt kx ky then
+                Node Red (ins a kx vx) ky vy b
+            else if lt ky kx then
+                Node Red a ky vy (ins b kx vx)
+            else
+                Node Red a ky vy (ins b kx vx)
+
+        Node Black a ky vy b ->
+            if lt kx ky then
+                (if isRed a then balance1 (Node Black Leaf ky vy b) (ins a kx vx) else Node Black (ins a kx vx) ky vy b)
+            else if lt ky kx then
+                (if isRed b then balance2 (Node Black a ky vy Leaf) (ins b kx vx) else Node Black a ky vy (ins b kx vx))
+            else
+                Node Black a kx vx b
+
+balance1 : Tree a b, Tree a b -> Tree a b
+balance1 = \tree1, tree2 ->
+    when tree1 is
+        Leaf -> Leaf
+        Node _ _ kv vv t ->
+            when tree2 is
+                Node _ (Node Red l kx vx r1) ky vy r2 ->
+                    Node Red (Node Black l kx vx r1) ky vy (Node Black r2 kv vv t)
+
+                Node _ l1 ky vy (Node Red l2 kx vx r) ->
+                    Node Red (Node Black l1 ky vy l2) kx vx (Node Black r kv vv t)
+
+                Node _ l ky vy r ->
+                    Node Black (Node Red l ky vy r) kv vv t
+
+                Leaf -> Leaf
+
+balance2 : Tree a b, Tree a b -> Tree a b
+balance2 = \tree1, tree2 ->
+    when tree1 is
+        Leaf -> Leaf
+        Node _ t kv vv _ ->
+            when tree2 is
+                Node _ (Node Red l kx1 vx1 r1) ky vy r2 ->
+                    Node Red (Node Black t kv vv l) kx1 vx1 (Node Black r1 ky vy r2)
+
+                Node _ l1 ky vy (Node Red l2 kx2 vx2 r2) ->
+                    Node Red (Node Black t kv vv l1) ky vy (Node Black l2 kx2 vx2 r2)
+
+                Node _ l ky vy r ->
+                    Node Black t kv vv (Node Red l ky vy r)
+
+                Leaf ->
+                    Leaf

crates/cli_testing_examples/benchmarks/RBTreeDel.roc

@@ -0,0 +1,247 @@
+app "rbtree-del"
+    packages { pf: "platform/main.roc" }
+    imports [pf.Task]
+    provides [main] to pf
+
+Color : [Red, Black]
+
+Tree a b : [Leaf, Node Color (Tree a b) a b (Tree a b)]
+
+Map : Tree I64 Bool
+
+ConsList a : [Nil, Cons a (ConsList a)]
+
+main : Task.Task {} []
+main =
+    Task.after
+        Task.getInt
+        \n ->
+            m = makeMap n # koka original n = 4_200_000
+            val = fold (\_, v, r -> if v then r + 1 else r) m 0
+
+            val
+            |> Num.toStr
+            |> Task.putLine
+
+boom : Str -> a
+boom = \_ -> boom ""
+
+makeMap : I64 -> Map
+makeMap = \n ->
+    makeMapHelp n n Leaf
+
+makeMapHelp : I64, I64, Map -> Map
+makeMapHelp = \total, n, m ->
+    when n is
+        0 -> m
+        _ ->
+            n1 = n - 1
+
+            powerOf10 =
+                n |> Num.isMultipleOf 10
+
+            t1 = insert m n powerOf10
+
+            isFrequency =
+                n |> Num.isMultipleOf 4
+
+            key = n1 + ((total - n1) // 5)
+            t2 = if isFrequency then delete t1 key else t1
+
+            makeMapHelp total n1 t2
+
+fold : (a, b, omega -> omega), Tree a b, omega -> omega
+fold = \f, tree, b ->
+    when tree is
+        Leaf -> b
+        Node _ l k v r -> fold f r (f k v (fold f l b))
+
+depth : Tree * * -> I64
+depth = \tree ->
+    when tree is
+        Leaf -> 1
+        Node _ l _ _ r -> 1 + depth l + depth r
+
+insert : Map, I64, Bool -> Map
+insert = \t, k, v -> if isRed t then setBlack (ins t k v) else ins t k v
+
+setBlack : Tree a b -> Tree a b
+setBlack = \tree ->
+    when tree is
+        Node _ l k v r -> Node Black l k v r
+        _ -> tree
+
+isRed : Tree a b -> Bool
+isRed = \tree ->
+    when tree is
+        Node Red _ _ _ _ -> Bool.true
+        _ -> Bool.false
+
+ins : Tree I64 Bool, I64, Bool -> Tree I64 Bool
+ins = \tree, kx, vx ->
+    when tree is
+        Leaf ->
+            Node Red Leaf kx vx Leaf
+
+        Node Red a ky vy b ->
+            when Num.compare kx ky is
+                LT -> Node Red (ins a kx vx) ky vy b
+                GT -> Node Red a ky vy (ins b kx vx)
+                EQ -> Node Red a ky vy (ins b kx vx)
+
+        Node Black a ky vy b ->
+            when Num.compare kx ky is
+                LT ->
+                    when isRed a is
+                        Bool.true -> balanceLeft (ins a kx vx) ky vy b
+                        Bool.false -> Node Black (ins a kx vx) ky vy b
+
+                GT ->
+                    when isRed b is
+                        Bool.true -> balanceRight a ky vy (ins b kx vx)
+                        Bool.false -> Node Black a ky vy (ins b kx vx)
+
+                EQ ->
+                    Node Black a kx vx b
+
+balanceLeft : Tree a b, a, b, Tree a b -> Tree a b
+balanceLeft = \l, k, v, r ->
+    when l is
+        Leaf ->
+            Leaf
+
+        Node _ (Node Red lx kx vx rx) ky vy ry ->
+            Node Red (Node Black lx kx vx rx) ky vy (Node Black ry k v r)
+
+        Node _ ly ky vy (Node Red lx kx vx rx) ->
+            Node Red (Node Black ly ky vy lx) kx vx (Node Black rx k v r)
+
+        Node _ lx kx vx rx ->
+            Node Black (Node Red lx kx vx rx) k v r
+
+balanceRight : Tree a b, a, b, Tree a b -> Tree a b
+balanceRight = \l, k, v, r ->
+    when r is
+        Leaf ->
+            Leaf
+
+        Node _ (Node Red lx kx vx rx) ky vy ry ->
+            Node Red (Node Black l k v lx) kx vx (Node Black rx ky vy ry)
+
+        Node _ lx kx vx (Node Red ly ky vy ry) ->
+            Node Red (Node Black l k v lx) kx vx (Node Black ly ky vy ry)
+
+        Node _ lx kx vx rx ->
+            Node Black l k v (Node Red lx kx vx rx)
+
+isBlack : Color -> Bool
+isBlack = \c ->
+    when c is
+        Black -> Bool.true
+        Red -> Bool.false
+
+Del a b : [Del (Tree a b) Bool]
+
+setRed : Map -> Map
+setRed = \t ->
+    when t is
+        Node _ l k v r ->
+            Node Red l k v r
+
+        _ ->
+            t
+
+makeBlack : Map -> Del I64 Bool
+makeBlack = \t ->
+    when t is
+        Node Red l k v r ->
+            Del (Node Black l k v r) Bool.false
+
+        _ ->
+            Del t Bool.true
+
+rebalanceLeft = \c, l, k, v, r ->
+    when l is
+        Node Black _ _ _ _ ->
+            Del (balanceLeft (setRed l) k v r) (isBlack c)
+
+        Node Red lx kx vx rx ->
+            Del (Node Black lx kx vx (balanceLeft (setRed rx) k v r)) Bool.false
+
+        _ ->
+            boom "unreachable"
+
+rebalanceRight = \c, l, k, v, r ->
+    when r is
+        Node Black _ _ _ _ ->
+            Del (balanceRight l k v (setRed r)) (isBlack c)
+
+        Node Red lx kx vx rx ->
+            Del (Node Black (balanceRight l k v (setRed lx)) kx vx rx) Bool.false
+
+        _ ->
+            boom "unreachable"
+
+delMin = \t ->
+    when t is
+        Node Black Leaf k v r ->
+            when r is
+                Leaf ->
+                    Delmin (Del Leaf Bool.true) k v
+
+                _ ->
+                    Delmin (Del (setBlack r) Bool.false) k v
+
+        Node Red Leaf k v r ->
+            Delmin (Del r Bool.false) k v
+
+        Node c l k v r ->
+            when delMin l is
+                Delmin (Del lx Bool.true) kx vx ->
+                    Delmin (rebalanceRight c lx k v r) kx vx
+
+                Delmin (Del lx Bool.false) kx vx ->
+                    Delmin (Del (Node c lx k v r) Bool.false) kx vx
+
+        Leaf ->
+            Delmin (Del t Bool.false) 0 Bool.false
+
+delete : Tree I64 Bool, I64 -> Tree I64 Bool
+delete = \t, k ->
+    when del t k is
+        Del tx _ ->
+            setBlack tx
+
+del : Tree I64 Bool, I64 -> Del I64 Bool
+del = \t, k ->
+    when t is
+        Leaf ->
+            Del Leaf Bool.false
+
+        Node cx lx kx vx rx ->
+            if (k < kx) then
+                when del lx k is
+                    Del ly Bool.true ->
+                        rebalanceRight cx ly kx vx rx
+
+                    Del ly Bool.false ->
+                        Del (Node cx ly kx vx rx) Bool.false
+            else if (k > kx) then
+                when del rx k is
+                    Del ry Bool.true ->
+                        rebalanceLeft cx lx kx vx ry
+
+                    Del ry Bool.false ->
+                        Del (Node cx lx kx vx ry) Bool.false
+            else
+                when rx is
+                    Leaf ->
+                        if isBlack cx then makeBlack lx else Del lx Bool.false
+
+                    Node _ _ _ _ _ ->
+                        when delMin rx is
+                            Delmin (Del ry Bool.true) ky vy ->
+                                rebalanceLeft cx lx ky vy ry
+
+                            Delmin (Del ry Bool.false) ky vy ->
+                                Del (Node cx lx ky vy ry) Bool.false

crates/cli_testing_examples/benchmarks/RBTreeInsert.roc

@@ -0,0 +1,101 @@
+app "rbtree-insert"
+    packages { pf: "platform/main.roc" }
+    imports [pf.Task]
+    provides [main] to pf
+
+main : Task.Task {} []
+main =
+    tree : RedBlackTree I64 {}
+    tree = insert 0 {} Empty
+
+    tree
+    |> show
+    |> Task.putLine
+
+show : RedBlackTree I64 {} -> Str
+show = \tree -> showRBTree tree Num.toStr (\{} -> "{}")
+
+showRBTree : RedBlackTree k v, (k -> Str), (v -> Str) -> Str
+showRBTree = \tree, showKey, showValue ->
+    when tree is
+        Empty -> "Empty"
+        Node color key value left right ->
+            sColor = showColor color
+            sKey = showKey key
+            sValue = showValue value
+            sL = nodeInParens left showKey showValue
+            sR = nodeInParens right showKey showValue
+
+            "Node \(sColor) \(sKey) \(sValue) \(sL) \(sR)"
+
+nodeInParens : RedBlackTree k v, (k -> Str), (v -> Str) -> Str
+nodeInParens = \tree, showKey, showValue ->
+    when tree is
+        Empty ->
+            showRBTree tree showKey showValue
+
+        Node _ _ _ _ _ ->
+            inner = showRBTree tree showKey showValue
+
+            "(\(inner))"
+
+showColor : NodeColor -> Str
+showColor = \color ->
+    when color is
+        Red -> "Red"
+        Black -> "Black"
+
+NodeColor : [Red, Black]
+
+RedBlackTree k v : [Node NodeColor k v (RedBlackTree k v) (RedBlackTree k v), Empty]
+
+Key k : Num k
+
+insert : Key k, v, RedBlackTree (Key k) v -> RedBlackTree (Key k) v
+insert = \key, value, dict ->
+    when insertHelp key value dict is
+        Node Red k v l r -> Node Black k v l r
+        x -> x
+
+insertHelp : Key k, v, RedBlackTree (Key k) v -> RedBlackTree (Key k) v
+insertHelp = \key, value, dict ->
+    when dict is
+        Empty ->
+            # New nodes are always red. If it violates the rules, it will be fixed
+            # when balancing.
+            Node Red key value Empty Empty
+
+        Node nColor nKey nValue nLeft nRight ->
+            when Num.compare key nKey is
+                LT -> balance nColor nKey nValue (insertHelp key value nLeft) nRight
+                EQ -> Node nColor nKey value nLeft nRight
+                GT -> balance nColor nKey nValue nLeft (insertHelp key value nRight)
+
+balance : NodeColor, k, v, RedBlackTree k v, RedBlackTree k v -> RedBlackTree k v
+balance = \color, key, value, left, right ->
+    when right is
+        Node Red rK rV rLeft rRight ->
+            when left is
+                Node Red lK lV lLeft lRight ->
+                    Node
+                        Red
+                        key
+                        value
+                        (Node Black lK lV lLeft lRight)
+                        (Node Black rK rV rLeft rRight)
+
+                _ ->
+                    Node color rK rV (Node Red key value left rLeft) rRight
+
+        _ ->
+            when left is
+                Node Red lK lV (Node Red llK llV llLeft llRight) lRight ->
+                    Node
+                        Red
+                        lK
+                        lV
+                        (Node Black llK llV llLeft llRight)
+                        (Node Black key value lRight right)
+
+                _ ->
+                    Node color key value left right

crates/cli_testing_examples/benchmarks/TestAStar.roc

@@ -0,0 +1,46 @@
+app "test-astar"
+    packages { pf: "platform/main.roc" }
+    imports [pf.Task, AStar]
+    provides [main] to pf
+
+main : Task.Task {} []
+main =
+    Task.putLine (showBool test1)
+
+#     Task.after Task.getInt \n ->
+#         when n is
+#             1 ->
+#                 Task.putLine (showBool test1)
+#
+#             _ ->
+#                 ns = Num.toStr n
+#                 Task.putLine "No test \(ns)"
+showBool : Bool -> Str
+showBool = \b ->
+    if
+        b
+    then
+        "True"
+    else
+        "False"
+
+test1 : Bool
+test1 =
+    example1 == [2, 4]
+
+example1 : List I64
+example1 =
+    step : I64 -> Set I64
+    step = \n ->
+        when n is
+            1 -> Set.fromList [2, 3]
+            2 -> Set.fromList [4]
+            3 -> Set.fromList [4]
+            _ -> Set.fromList []
+
+    cost : I64, I64 -> F64
+    cost = \_, _ -> 1
+
+    when AStar.findPath cost step 1 4 is
+        Ok path -> path
+        Err _ -> []

crates/cli_testing_examples/benchmarks/TestBase64.roc

@@ -0,0 +1,18 @@
+app "test-base64"
+    packages { pf: "platform/main.roc" }
+    imports [pf.Task, Base64]
+    provides [main] to pf
+
+IO a : Task.Task a []
+
+main : IO {}
+main =
+    when Base64.fromBytes (Str.toUtf8 "Hello World") is
+        Err _ -> Task.putLine "sadness"
+        Ok encoded ->
+            Task.after
+                (Task.putLine (Str.concat "encoded: " encoded))
+                \_ ->
+                    when Base64.toStr encoded is
+                        Ok decoded -> Task.putLine (Str.concat "decoded: " decoded)
+                        Err _ -> Task.putLine "sadness"

crates/cli_testing_examples/benchmarks/platform/Effect.roc

@@ -0,0 +1,10 @@
+hosted Effect
+    exposes [Effect, after, map, always, forever, loop, putLine, putInt, getInt]
+    imports []
+    generates Effect with [after, map, always, forever, loop]
+
+putLine : Str -> Effect {}
+
+putInt : I64 -> Effect {}
+
+getInt : Effect { value : I64, isError : Bool }

crates/cli_testing_examples/benchmarks/platform/Task.roc

@@ -0,0 +1,78 @@
+interface Task
+    exposes [Task, succeed, fail, after, map, putLine, putInt, getInt, forever, loop]
+    imports [pf.Effect]
+
+Task ok err : Effect.Effect (Result ok err)
+
+forever : Task val err -> Task * err
+forever = \task ->
+    looper = \{} ->
+        task
+        |> Effect.map
+            \res ->
+                when res is
+                    Ok _ -> Step {}
+                    Err e -> Done (Err e)
+
+    Effect.loop {} looper
+
+loop : state, (state -> Task [Step state, Done done] err) -> Task done err
+loop = \state, step ->
+    looper = \current ->
+        step current
+        |> Effect.map
+            \res ->
+                when res is
+                    Ok (Step newState) -> Step newState
+                    Ok (Done result) -> Done (Ok result)
+                    Err e -> Done (Err e)
+
+    Effect.loop state looper
+
+succeed : val -> Task val *
+succeed = \val ->
+    Effect.always (Ok val)
+
+fail : err -> Task * err
+fail = \val ->
+    Effect.always (Err val)
+
+after : Task a err, (a -> Task b err) -> Task b err
+after = \effect, transform ->
+    Effect.after
+        effect
+        \result ->
+            when result is
+                Ok a -> transform a
+                Err err -> Task.fail err
+
+map : Task a err, (a -> b) -> Task b err
+map = \effect, transform ->
+    Effect.map
+        effect
+        \result ->
+            when result is
+                Ok a -> Ok (transform a)
+                Err err -> Err err
+
+putLine : Str -> Task {} *
+putLine = \line -> Effect.map (Effect.putLine line) (\_ -> Ok {})
+
+putInt : I64 -> Task {} *
+putInt = \line -> Effect.map (Effect.putInt line) (\_ -> Ok {})
+
+getInt : Task I64 []
+getInt =
+    Effect.after
+        Effect.getInt
+        \{ isError, value } ->
+            if
+                isError
+            then
+                # when errorCode is
+                #    # A -> Task.fail InvalidCharacter
+                #    # B -> Task.fail IOError
+                #    _ ->
+                Task.succeed -1
+            else
+                Task.succeed value

crates/cli_testing_examples/benchmarks/platform/host.zig

@@ -0,0 +1,217 @@
+const std = @import("std");
+const str = @import("str");
+const RocStr = str.RocStr;
+const testing = std.testing;
+const expectEqual = testing.expectEqual;
+const expect = testing.expect;
+const maxInt = std.math.maxInt;
+
+comptime {
+    // This is a workaround for https://github.com/ziglang/zig/issues/8218
+    // which is only necessary on macOS.
+    //
+    // Once that issue is fixed, we can undo the changes in
+    // 177cf12e0555147faa4d436e52fc15175c2c4ff0 and go back to passing
+    // -fcompiler-rt in link.rs instead of doing this. Note that this
+    // workaround is present in many host.zig files, so make sure to undo
+    // it everywhere!
+    const builtin = @import("builtin");
+    if (builtin.os.tag == .macos) {
+        _ = @import("compiler_rt");
+    }
+}
+
+const mem = std.mem;
+const Allocator = mem.Allocator;
+
+extern fn roc__mainForHost_1_exposed_generic([*]u8) void;
+extern fn roc__mainForHost_size() i64;
+extern fn roc__mainForHost_1__Fx_caller(*const u8, [*]u8, [*]u8) void;
+extern fn roc__mainForHost_1__Fx_size() i64;
+extern fn roc__mainForHost_1__Fx_result_size() i64;
+
+const Align = 2 * @alignOf(usize);
+extern fn malloc(size: usize) callconv(.C) ?*align(Align) anyopaque;
+extern fn realloc(c_ptr: [*]align(Align) u8, size: usize) callconv(.C) ?*anyopaque;
+extern fn free(c_ptr: [*]align(Align) u8) callconv(.C) void;
+extern fn memcpy(dst: [*]u8, src: [*]u8, size: usize) callconv(.C) void;
+extern fn memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void;
+
+const DEBUG: bool = false;
+
+export fn roc_alloc(size: usize, alignment: u32) callconv(.C) ?*anyopaque {
+    if (DEBUG) {
+        var ptr = malloc(size);
+        const stdout = std.io.getStdOut().writer();
+        stdout.print("alloc:   {d} (alignment {d}, size {d})\n", .{ ptr, alignment, size }) catch unreachable;
+        return ptr;
+    } else {
+        return malloc(size);
+    }
+}
+
+export fn roc_realloc(c_ptr: *anyopaque, new_size: usize, old_size: usize, alignment: u32) callconv(.C) ?*anyopaque {
+    if (DEBUG) {
+        const stdout = std.io.getStdOut().writer();
+        stdout.print("realloc: {d} (alignment {d}, old_size {d})\n", .{ c_ptr, alignment, old_size }) catch unreachable;
+    }
+
+    return realloc(@alignCast(Align, @ptrCast([*]u8, c_ptr)), new_size);
+}
+
+export fn roc_dealloc(c_ptr: *anyopaque, alignment: u32) callconv(.C) void {
+    if (DEBUG) {
+        const stdout = std.io.getStdOut().writer();
+        stdout.print("dealloc: {d} (alignment {d})\n", .{ c_ptr, alignment }) catch unreachable;
+    }
+
+    free(@alignCast(Align, @ptrCast([*]u8, c_ptr)));
+}
+
+export fn roc_panic(c_ptr: *anyopaque, tag_id: u32) callconv(.C) void {
+    _ = tag_id;
+
+    const stderr = std.io.getStdErr().writer();
+    const msg = @ptrCast([*:0]const u8, c_ptr);
+    stderr.print("Application crashed with message\n\n    {s}\n\nShutting down\n", .{msg}) catch unreachable;
+    std.process.exit(0);
+}
+
+export fn roc_memcpy(dst: [*]u8, src: [*]u8, size: usize) callconv(.C) void {
+    return memcpy(dst, src, size);
+}
+
+export fn roc_memset(dst: [*]u8, value: i32, size: usize) callconv(.C) void {
+    return memset(dst, value, size);
+}
+
+const Unit = extern struct {};
+
+pub fn main() !u8 {
+    const stderr = std.io.getStdErr().writer();
+
+    // The size might be zero; if so, make it at least 8 so that we don't have a nullptr
+    const size = std.math.max(@intCast(usize, roc__mainForHost_size()), 8);
+    const raw_output = roc_alloc(@intCast(usize, size), @alignOf(u64)).?;
+    var output = @ptrCast([*]u8, raw_output);
+
+    defer {
+        roc_dealloc(raw_output, @alignOf(u64));
+    }
+
+    var timer = std.time.Timer.start() catch unreachable;
+
+    roc__mainForHost_1_exposed_generic(output);
+
+    const closure_data_pointer = @ptrCast([*]u8, output);
+
+    call_the_closure(closure_data_pointer);
+
+    const nanos = timer.read();
+    const seconds = (@intToFloat(f64, nanos) / 1_000_000_000.0);
+
+    stderr.print("runtime: {d:.3}ms\n", .{seconds * 1000}) catch unreachable;
+
+    return 0;
+}
+
+fn to_seconds(tms: std.os.timespec) f64 {
+    return @intToFloat(f64, tms.tv_sec) + (@intToFloat(f64, tms.tv_nsec) / 1_000_000_000.0);
+}
+
+fn call_the_closure(closure_data_pointer: [*]u8) void {
+    const allocator = std.heap.page_allocator;
+
+    // The size might be zero; if so, make it at least 8 so that we don't have a nullptr
+    const size = std.math.max(roc__mainForHost_1__Fx_result_size(), 8);
+    const raw_output = allocator.allocAdvanced(u8, @alignOf(u64), @intCast(usize, size), .at_least) catch unreachable;
+    var output = @ptrCast([*]u8, raw_output);
+
+    defer {
+        allocator.free(raw_output);
+    }
+
+    const flags: u8 = 0;
+
+    roc__mainForHost_1__Fx_caller(&flags, closure_data_pointer, output);
+
+    // The closure returns result, nothing interesting to do with it
+    return;
+}
+
+pub export fn roc_fx_putInt(int: i64) i64 {
+    const stdout = std.io.getStdOut().writer();
+
+    stdout.print("{d}", .{int}) catch unreachable;
+
+    stdout.print("\n", .{}) catch unreachable;
+
+    return 0;
+}
+
+export fn roc_fx_putLine(rocPath: *str.RocStr) callconv(.C) void {
+    const stdout = std.io.getStdOut().writer();
+
+    for (rocPath.asSlice()) |char| {
+        stdout.print("{c}", .{char}) catch unreachable;
+    }
+
+    stdout.print("\n", .{}) catch unreachable;
+}
+
+const GetInt = extern struct {
+    value: i64,
+    is_error: bool,
+};
+
+comptime {
+    if (@sizeOf(usize) == 8) {
+        @export(roc_fx_getInt_64bit, .{ .name = "roc_fx_getInt" });
+    } else {
+        @export(roc_fx_getInt_32bit, .{ .name = "roc_fx_getInt" });
+    }
+}
+
+fn roc_fx_getInt_64bit() callconv(.C) GetInt {
+    if (roc_fx_getInt_help()) |value| {
+        const get_int = GetInt{ .is_error = false, .value = value };
+        return get_int;
+    } else |err| switch (err) {
+        error.InvalidCharacter => {
+            return GetInt{ .is_error = true, .value = 0 };
+        },
+        else => {
+            return GetInt{ .is_error = true, .value = 0 };
+        },
+    }
+
+    return 0;
+}
+
+fn roc_fx_getInt_32bit(output: *GetInt) callconv(.C) void {
+    if (roc_fx_getInt_help()) |value| {
+        const get_int = GetInt{ .is_error = false, .value = value, .error_code = false };
+        output.* = get_int;
+    } else |err| switch (err) {
+        error.InvalidCharacter => {
+            output.* = GetInt{ .is_error = true, .value = 0, .error_code = false };
+        },
+        else => {
+            output.* = GetInt{ .is_error = true, .value = 0, .error_code = true };
+        },
+    }
+
+    return;
+}
+
+fn roc_fx_getInt_help() !i64 {
+    const stdout = std.io.getStdOut().writer();
+    stdout.print("Please enter an integer\n", .{}) catch unreachable;
+
+    const stdin = std.io.getStdIn().reader();
+    var buf: [40]u8 = undefined;
+
+    const line: []u8 = (try stdin.readUntilDelimiterOrEof(&buf, '\n')) orelse "";
+
+    return std.fmt.parseInt(i64, line, 10);
+}

crates/cli_testing_examples/benchmarks/platform/main.roc

@@ -0,0 +1,9 @@
+platform "benchmarks"
+    requires {} { main : Task {} [] }
+    exposes []
+    packages {}
+    imports [Task.{ Task }]
+    provides [mainForHost]
+
+mainForHost : Task {} [] as Fx
+mainForHost = main