mirror of
https://github.com/roc-lang/roc.git
synced 2024-09-22 16:30:04 +03:00
115 lines
2.7 KiB
Plaintext
115 lines
2.7 KiB
Plaintext
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
|