Skip to content

Commit

Permalink
Make sure default impls for BoundedEnum are TCO'd (#37)
Browse files Browse the repository at this point in the history
The implementations for `defaultCardinality`, `defaultToEnum`, and
`defaultFromEnum` don't trigger tail-call optimization, which means that
they are quite a bit slower than they could be (and in some cases will
produce a stack overflow when they needn't).

This commit will also have the fortunate effect that this library won't
break if the compiler stops inlining function composition in the
(arguably broken) way that it does currently; see
purescript/purescript#3439 (comment)
  • Loading branch information
hdgarrood authored Jan 31, 2019
1 parent b244240 commit c22de83
Show file tree
Hide file tree
Showing 2 changed files with 64 additions and 9 deletions.
30 changes: 22 additions & 8 deletions src/Data/Enum.purs
Original file line number Diff line number Diff line change
Expand Up @@ -268,9 +268,11 @@ defaultPred toEnum' fromEnum' a = toEnum' (fromEnum' a - 1)
-- |
-- | Runs in `O(n)` where `n` is `fromEnum top`
defaultCardinality :: forall a. Bounded a => Enum a => Cardinality a
defaultCardinality = Cardinality $ defaultCardinality' 1 (bottom :: a)
where
defaultCardinality' i = maybe i (defaultCardinality' (i + 1)) <<< succ
defaultCardinality = Cardinality $ go 1 (bottom :: a) where
go i x =
case succ x of
Just x' -> go (i + 1) x'
Nothing -> i

-- | Provides a default implementation for `toEnum`.
-- |
Expand All @@ -279,10 +281,18 @@ defaultCardinality = Cardinality $ defaultCardinality' 1 (bottom :: a)
-- |
-- | Runs in `O(n)` where `n` is `fromEnum a`.
defaultToEnum :: forall a. Bounded a => Enum a => Int -> Maybe a
defaultToEnum n
| n < 0 = Nothing
| n == 0 = Just bottom
| otherwise = defaultToEnum (n - 1) >>= succ
defaultToEnum i' =
if i' < 0
then Nothing
else go i' bottom
where
go i x =
if i == 0
then Just x
-- We avoid using >>= here because it foils tail-call optimization
else case succ x of
Just x' -> go (i - 1) x'
Nothing -> Nothing

-- | Provides a default implementation for `fromEnum`.
-- |
Expand All @@ -291,7 +301,11 @@ defaultToEnum n
-- |
-- | Runs in `O(n)` where `n` is `fromEnum a`.
defaultFromEnum :: forall a. Enum a => a -> Int
defaultFromEnum = maybe 0 (\prd -> defaultFromEnum prd + 1) <<< pred
defaultFromEnum = go 0 where
go i x =
case pred x of
Just x' -> go (i + 1) x'
Nothing -> i

diag :: forall a. a -> Tuple a a
diag a = Tuple a a
Expand Down
43 changes: 42 additions & 1 deletion test/Test/Data/Enum.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,8 +2,9 @@ module Test.Data.Enum (testEnum) where

import Prelude

import Data.Enum (class BoundedEnum, class Enum, defaultCardinality, defaultFromEnum, defaultToEnum, downFrom, downFromIncluding, enumFromThenTo, enumFromTo, upFrom, upFromIncluding)
import Data.Enum (class BoundedEnum, class Enum, Cardinality, defaultCardinality, defaultFromEnum, defaultToEnum, downFrom, downFromIncluding, enumFromThenTo, enumFromTo, upFrom, upFromIncluding)
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.NonEmpty ((:|))
import Effect (Effect)
import Effect.Console (log)
Expand Down Expand Up @@ -44,6 +45,28 @@ instance boundedEnumT :: BoundedEnum T where
toEnum = defaultToEnum
fromEnum = defaultFromEnum

-- | A newtype over Int which is supposed to represent Ints bounded between 0
-- | and 100,000. Why 100,000? It seems to be large enough that we are very
-- | likely to see stack overflow errors if we've managed to break TCO.
newtype Upto100k = Upto100k Int

derive newtype instance eqUpto100k :: Eq Upto100k
derive newtype instance ordUpto100k :: Ord Upto100k
derive newtype instance showUpto100k :: Show Upto100k

instance boundedUpto100k :: Bounded Upto100k where
top = Upto100k 100000
bottom = Upto100k 0

instance enumUpto100k :: Enum Upto100k where
succ (Upto100k x) = if (x+1) > 100000 then Nothing else Just (Upto100k (x+1))
pred (Upto100k x) = if (x-1) < 0 then Nothing else Just (Upto100k (x-1))

instance boundedEnumUpto100k :: BoundedEnum Upto100k where
cardinality = defaultCardinality
toEnum = defaultToEnum
fromEnum = defaultFromEnum

testEnum :: Effect Unit
testEnum = do
log "enumFromTo"
Expand Down Expand Up @@ -153,3 +176,21 @@ testEnum = do
{ actual: downFromIncluding A
, expected: [A]
}

log "defaultCardinality is stack safe"
assertEqual
{ actual: unwrap (defaultCardinality :: Cardinality Upto100k)
, expected: 100001
}

log "defaultToEnum is stack safe"
assertEqual
{ actual: defaultToEnum 100000
, expected: Just (Upto100k 100000)
}

log "defaultFromEnum is stack safe"
assertEqual
{ actual: defaultFromEnum (Upto100k 100000)
, expected: 100000
}

0 comments on commit c22de83

Please sign in to comment.