From 943e78d112cea1abc7f42e2c0e7968023eebeddc Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Sun, 13 Jan 2019 05:01:19 +0000 Subject: [PATCH 1/2] Make sure default impls for BoundedEnum are TCO'd 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 https://github.com/purescript/purescript/pull/3439#issuecomment-429154429 --- src/Data/Enum.purs | 30 ++++++++++++++++++++-------- test/Test/Data/Enum.purs | 43 +++++++++++++++++++++++++++++++++++++++- 2 files changed, 64 insertions(+), 9 deletions(-) diff --git a/src/Data/Enum.purs b/src/Data/Enum.purs index 7375e47..0bb9287 100644 --- a/src/Data/Enum.purs +++ b/src/Data/Enum.purs @@ -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`. -- | @@ -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`. -- | @@ -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 diff --git a/test/Test/Data/Enum.purs b/test/Test/Data/Enum.purs index 0b77e3c..1386573 100644 --- a/test/Test/Data/Enum.purs +++ b/test/Test/Data/Enum.purs @@ -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) @@ -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 10,000. Why 10,000? It's just about large enough that we'll most +-- | likely see stack overflow errors if we've managed to break TCO. +newtype Upto10k = Upto10k Int + +derive newtype instance eqUpto10k :: Eq Upto10k +derive newtype instance ordUpto10k :: Ord Upto10k +derive newtype instance showUpto10k :: Show Upto10k + +instance boundedUpto10k :: Bounded Upto10k where + top = Upto10k 10000 + bottom = Upto10k 0 + +instance enumUpto10k :: Enum Upto10k where + succ (Upto10k x) = if (x+1) > 10000 then Nothing else Just (Upto10k (x+1)) + pred (Upto10k x) = if (x-1) < 0 then Nothing else Just (Upto10k (x-1)) + +instance boundedEnumUpto10k :: BoundedEnum Upto10k where + cardinality = defaultCardinality + toEnum = defaultToEnum + fromEnum = defaultFromEnum + testEnum :: Effect Unit testEnum = do log "enumFromTo" @@ -153,3 +176,21 @@ testEnum = do { actual: downFromIncluding A , expected: [A] } + + log "defaultCardinality is stack safe" + assertEqual + { actual: unwrap (defaultCardinality :: Cardinality Upto10k) + , expected: 10001 + } + + log "defaultToEnum is stack safe" + assertEqual + { actual: defaultToEnum 10000 + , expected: Just (Upto10k 10000) + } + + log "defaultFromEnum is stack safe" + assertEqual + { actual: defaultFromEnum (Upto10k 10000) + , expected: 10000 + } From fa8d6531baf6aee8666339399f0d373adbad30fe Mon Sep 17 00:00:00 2001 From: Harry Garrood Date: Wed, 30 Jan 2019 23:55:36 +0000 Subject: [PATCH 2/2] Increase the number of iterations to check stack-safety --- test/Test/Data/Enum.purs | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/test/Test/Data/Enum.purs b/test/Test/Data/Enum.purs index 1386573..db2d5fb 100644 --- a/test/Test/Data/Enum.purs +++ b/test/Test/Data/Enum.purs @@ -46,23 +46,23 @@ instance boundedEnumT :: BoundedEnum T where fromEnum = defaultFromEnum -- | A newtype over Int which is supposed to represent Ints bounded between 0 --- | and 10,000. Why 10,000? It's just about large enough that we'll most --- | likely see stack overflow errors if we've managed to break TCO. -newtype Upto10k = Upto10k Int +-- | 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 eqUpto10k :: Eq Upto10k -derive newtype instance ordUpto10k :: Ord Upto10k -derive newtype instance showUpto10k :: Show Upto10k +derive newtype instance eqUpto100k :: Eq Upto100k +derive newtype instance ordUpto100k :: Ord Upto100k +derive newtype instance showUpto100k :: Show Upto100k -instance boundedUpto10k :: Bounded Upto10k where - top = Upto10k 10000 - bottom = Upto10k 0 +instance boundedUpto100k :: Bounded Upto100k where + top = Upto100k 100000 + bottom = Upto100k 0 -instance enumUpto10k :: Enum Upto10k where - succ (Upto10k x) = if (x+1) > 10000 then Nothing else Just (Upto10k (x+1)) - pred (Upto10k x) = if (x-1) < 0 then Nothing else Just (Upto10k (x-1)) +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 boundedEnumUpto10k :: BoundedEnum Upto10k where +instance boundedEnumUpto100k :: BoundedEnum Upto100k where cardinality = defaultCardinality toEnum = defaultToEnum fromEnum = defaultFromEnum @@ -179,18 +179,18 @@ testEnum = do log "defaultCardinality is stack safe" assertEqual - { actual: unwrap (defaultCardinality :: Cardinality Upto10k) - , expected: 10001 + { actual: unwrap (defaultCardinality :: Cardinality Upto100k) + , expected: 100001 } log "defaultToEnum is stack safe" assertEqual - { actual: defaultToEnum 10000 - , expected: Just (Upto10k 10000) + { actual: defaultToEnum 100000 + , expected: Just (Upto100k 100000) } log "defaultFromEnum is stack safe" assertEqual - { actual: defaultFromEnum (Upto10k 10000) - , expected: 10000 + { actual: defaultFromEnum (Upto100k 100000) + , expected: 100000 }