Make sure default impls for BoundedEnum are TCO'd (#37)

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)

Author: hdgarrood

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

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 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"
@@ -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
+    }