In strict functional programming and the lambda calculus, functions (lambda expressions) don't have state and are only allowed to refer to arguments of enclosing functions.

This rules out the usual definition of a recursive function wherein a function is associated with the state of a variable and this variable's state is used in the body of the function.

The   Y combinator   is itself a stateless function that, when applied to another stateless function, returns a recursive version of the function.

The Y combinator is the simplest of the class of such functions, called fixed-point combinators.



Task

Define the stateless   Y combinator   and use it to compute factorials and Fibonacci numbers from other stateless functions or lambda expressions.



Cf

 Jim Weirich: Adventures in Functional Programming


module Main exposing ( main )
 
import Html exposing ( Html, text )
 
-- As with most of the strict (non-deferred or non-lazy) languages,
-- this is the Z-combinator with the additional value parameter...
 
-- wrap type conversion to avoid recursive type definition...
type Mu a b = Roll (Mu a b -> a -> b)
 
unroll : Mu a b -> (Mu a b -> a -> b) -- unwrap it...
unroll (Roll x) = x
 
-- note lack of beta reduction using values...
fixz : ((a -> b) -> (a -> b)) -> (a -> b)
fixz f = let g r = f (\ v -> unroll r r v) in g (Roll g)
 
facz : Int -> Int
-- facz = fixz <| \ f n -> if n < 2 then 1 else n * f (n - 1) -- inefficient recursion
facz = fixz (\ f n i -> if i < 2 then n else f (i * n) (i - 1)) 1 -- efficient tailcall
 
fibz : Int -> Int
-- fibz = fixz <| \ f n -> if n < 2 then n else f (n - 1) + f (n - 2) -- inefficient recursion
fibz = fixz (\ fn f s i -> if i < 2 then f else fn s (f + s) (i - 1)) 1 1 -- efficient tailcall
 
-- by injecting laziness, we can get the true Y-combinator...
-- as this includes laziness, there is no need for the type wrapper!
fixy : ((() -> a) -> a) -> a
fixy f = f <| \ () -> fixy f -- direct function recursion
-- the above is not value recursion but function recursion!
-- fixv f = let x = f x in x -- not allowed by task or by Elm!
-- we can make Elm allow it by injecting laziness...
-- fixv f = let x = f () x in x -- but now value recursion not function recursion
 
facy : Int -> Int
-- facy = fixy <| \ f n -> if n < 2 then 1 else n * f () (n - 1) -- inefficient recursion
facy = fixy (\ f n i -> if i < 2 then n else f () (i * n) (i - 1)) 1 -- efficient tailcall
 
fiby : Int -> Int
-- fiby = fixy <| \ f n -> if n < 2 then n else f () (n - 1) + f (n - 2) -- inefficient recursion
fiby = fixy (\ fn f s i -> if i < 2 then f else fn () s (f + s) (i - 1)) 1 1 -- efficient tailcall
 
-- something that can be done with a true Y-Combinator that
-- can't be done with the Z combinator...
-- given an infinite Co-Inductive Stream (CIS) defined as...
type CIS a = CIS a (() -> CIS a) -- infinite lazy stream!
 
mapCIS : (a -> b) -> CIS a -> CIS b -- uses function to map
mapCIS cf cis =
  let mp (CIS head restf) = CIS (cf head) <| \ () -> mp (restf()) in mp cis
 
-- now we can define a Fibonacci stream as follows...
fibs : () -> CIS Int
fibs() = -- two recursive fix's, second already lazy...
  let fibsgen = fixy (\ fn (CIS (f, s) restf) ->
        CIS (s, f + s) (\ () -> fn () (restf())))
  in fixy (\ cisthnk -> fibsgen (CIS (0, 1) cisthnk))
       |> mapCIS (\ (v, _) -> v)
 
nCISs2String : Int -> CIS a -> String -- convert n CIS's to String
nCISs2String n cis =
  let loop i (CIS head restf) rslt =
        if i <= 0 then rslt ++ " )" else
        loop (i - 1) (restf()) (rslt ++ " " ++ Debug.toString head)
  in loop n cis "("
 
-- unfortunately, if we need CIS memoization so as
-- to make a true lazy list, Elm doesn't support it!!!
 
main : Html Never
main =
  String.fromInt (facz 10) ++ " " ++ String.fromInt (fibz 10)
    ++ " " ++ String.fromInt (facy 10) ++ " " ++ String.fromInt (fiby 10)
    ++ " " ++ nCISs2String 20 (fibs())
      |> text