-
Notifications
You must be signed in to change notification settings - Fork 1
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
5db6e90
commit 1026445
Showing
7 changed files
with
177 additions
and
8 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,61 @@ | ||
module AnotherBadClosure exposing (anotherBadClosureTest) | ||
|
||
-- From https://github.com/elm/compiler/issues/1813#issuecomment-535417649 | ||
|
||
import Test exposing (Test, test) | ||
import Expect | ||
|
||
|
||
{-| This is a tail-recursive function. | ||
It adds upwards counting integers starting from 0 to the given list: | ||
fDirect 4 [ 0 ] == [ 0, 1, 2, 3, 4, 0 ] | ||
-} | ||
fDirect : Int -> List Int -> List Int | ||
fDirect count accum = | ||
if count < 0 then | ||
accum | ||
|
||
else | ||
fDirect (count - 1) (count :: accum) | ||
|
||
|
||
{-| This is a slight variation of f and also tail-recursive. | ||
If we add a closure around the reference of "count", one of | ||
the arguments that tail-call optimization transforms into a variable, | ||
then we get incorrect values. | ||
List.map ((|>) ()) (f 4 [ \() -> 0 ]) == [ -1, -1, -1, -1, -1, 0 ] | ||
-} | ||
f : Int -> List (() -> Int) -> List (() -> Int) | ||
f count accum = | ||
if count < 0 then | ||
accum | ||
|
||
else | ||
f (count - 1) ((\() -> count) :: accum) | ||
|
||
|
||
{-| results in [-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1] | ||
We apply `()` on all functions in the generated list, to collapse the closures. | ||
-} | ||
bug : List Int | ||
bug = | ||
List.map ((|>) ()) (f 10 []) | ||
|
||
|
||
{-| results in [0,1,2,3,4,5,6,7,8,9,10] | ||
-} | ||
nobug : List Int | ||
nobug = | ||
fDirect 10 [] | ||
|
||
|
||
anotherBadClosureTest = test "Running a TCO version with closures that capture function arguments should equal running a TCO version without closures" <| | ||
\_ -> bug |> Expect.equal nobug |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,15 @@ | ||
module TCOMiscompilation0 exposing (tcoMiscompilation0Test) | ||
|
||
-- From https://github.com/elm/compiler/issues/2221#issue-972780518 | ||
|
||
import Test exposing (Test, test) | ||
import Expect | ||
|
||
g : Int -> (Int -> a) -> a | ||
g value cont = | ||
case value of | ||
1 -> cont 1 | ||
_ -> g (value-1) (\result -> cont (result * value)) | ||
|
||
tcoMiscompilation0Test = test "TCO shouldn't result in a stack overflow for CPS" <| | ||
\_ -> g 2 identity |> Expect.equal (g 2 identity) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,55 @@ | ||
module TCOMiscompilation1 exposing (tcoMiscompilation1Test) | ||
|
||
-- https://github.com/elm/compiler/issues/2268#issuecomment-1671931317 | ||
|
||
import Test exposing (Test, test) | ||
import Expect | ||
|
||
type Trampoline a | ||
= More (() -> Trampoline a) | ||
| Done a | ||
|
||
|
||
wrapMany : Int -> Trampoline a -> Trampoline a | ||
wrapMany n trampoline = | ||
if n > 0 then | ||
wrapMany (n - 1) (More (\_ -> trampoline)) | ||
|
||
else | ||
trampoline | ||
|
||
|
||
run : Trampoline a -> a | ||
run trampoline = | ||
case trampoline of | ||
More next -> | ||
run (next ()) | ||
|
||
Done a -> | ||
a | ||
|
||
wrapManyNoBug : Int -> Trampoline a -> Trampoline a | ||
wrapManyNoBug n trampoline = | ||
if n > 0 then | ||
wrapManyNoBug (n - 1) (more trampoline) | ||
|
||
else | ||
trampoline | ||
|
||
|
||
more : Trampoline a -> Trampoline a | ||
more a = | ||
More (\_ -> a) | ||
|
||
trampolinedValue = More(\_ -> (More (\_ -> Done 0))) | ||
|
||
-- This should cause hanging in vanilla Elm | ||
buggyExample = run (wrapMany 2 trampolinedValue) | ||
|
||
|
||
-- This shouldn't hang in vanilla Elm | ||
goodExample = run (wrapManyNoBug 2 trampolinedValue) | ||
|
||
|
||
tcoMiscompilation1Test = test "TCO shouldn't result in a stack overflow for trampolines" <| | ||
\_ -> buggyExample |> Expect.equal goodExample |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,11 @@ | ||
module TCOMiscompilation2 exposing (tcoMiscompilation2Test) | ||
|
||
-- From https://github.com/elm/compiler/issues/1813#issue-365193260 | ||
|
||
import Test exposing (Test, test) | ||
import Expect | ||
|
||
testcase = let loop n list = if n <= 0 then list else loop (n - 1) ((\() -> n) :: list) in List.map (\f -> f()) <| loop 3 [] | ||
|
||
tcoMiscompilation2Test = test "TCO not just repeat the same value over and over again when given a trivial loop" <| | ||
\_ -> testcase |> Expect.equal [1, 2, 3] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,20 @@ | ||
module Tests exposing (..) | ||
|
||
import Test exposing (Test, describe) | ||
import AnotherBadClosure exposing (anotherBadClosureTest) | ||
import TCOProducesBadClosures exposing (tcoProducesBadClosuresTest) | ||
import TCOMiscompilation0 exposing (tcoMiscompilation0Test) | ||
-- This causes hanging in vanilla Elm, uncomment once I have a way of failing a test after it runs for too long | ||
-- import TCOMiscompilation1 exposing (tcoMiscompilation1Test) | ||
import TCOMiscompilation2 exposing (tcoMiscompilation2Test) | ||
|
||
|
||
suite : Test | ||
suite = describe "TCO tests" | ||
[ anotherBadClosureTest | ||
, tcoProducesBadClosuresTest | ||
, tcoMiscompilation0Test | ||
-- This causes hanging in vanilla Elm, uncomment once I have a way of failing a test after it runs for too long | ||
-- , tcoMiscompilation1Test | ||
, tcoMiscompilation2Test | ||
] |