Merge pull request #5300 from roc-lang/benchmark_segfault

improve benchmark error handling, bugfixes

crates/cli_testing_examples/benchmarks/CFold.roc

@@ -6,9 +6,10 @@ app "cfold"
 # adapted from https://github.com/koka-lang/koka/blob/master/test/bench/haskell/cfold.hs
 main : Task.Task {} []
 main =
-    Task.after
-        Task.getInt
-        \n ->
+    inputResult <- Task.attempt Task.getInt
+
+    when inputResult is
+        Ok 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))
@@ -19,6 +20,9 @@ main =
             |> Str.concat (Num.toStr optimized)
             |> Task.putLine
 
+        Err GetIntError ->
+            Task.putLine "Error: Failed to get Integer from stdin."      
+
 Expr : [
     Add Expr Expr,
     Mul Expr Expr,

crates/cli_testing_examples/benchmarks/Deriv.roc

@@ -8,9 +8,10 @@ IO a : Task.Task a []
 
 main : Task.Task {} []
 main =
-    Task.after
-        Task.getInt
-        \n ->
+    inputResult <- Task.attempt Task.getInt
+
+    when inputResult is
+        Ok n ->
             x : Expr
             x = Var "x"
 
@@ -20,6 +21,10 @@ main =
             nest deriv n f # original koka n = 10
             |> Task.map \_ -> {}
 
+        Err GetIntError ->
+            Task.putLine "Error: Failed to get Integer from stdin."
+            
+
 nest : (I64, Expr -> IO Expr), I64, Expr -> IO Expr
 nest = \f, n, e -> Task.loop { s: n, f, m: n, x: e } nestHelp
 

crates/cli_testing_examples/benchmarks/NQueens.roc

@@ -5,32 +5,31 @@ app "nqueens"
 
 main : Task.Task {} []
 main =
-    Task.after
-        Task.getInt
-        \n ->
+    inputResult <- Task.attempt Task.getInt
+
+    when inputResult is
+        Ok n ->
             queens n # original koka 13
-            |> Num.toStr
-            |> Task.putLine
+                |> Num.toStr
+                |> Task.putLine
+
+        Err GetIntError ->
+            Task.putLine "Error: Failed to get Integer from stdin."
 
 ConsList a : [Nil, Cons a (ConsList a)]
 
 queens = \n -> length (findSolutions n n)
 
-length : ConsList a -> I64
-length = \xs -> lengthHelp xs 0
+findSolutions = \n, k ->
+    if k <= 0 then # should we use U64 as input type here instead?
+        Cons Nil Nil
+    else
+        extend n Nil (findSolutions n (k - 1))
 
-lengthHelp : ConsList a, I64 -> I64
-lengthHelp = \foobar, acc ->
-    when foobar is
-        Cons _ lrest -> lengthHelp lrest (1 + acc)
+extend = \n, acc, solutions ->
+    when solutions is
         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
+        Cons soln rest -> extend n (appendSafe n soln acc) rest
 
 appendSafe : I64, ConsList I64, ConsList (ConsList I64) -> ConsList (ConsList I64)
 appendSafe = \k, soln, solns ->
@@ -41,13 +40,22 @@ appendSafe = \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))
+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
+
+
+length : ConsList a -> I64
+length = \xs ->
+    dbg "length"
+    lengthHelp xs 0
+
+lengthHelp : ConsList a, I64 -> I64
+lengthHelp = \foobar, acc ->
+    when foobar is
+        Cons _ lrest -> lengthHelp lrest (1 + acc)
+        Nil -> acc

crates/cli_testing_examples/benchmarks/QuicksortApp.roc

@@ -5,9 +5,10 @@ app "quicksortapp"
 
 main : Task.Task {} []
 main =
-    Task.after
-        Task.getInt
-        \n ->
+    inputResult <- Task.attempt Task.getInt
+
+    when inputResult is
+        Ok n ->
             unsortedList =
                 if n == 0 then
                     # small unsorted list of 20 elements (0-9)
@@ -20,6 +21,10 @@ main =
             |> Quicksort.show
             |> Task.putLine
 
+        Err GetIntError ->
+            Task.putLine "Error: Failed to get Integer from stdin."
+            
+
 sort : List I64 -> List I64
 sort = \list ->
     Quicksort.sortWith list (\x, y -> Num.compare x y)

crates/cli_testing_examples/benchmarks/RBTreeCk.roc

@@ -40,9 +40,10 @@ fold = \f, tree, b ->
 
 main : Task.Task {} []
 main =
-    Task.after
-        Task.getInt
-        \n ->
+    inputResult <- Task.attempt Task.getInt
+
+    when inputResult is
+        Ok n ->
             # original koka n = 4_200_000
             ms : ConsList Map
             ms = makeMap 5 n
@@ -58,6 +59,9 @@ main =
                 Nil ->
                     Task.putLine "fail"
 
+        Err GetIntError ->
+            Task.putLine "Error: Failed to get Integer from stdin."
+
 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
 

crates/cli_testing_examples/benchmarks/RBTreeDel.roc

@@ -13,9 +13,10 @@ ConsList a : [Nil, Cons a (ConsList a)]
 
 main : Task.Task {} []
 main =
-    Task.after
-        Task.getInt
-        \n ->
+    inputResult <- Task.attempt Task.getInt
+
+    when inputResult is
+        Ok n ->
             m = makeMap n # koka original n = 4_200_000
             val = fold (\_, v, r -> if v then r + 1 else r) m 0
 
@@ -23,6 +24,10 @@ main =
             |> Num.toStr
             |> Task.putLine
 
+        Err GetIntError ->
+            Task.putLine "Error: Failed to get Integer from stdin."
+            
+
 boom : Str -> a
 boom = \_ -> boom ""
 

crates/cli_testing_examples/benchmarks/platform/Task.roc

@@ -1,5 +1,5 @@
 interface Task
-    exposes [Task, succeed, fail, after, map, putLine, putInt, getInt, forever, loop]
+    exposes [Task, succeed, fail, after, map, putLine, putInt, getInt, forever, loop, attempt]
     imports [pf.Effect]
 
 Task ok err : Effect.Effect (Result ok err)
@@ -46,6 +46,15 @@ after = \effect, transform ->
                 Ok a -> transform a
                 Err err -> Task.fail err
 
+attempt : Task a b, (Result a b -> Task c d) -> Task c d
+attempt = \task, transform ->
+    Effect.after
+        task
+        \result ->
+            when result is
+                Ok ok -> transform (Ok ok)
+                Err err -> transform (Err err)
+
 map : Task a err, (a -> b) -> Task b err
 map = \effect, transform ->
     Effect.map
@@ -61,7 +70,7 @@ putLine = \line -> Effect.map (Effect.putLine line) (\_ -> Ok {})
 putInt : I64 -> Task {} *
 putInt = \line -> Effect.map (Effect.putInt line) (\_ -> Ok {})
 
-getInt : Task I64 []
+getInt : Task I64 [GetIntError]
 getInt =
     Effect.after
         Effect.getInt
@@ -69,10 +78,11 @@ getInt =
             if
                 isError
             then
+                # TODO
                 # when errorCode is
                 #    # A -> Task.fail InvalidCharacter
                 #    # B -> Task.fail IOError
                 #    _ ->
-                Task.succeed -1
+                Task.fail GetIntError
             else
                 Task.succeed value