unfold-foldl.hs

-- Compile with
-- ghc -Wall -O -fforce-recomp -ddump-simpl -dsuppress-all poly.hs
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Poly (value, ualue, xalue) where

import Data.Proxy (Proxy (..))

data N = Z | S N
type N5 = 'S ('S ('S ('S ('S 'Z))))
type N7 = 'S ('S N5)

type Bound = N5

-- Dictionary inlines better if it's single value. ¯\_(ツ)_/¯
class Foldl (n :: N) where
    left  :: proxy n -> (b -> a -> b) -> b -> [a] -> b

instance Foldl 'Z where
    left _ f z = go z where
        go !acc []       = acc
        go !acc (x : xs) = go (f acc x) xs

instance Foldl n => Foldl ('S n) where
    left _ _ z []       = z
    left _ f z (x : xs) = left (Proxy :: Proxy n) f (f z x) xs

foldl' :: forall a b. (b -> a -> b) -> b -> [a] -> b
foldl' = left (Proxy :: Proxy Bound)

-- | Core:
--
-- @
-- -- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-- value
-- value = I# 10#
-- @
--
value :: Int
value = foldl' (+) 0 [1,2,3,4]

-- This doesn't work out because 'enumFromTo' is recursive :(
ualue :: Int
ualue = foldl' (+) 0 [1..100]

-------------------------------------------------------------------------------
-- Second try
-------------------------------------------------------------------------------

class Unfoldr (n :: N) where
    unf :: proxy n -> (b -> Maybe (a, b)) -> b -> [a]

instance Unfoldr 'Z where
    unf _ f = go where
        go z = case f z of
            Nothing     -> []
            Just (a, b) -> a : go b
        

instance Unfoldr n => Unfoldr ('S n) where
    unf _ f z = case f z of
        Nothing     -> []
        Just (a, b) -> a : unf (Proxy :: Proxy n) f b

unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
unfoldr = unf (Proxy :: Proxy Bound)

-- | Core;
--
-- @
-- -- RHS size: {terms: 8, types: 1, coercions: 0, joins: 0/0}
-- xalue
-- xalue
--  = case $wgo2 15# ($wgo1 6#) of ww_s2ZA { __DEFAULT -> I# ww_s2ZA }
--
-- Rec {
-- -- RHS size: {terms: 22, types: 7, coercions: 0, joins: 0/0}
-- $wgo1
-- $wgo1
--   = \ ww_s2Zo ->
--       case tagToEnum# (># ww_s2Zo 100#) of {
--         False ->
--           : (I# ww_s2Zo)
--             (case ww_s2Zo of wild1_a2Ny {
--                __DEFAULT -> $wgo1 (+# wild1_a2Ny 1#);
--                9223372036854775807# -> case $fEnumInt2 of wild2_00 { }
--              });
--         True -> []
--       }
-- end Rec }
--
-- Rec {
-- -- RHS size: {terms: 15, types: 10, coercions: 0, joins: 0/0}
-- $wgo2
-- $wgo2
--   = \ ww_s2Zf w_s2Zc ->
--       case w_s2Zc of {
--         [] -> ww_s2Zf;
--         : x_aXn xs_aXo ->
--           case x_aXn of { I# y_X2NU -> $wgo2 (+# ww_s2Zf y_X2NU) xs_aXo }
--       }
-- end Rec }
-- @

xalue :: Int
xalue = foldl' (+) 0 (myEnumFromTo 1 100)

myEnumFromTo :: Enum a => a -> a -> [a]
myEnumFromTo x y = unfoldr f (fromEnum x) where
    y' = fromEnum y
    f z | z > y'     = Nothing
        | otherwise = Just (toEnum z, succ z)

-------------------------------------------------------------------------------
-- Bonus
-------------------------------------------------------------------------------

class Foldr (n :: N) where
    right :: proxy n -> (a -> b -> b) -> b -> [a] -> b 

instance Foldr 'Z where
    right _ f z = go where
        go [] = z
        go (x : xs) = f x (go xs)

instance Foldr n => Foldr ('S n) where
    right _ _ z []       = z
    right _ f z (x : xs) = f x (right (Proxy :: Proxy n) f z xs)

@nrolland yes, you read it exactly right. (Gists don't give me notifications, sorry for very late response)