September Morn Update

Task/Y-combinator/Haskell/y-combinator-1.hs

@@ -6,22 +6,41 @@ fix = g <*> (Roll . g)
   where
     g = (. (>>= id) unroll)
 
+- this version is not in tail call position...
+-- fac :: Integer -> Integer
+-- fac =
+--   fix $ \f n -> if n <= 0 then 1 else n * f (n - 1)
+
+-- this version builds a progression from tail call position and is more efficient...
 fac :: Integer -> Integer
 fac =
-  fix $
-  \f n ->
-     (if n <= 0
-        then 1
-        else n * f (n - 1))
+  (fix $ \f n i -> if i <= 0 then n else f (i * n) (i - 1)) 1
 
-fibs :: [Integer]
-fibs =
-  fix $ (0 :) . (1 :) . (fix (\f (x:xs) (y:ys) -> x + y : f xs ys) <*> tail)
+-- make fibs a function, else memory leak as
+-- head of the list can never be released as per:
+--   https://wiki.haskell.org/Memory_leak, type 1.1
+-- overly complex version...
+{--
+fibs :: () -> [Integer]
+fibs() =
+  fix $
+    (0 :) . (1 :) .
+      (fix
+        (\f (x:xs) (y:ys) ->
+          case x + y of n -> n `seq` n : f xs ys) <*> tail)
+--}
+
+-- easier to read, simpler (faster) version...
+fibs :: () -> [Integer]
+fibs() = 0 : 1 : fix fibs_ 0 1
+  where
+    fibs_ fnc f s =
+      case f + s of n -> n `seq` n : fnc s n
 
 main :: IO ()
 main =
   mapM_
     print
     [ map fac [1 .. 20]
-    , take 20 fibs
+    , take 20 $ fibs()
     ]

Task/Y-combinator/Haskell/y-combinator-2.hs

@@ -1,36 +1,48 @@
+-- note that this version of fix uses function recursion in its own definition;
+-- thus its use just means that the recursion has been "pulled" into the "fix" function,
+-- instead of the function that uses it...
 fix :: (a -> a) -> a
 fix f = f (fix f) -- _not_ the {fix f = x where x = f x}
 
 fac :: Integer -> Integer
-fac_ f n
-  | n <= 0 = 1
-  | otherwise = n * f (n - 1)
+fac =
+  (fix $
+    \f n i ->
+      if i <= 0 then n
+      else f (i * n) (i - 1)) 1
 
-fac = fix fac_ -- fac_ (fac_ . fac_ . fac_ . fac_ . ...)
-
--- a simple but wasteful exponential time definition:
 fib :: Integer -> Integer
-fib_ f 0 = 0
-fib_ f 1 = 1
-fib_ f n = f (n - 1) + f (n - 2)
+fib =
+  (fix $
+    \fnc f s i ->
+      if i <= 1 then f
+      else case f + s of n -> n `seq` fnc s n (i - 1)) 0 1
 
-fib = fix fib_
-
--- Or for far more efficiency, compute a lazy infinite list. This is
--- a Y-combinator version of: fibs = 0:1:zipWith (+) fibs (tail fibs)
-fibs :: [Integer]
-fibs_ a = 0 : 1 : fix zipP a (tail a)
+{--
+-- compute a lazy infinite list. This is
+-- a Y-combinator version of: fibs() = 0:1:zipWith (+) fibs (tail fibs)
+-- which is the same as the above version but easier to read...
+fibs :: () -> [Integer]
+fibs() = fix fibs_
   where
-    zipP f (x:xs) (y:ys) = x + y : f xs ys
+    zipP f (x:xs) (y:ys) =
+      case x + y of n -> n `seq` n : f xs ys
+    fibs_ a = 0 : 1 : fix zipP a (tail a)
+--}
 
-fibs = fix fibs_
+-- easier to read, simpler (faster) version...
+fibs :: () -> [Integer]
+fibs() = 0 : 1 : fix fibs_ 0 1
+  where
+    fibs_ fnc f s =
+      case f + s of n -> n `seq` n : fnc s n
 
 -- This code shows how the functions can be used:
-main : IO ()
+main :: IO ()
 main =
   mapM_
     print
     [ map fac [1 .. 20]
-    , map fib [0 .. 19]
-    , take 20 fibs
+    , map fib [1 .. 20]
+    , take 20 fibs()
     ]