Why doesn't this lambda calculus reducer reduce succ 0 to 1? - haskell

data Term = Var Integer
| Apply Term Term
| Lambda Term
deriving (Eq, Show)
sub :: Term -> Integer -> Term -> Term
sub e v r = case e of
Var x -> if x == v then r else e
Apply m1 m2 -> Apply (sub m1 v r) (sub m2 v r)
Lambda t -> Lambda (sub t (v + 1) r)
beta :: Term -> Term
beta t = case t of
Apply (Lambda e) e' -> sub e 0 e'
otherwise -> t
eta :: Term -> Term
eta t = case t of
Lambda (Apply f (Var 0)) -> f
otherwise -> t
reduce :: Term -> Term
reduce t = if t == t'
then t
else reduce t'
where t' = beta . eta $ t
I tried:
let zero = Lambda $ Lambda $ Var 0
let succ = Lambda $ Lambda $ Lambda $ Apply (Var 1) $ (Apply (Apply (Var 2) (Var 1)) (Var 0))
reduce (Apply succ zero)
In GHCi, but it didn't seem to give me the expression for one (Lambda (Lambda (Apply (Var 1) (Var 0)) that I'm looking for. Instead it gives me:
Lambda (Lambda (Apply (Var 1) (Apply (Apply (Lambda (Lambda (Var 0))) (Var 1)) (Var 0))))
The variables are encoded not by name, but by how many lambdas you need to walk outwards to get the parameter.

Your reducer, in common with the way lambda calculus is normally evaluated, doesn't reduce inside Lambda terms - it only removes top-level redexes. The result it produces should be equivalent to one, in that if you apply both to the same arguments you will get the same result, but not syntactically identical.

Related

Capture-avoiding substitution function -- Lambda calculus

I am trying to write a function that performs capture-avoiding substitution in Lambda calculus. The code compiles but does not spit out the correct answer. I've written what I expect the code to do, is my comprehension correct?
For example, I should get the following output for this input (numeral 0 is the Church numeral 0)
*Main> substitute "b" (numeral 0) example -- \a. \x. ((\y. a) x) b
\c. \a. (\a. c) a (\f. \x. x)
-- The incorrect result I actually got
\c. \c. (\f. \x. x) (x (\b. a))
NB \y is renamed to \a due to the substitution (\y.a)[N/b] (I think I have this covered in the code I have written, but please let me know if I am wrong.)
import Data.Char
import Data.List
type Var = String
data Term =
Variable Var
| Lambda Var Term
| Apply Term Term
-- deriving Show
instance Show Term where
show = pretty
example :: Term -- \a. \x. ((\y. a) x) b
example = Lambda "a"
(Lambda "x" (Apply (Apply (Lambda "y" (Variable "a"))
(Variable "x"))
(Variable "b")))
pretty :: Term -> String
pretty = f 0
where
f i (Variable x) = x
f i (Lambda x m) = if i /= 0 then "(" ++ s ++ ")" else s
where s = "\\" ++ x ++ ". " ++ f 0 m
f i (Apply n m) = if i == 2 then "(" ++ s ++ ")" else s
where s = f 1 n ++ " " ++ f 2 m
substitute :: Var -> Term -> Term -> Term
substitute x n (Variable y)
--if y = x, then leave n alone
| y == x = n
-- otherwise change to y
| otherwise = Variable y
substitute x n (Lambda y m)
--(\y.M)[N/x] = \y.M if y = x
| y == x = Lambda y m
--otherwise \z.(M[z/y][N/x]), where `z` is a fresh variable name
--generated by the `fresh` function, `z` must not be used in M or N,
--and `z` cannot be equal `x`. The `used` function checks if a
--variable name has been used in `Lambda y m`
| otherwise = Lambda newZ newM
where newZ = fresh(used(Lambda y m))
newM = substitute x n m
substitute x n (Apply m2 m1) = Apply newM2 newM1
where newM1 = substitute x n m2
newM2 = substitute x n m1
used :: Term -> [Var]
used (Variable n) = [n]
used (Lambda n t) = merge [n] (used t)
used (Apply t1 t2) = merge (used t1) (used t2)
variables :: [Var]
variables = [l:[] | l <- ['a'..'z']] ++
[l:show x | x <- [1..], l <- ['a'..'z']]
filterFreshVariables :: [Var] -> [Var] -> [Var]
filterFreshVariables lst = filter ( `notElem` lst)
fresh :: [Var] -> Var
fresh lst = head (filterFreshVariables lst variables)
recursiveNumeral :: Int -> Term
recursiveNumeral i
| i == 0 = Variable "x"
| i > 0 = Apply(Variable "f")(recursiveNumeral(i-1))
numeral :: Int -> Term
numeral i = Lambda "f" (Lambda "x" (recursiveNumeral i))
merge :: Ord a => [a] -> [a] -> [a]
merge (x : xs) (y : ys)
| x < y = x : merge xs (y : ys)
| otherwise = y : merge (x : xs) ys
merge xs [] = xs
merge [] ys = ys
This part in substitute x n (Lambda y m) is not correct:
the comment says "z must not be used in M or N", but there is nothing preventing that. newZ could be a variable in n, which leads to a problematic capture
the substitution z/y has not been done
| otherwise = Lambda newZ newM
where newZ = fresh(used(Lambda y m))
newM = substitute x n m
Fix:
"z must not be used in M or N":
newZ = fresh(used m `merge` used n)
"M[z/y][N/x]":
newM = substitute x n (substitute y (Variable newZ) m)
Put together:
| otherwise = Lambda newZ newM
where
newZ = fresh(used m `merge` used n)
newM = substitute x n (substitute y (Variable newZ) m)
Note that refreshing all bindings as done above makes it difficult to understand the result and to debug substitution. Actually y only needs to be refreshed if y is in n. Otherwise you can keep y, adding this clause:
| y `notElem` used n = Lambda y (substitute x n m)
Another idea would be to modify fresh to pick a name similar to the old one, e.g., by appending numbers until one doesn't clash.
There is still a bug I missed: newZ should also not be equal to x (the variable originally being substituted).
-- substitute [a -> \f. \x. x] in (\g. g), should be (\g. g)
ghci> substitute "a" (numeral 0) (Lambda "g" (Variable "g"))
\a. \g. \x. x
Two ways to address this:
add x to the set of variables to exclude newZ from:
newZ = fresh ([x] `merge` used m `merge` used n)
if you think about it, this bug only manifests itself when x is not in m, in which case there is nothing to substitute, so another way is to add one more branch skipping the work:
| x `notElem` used m = Lambda y m
Put together:
substitute x n (Lambda y m)
--(\y.M)[N/x] = \y.M if y = x
| y == x = Lambda y m
| x `notElem` used m = Lambda y m
| y `notElem` used n = Lambda y (substitute x n m)
| otherwise = Lambda newZ newM
where newZ = fresh(used m `merge` used n)
newM = substitute x n (substitute y (Variable newZ) m)
Output
ghci> example
\a. \x. (\y. a) x b
ghci> numeral 0
\f. \x. x
ghci> substitute "b" (numeral 0) example
\a. \c. (\y. a) c (\f. \x. x)
Note: I haven't tried to prove this code correct (exercise for the reader: define "correct"), there may still be bugs I missed. There must be some course about lambda calculus that has all the details and pitfalls but I haven't bothered to look.

What math operations does this abstraction of expression support?

A famous Haskell book has an exercise (spoiler alert) that asks to write functor, applicative and monad instances for a simplified data type of mathematical expressions. And no, this is not my homework for a course.
The following typechecks:
data Expr a = Var a | Val Int | Add (Expr a) (Expr a) deriving Show
instance Functor Expr where
fmap f (Var x) = Var $ f x
fmap f (Add e1 e2) = Add (fmap f e1) (fmap f e2)
fmap _ (Val x) = Val x
instance Applicative Expr where
pure x = Var x
(Val x) <*> _ = Val x
(Var f) <*> e = f <$> e
(Add f g) <*> e = Add (f <*> e) (g <*> e)
instance Monad Expr where
return = pure
(Val x) >>= _ = Val x
(Var x) >>= f = f x
(Add e1 e2) >>= f = Add (e1 >>= f) (e2 >>= f)
However, the last part of the question asks to explain what bind does in this case, with an example. I think an even better question would be: what kinds of useful operations can you do with these abstractions? So I started to consider this, with the following expression:
expr :: Expr Char
expr = Add (Add (Var 'x') (Var 'y')) (Add (Var 'x') (Val 1))
The functor instance allows me to substitute a different name for a variable:
λ> (\v -> if v == 'x' then 't' else v) <$> expr
Add (Add (Var 't') (Var 'y')) (Add (Var 't') (Val 1))
But using it to substitute values for variables doesn't really seem to work:
λ> (\v -> if v == 'x' then 2 else 3) <$> expr
Add (Add (Var 2) (Var 3)) (Add (Var 2) (Val 1))
Here, however, the monad comes to the rescue:
λ> expr >>= (\v -> Val (if v == 'x' then 2 else 3))
Add (Add (Val 2) (Val 3)) (Add (Val 2) (Val 1))
With the help of the monad, it seems even possible to substitute expressions for a variable, here t+2 is substituted for x:
λ> expr >>= (\v -> if v == 'x' then Add (Var 't') (Val 2) else pure v)
Add (Add (Add (Var 't') (Val 2)) (Var 'y')) (Add (Add (Var 't') (Val 2)) (Val 1))
But what else? What would be meaningful uses of the applicative? What other useful operations could we do with the monad?
The applicative instance corresponds to substituting for variables where the Expr-level structure of the substitution doesn't depend on the variable. For example, if you were processing this expression in the context of a linear programming problem and wanted to replace each variable Var 'x' with a sum of two variables, one which is always positive and one which is always negative, you could write:
> import Control.Applicative
> expr <**> Add (Var (:"pos")) (Var (:"neg"))
Add (Add (Add (Var "xpos") (Var "xneg"))
(Add (Var "ypos") (Var "yneg")))
(Add (Add (Var "xpos") (Var "xneg")) (Val 1))
>
The key here is that every variable is replaced with the same template Add (Var "_pos") (Var "_neg") where the new variables in the template have names that can depend on the original variable name. That's what makes this operation applicative.
As an aside, note that substituting a Val Int for each Var Char isn't an applicative operation unless the same value is substituted for each variable -- the value of the Int is part of the Expr-level structure and can't depend on the variable name.
Because the monad instance can replace variables with an Expr that depends on the variable name, it can perform more general substitutions.
Ultimately, the Functor instance allows you to change variable names, the Monad instance allows you to substitute variables with arbitrary expressions, and the Applicative instance provides a limited sort of template substitution that just isn't very interesting or useful for this particular data structure.
That's really all they can do, though there is one generalization that you touched on with your failed attempt to use the Functor instance to substitute values. These instances can change the type from Expr Char to some other Expr b. For example, if you were compiling an expression to a bytecode that referenced variables by memory pointers, then suddenly variable "renaming" via the Functor becomes a little more interesting:
type Location = Int
symtab :: [(Char, Int)]
symtab = [('x', 4096), ('y', 4100)] -- memory addresses
> fmap (fromJust . flip lookup symtab) expr
Add (Add (Var 4096) (Var 4100)) (Add (Var 4096) (Val 1))
>
Substitution is pretty much what bind does, but that's a pretty useful tool. For instance you can make a function that eliminates all variables by lookups in an [(a,Int)] (and an extra Int as default value if the variable is not in the list).
I suppose the Monad instance could be made to do other stuff, for instance if it simplifies the expression when it rebuilds Add's (so Add (Val x) (Val y) is reduced to Val (x+y)), the function I mentioned above would always reduce the result to (Val n). Not sure you want to do that though.
The Applicative instance does not let you do anything you can not already do with the Monad instance (prove this by implementing <*> using >>= and pure).

interpret Parigot's lambda-mu calculus in Haskell

One can interpret the lambda calculus in Haskell:
data Expr = Var String | Lam String Expr | App Expr Expr
data Value a = V a | F (Value a -> Value a)
interpret :: [(String, Value a)] -> Expr -> Value a
interpret env (Var x) = case lookup x env of
Nothing -> error "undefined variable"
Just v -> v
interpret env (Lam x e) = F (\v -> interpret ((x, v):env) e)
interpret env (App e1 e2) = case interpret env e1 of
V _ -> error "not a function"
F f -> f (interpret env e2)
How could the above interpreter be extended to the lambda-mu calculus? My guess is that it should use continuations for interpreting the additional constructs in this calculus. (15) and (16) from the Bernardi&Moortgat paper are the kind of translations I expect.
It is possible since Haskell is Turing-complete, but how?
Hint: See the comment on page 197 on this research paper for the intuitive meaning of the mu binder.
Here's a mindless transliteration of the reduction rules from the paper, using #user2407038's representation (as you'll see, when I say mindless, I really do mean mindless):
{-# LANGUAGE DataKinds, KindSignatures, GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
import Control.Monad.Writer
import Control.Applicative
import Data.Monoid
data TermType = Named | Unnamed
type Var = String
type MuVar = String
data Expr (n :: TermType) where
Var :: Var -> Expr Unnamed
Lam :: Var -> Expr Unnamed -> Expr Unnamed
App :: Expr Unnamed -> Expr Unnamed -> Expr Unnamed
Freeze :: MuVar -> Expr Unnamed -> Expr Named
Mu :: MuVar -> Expr Named -> Expr Unnamed
deriving instance Show (Expr n)
substU :: Var -> Expr Unnamed -> Expr n -> Expr n
substU x e = go
where
go :: Expr n -> Expr n
go (Var y) = if y == x then e else Var y
go (Lam y e) = Lam y $ if y == x then e else go e
go (App f e) = App (go f) (go e)
go (Freeze alpha e) = Freeze alpha (go e)
go (Mu alpha u) = Mu alpha (go u)
renameN :: MuVar -> MuVar -> Expr n -> Expr n
renameN beta alpha = go
where
go :: Expr n -> Expr n
go (Var x) = Var x
go (Lam x e) = Lam x (go e)
go (App f e) = App (go f) (go e)
go (Freeze gamma e) = Freeze (if gamma == beta then alpha else gamma) (go e)
go (Mu gamma u) = Mu gamma $ if gamma == beta then u else go u
appN :: MuVar -> Expr Unnamed -> Expr n -> Expr n
appN beta v = go
where
go :: Expr n -> Expr n
go (Var x) = Var x
go (Lam x e) = Lam x (go e)
go (App f e) = App (go f) (go e)
go (Freeze alpha w) = Freeze alpha $ if alpha == beta then App (go w) v else go w
go (Mu alpha u) = Mu alpha $ if alpha /= beta then go u else u
reduceTo :: a -> Writer Any a
reduceTo x = tell (Any True) >> return x
reduce0 :: Expr n -> Writer Any (Expr n)
reduce0 (App (Lam x u) v) = reduceTo $ substU x v u
reduce0 (App (Mu beta u) v) = reduceTo $ Mu beta $ appN beta v u
reduce0 (Freeze alpha (Mu beta u)) = reduceTo $ renameN beta alpha u
reduce0 e = return e
reduce1 :: Expr n -> Writer Any (Expr n)
reduce1 (Var x) = return $ Var x
reduce1 (Lam x e) = reduce0 =<< (Lam x <$> reduce1 e)
reduce1 (App f e) = reduce0 =<< (App <$> reduce1 f <*> reduce1 e)
reduce1 (Freeze alpha e) = reduce0 =<< (Freeze alpha <$> reduce1 e)
reduce1 (Mu alpha u) = reduce0 =<< (Mu alpha <$> reduce1 u)
reduce :: Expr n -> Expr n
reduce e = case runWriter (reduce1 e) of
(e', Any changed) -> if changed then reduce e' else e
It "works" for the example from the paper: with
example 0 = App (App t (Var "x")) (Var "y")
where
t = Lam "x" $ Lam "y" $ Mu "delta" $ Freeze "phi" $ App (Var "x") (Var "y")
example n = App (example (n-1)) (Var ("z_" ++ show n))
I can reduce example n to the expected result:
*Main> reduce (example 10)
Mu "delta" (Freeze "phi" (App (Var "x") (Var "y")))
The reason I put scare quotes around "works" above is that I have no intuition about the λμ calculus so I don't know what it should do.
Note: this is only a partial answer since I'm not sure how to extend the interpreter.
This seems like a good use case for DataKinds. The Expr datatype is indexed on a type which is named or unnamed. The regular lambda constructs produce named terms only.
{-# LANGUAGE GADTs, DataKinds, KindSignatures #-}
data TermType = Named | Unnamed
type Var = String
type MuVar = String
data Expr (n :: TermType) where
Var :: Var -> Expr Unnamed
Lam :: Var -> Expr Unnamed -> Expr Unnamed
App :: Expr Unnamed -> Expr Unnamed -> Expr Unnamed
and the additional Mu and Name constructs can manipulate the TermType.
...
Name :: MuVar -> Expr Unnamed -> Expr Named
Mu :: MuVar -> Expr Named -> Expr Unnamed
How about something like the below. I don't have a good idea on how to traverse Value a, but at least I can see it evaluates example n into MuV.
import Data.Maybe
type Var = String
type MuVar = String
data Expr = Var Var
| Lam Var Expr
| App Expr Expr
| Mu MuVar MuVar Expr
deriving Show
data Value a = ConV a
| LamV (Value a -> Value a)
| MuV (Value a -> Value a)
type Env a = [(Var, Value a)]
type MuEnv a = [(MuVar, Value a -> Value a)]
varScopeErr :: Var -> Value a
varScopeErr v = error $ unwords ["Out of scope λ variable:", show v]
appErr :: Value a
appErr = error "Trying to apply a non-lambda"
muVarScopeErr :: MuVar -> (Value a -> Value a)
muVarScopeErr alpha = id
app :: Value a -> Value a -> Value a
app (LamV f) x = f x
app (MuV f) x = MuV $ \y -> f x `app` y
app _ _ = appErr
eval :: Env a -> MuEnv a -> Expr -> Value a
eval env menv (Var v) = fromMaybe (varScopeErr v) $ lookup v env
eval env menv (Lam v e) = LamV $ \x -> eval ((v, x):env) menv e
eval env menv (Mu alpha beta e) = MuV $ \u ->
let menv' = (alpha, (`app` u)):menv
wrap = fromMaybe (muVarScopeErr beta) $ lookup beta menv'
in wrap (eval env menv' e)
eval env menv (App f e) = eval env menv f `app` eval env menv e
example 0 = App (App t (Var "v")) (Var "w")
where
t = Lam "x" $ Lam "y" $ Mu "delta" "phi" $ App (Var "x") (Var "y")
example n = App (example (n-1)) (Var ("z_" ++ show n))

Conversion from lambda term to combinatorial term

Suppose there are some data types to express lambda and combinatorial terms:
data Lam α = Var α -- v
| Abs α (Lam α) -- λv . e1
| App (Lam α) (Lam α) -- e1 e2
deriving (Eq, Show)
infixl 0 :#
data SKI α = V α -- x
| SKI α :# SKI α -- e1 e2
| I -- I
| K -- K
| S -- S
deriving (Eq, Show)
There is also a function to get a list of lambda term's free variables:
fv ∷ Eq α ⇒ Lam α → [α]
fv (Var v) = [v]
fv (Abs x e) = filter (/= x) $ fv e
fv (App e1 e2) = fv e1 ++ fv e2
To convert lambda term to combinatorial term abstract elimination rules could be usefull:
convert ∷ Eq α ⇒ Lam α → SKI α
1) T[x] => x
convert (Var x) = V x
2) T[(E₁ E₂)] => (T[E₁] T[E₂])
convert (App e1 e2) = (convert e1) :# (convert e2)
3) T[λx.E] => (K T[E]) (if x does not occur free in E)
convert (Abs x e) | x `notElem` fv e = K :# (convert e)
4) T[λx.x] => I
convert (Abs x (Var y)) = if x == y then I else K :# V y
5) T[λx.λy.E] => T[λx.T[λy.E]] (if x occurs free in E)
convert (Abs x (Abs y e)) | x `elem` fv e = convert (Abs x (convert (Abs y e)))
6) T[λx.(E₁ E₂)] => (S T[λx.E₁] T[λx.E₂])
convert (Abs x (App y z)) = S :# (convert (Abs x y)) :# (convert (Abs x z))
convert _ = error ":["
This definition is not valid because of 5):
Couldn't match expected type `Lam α' with actual type `SKI α'
In the return type of a call of `convert'
In the second argument of `Abs', namely `(convert (Abs y e))'
In the first argument of `convert', namely
`(Abs x (convert (Abs y e)))'
So, what I have now is:
> convert $ Abs "x" $ Abs "y" $ App (Var "y") (Var "x")
*** Exception: :[
What I want is (hope I calculate it right):
> convert $ Abs "x" $ Abs "y" $ App (Var "y") (Var "x")
S :# (S (KS) (S (KK) I)) (S (KK) I)
Question:
If lambda term and combinatorial term have a different types of expression, how 5) could be formulated right?
Let's consider the equation T[λx.λy.E] => T[λx.T[λy.E]].
We know the result of T[λy.E] is an SKI expression. Since it has been produced by one of the cases 3, 4 or 6, it is either I or an application (:#).
Thus the outer T in T[λx.T[λy.E]] must be one of the cases 3 or 6. You can perform this case analysis in the code. I'm sorry but I don't have the time to write it out.
Here it's better to have a common data type for combinators and lambda expressions. Notice that your types already have significant overlap (Var, App), and it doesn't hurt to have combinators in lambda expressions.
The only possibility we want to eliminate is having lambda abstractions in combinator terms. We can forbid them using indexed types.
In the following code the type of a term is parameterised by the number of nested lambda abstractions in that term. The convert function returns Term Z a, where Z means zero, so there are no lambda abstractions in the returned term.
For more information about singleton types (which are used a bit here), see the paper Dependently Typed Programming with Singletons.
{-# LANGUAGE DataKinds, KindSignatures, TypeFamilies, GADTs, TypeOperators,
ScopedTypeVariables, MultiParamTypeClasses, FlexibleInstances #-}
data Nat = Z | Inc Nat
data SNat :: Nat -> * where
SZ :: SNat Z
SInc :: NatSingleton n => SNat n -> SNat (Inc n)
class NatSingleton (a :: Nat) where
sing :: SNat a
instance NatSingleton Z where sing = SZ
instance NatSingleton a => NatSingleton (Inc a) where sing = SInc sing
type family Max (a :: Nat) (b :: Nat) :: Nat
type instance Max Z a = a
type instance Max a Z = a
type instance Max (Inc a) (Inc b) = Inc (Max a b)
data Term (l :: Nat) a where
Var :: a -> Term Z a
Abs :: NatSingleton l => a -> Term l a -> Term (Inc l) a
App :: (NatSingleton l1, NatSingleton l2)
=> Term l1 a -> Term l2 a -> Term (Max l1 l2) a
I :: Term Z a
K :: Term Z a
S :: Term Z a
fv :: Eq a => Term l a -> [a]
fv (Var v) = [v]
fv (Abs x e) = filter (/= x) $ fv e
fv (App e1 e2) = fv e1 ++ fv e2
fv _ = []
eliminateLambda :: (Eq a, NatSingleton l) => Term (Inc l) a -> Term l a
eliminateLambda t =
case t of
Abs x t ->
case t of
Var y
| y == x -> I
| otherwise -> App K (Var y)
Abs {} -> Abs x $ eliminateLambda t
App a b -> S `App` (eliminateLambda $ Abs x a)
`App` (eliminateLambda $ Abs x b)
App a b -> eliminateLambdaApp a b
eliminateLambdaApp
:: forall a l1 l2 l .
(Eq a, Max l1 l2 ~ Inc l,
NatSingleton l1,
NatSingleton l2)
=> Term l1 a -> Term l2 a -> Term l a
eliminateLambdaApp a b =
case (sing :: SNat l1, sing :: SNat l2) of
(SInc _, SZ ) -> App (eliminateLambda a) b
(SZ , SInc _) -> App a (eliminateLambda b)
(SInc _, SInc _) -> App (eliminateLambda a) (eliminateLambda b)
convert :: forall a l . Eq a => NatSingleton l => Term l a -> Term Z a
convert t =
case sing :: SNat l of
SZ -> t
SInc _ -> convert $ eliminateLambda t
The key insight is that S, K and I are just constant Lam terms, in the same way that 1, 2 and 3 are constant Ints. It would be pretty easy to make rule 5 type-check by making an inverse to the 'convert' function:
nvert :: SKI a -> Lam a
nvert S = Abs "x" (Abs "y" (Abs "z" (App (App (Var "x") (Var "z")) (App (Var "y") (Var "z")))))
nvert K = Abs "x" (Abs "y" (Var "x"))
nvert I = Abs "x" (Var "x")
nvert (V x) = Var x
nvert (x :# y) = App (nvert x) (nvert y)
Now we can use 'nvert' to make rule 5 type-check:
convert (Abs x (Abs y e)) | x `elem` fv e = convert (Abs x (nvert (convert (Abs y e))))
We can see that the left and the right are identical (we'll ignore the guard), except that 'Abs y e' on the left is replaced by 'nvert (convert (Abs y e))' on the right. Since 'convert' and 'nvert' are each others' inverse, we can always replace any Lam 'x' with 'nvert (convert x)' and likewise we can always replace any SKI 'x' with 'convert (nvert x)', so this is a valid equation.
Unfortunately, while it's a valid equation it's not a useful function definition because it won't cause the computation to progress: we'll just convert 'Abs y e' back and forth forever!
To break this loop we can replace the call to 'nvert' with a 'reminder' that we should do it later. We do this by adding a new constructor to Lam:
data Lam a = Var a -- v
| Abs a (Lam a) -- \v . e1
| App (Lam a) (Lam a) -- e1 e2
| Com (SKI a) -- Reminder to COMe back later and nvert
deriving (Eq, Show)
Now rule 5 uses this reminder instead of 'nvert':
convert (Abs x (Abs y e)) | x `elem` fv e = convert (Abs x (Com (convert (Abs y e))))
Now we need to make good our promise to come back, by making a separate rule to replace reminders with actual calls to 'nvert', like this:
convert (Com c) = convert (nvert c)
Now we can finally break the loop: we know that 'convert (nvert c)' is always identical to 'c', so we can replace the above line with this:
convert (Com c) = c
Notice that our final definition of 'convert' doesn't actually use 'nvert' at all! It's still a handy function though, since other functions involving Lam can use it to handle the new 'Com' case.
You've probably noticed that I've actually named this constructor 'Com' because it's just a wrapped-up COMbinator, but I thought it would be more informative to take a slightly longer route than just saying "wrap up your SKIs in Lams" :)
If you're wondering why I called that function "nvert", see http://unapologetic.wordpress.com/2007/05/31/duality-terminology/ :)
Warbo is right, combinators are constant lambda terms, consequently the conversion function is
T[ ]:L -> C with L the set of lambda terms and C that of combinatory terms and with C ⊂ L .
So there is no typing problem for the rule T[λx.λy.E] => T[λx.T[λy.E]]
Here an implementation in Scala.

Implementing lazy functional languages

When implementing a lazy functional language, it is necessary to store values as unevaluated thunks, to be evaluated only when needed.
One of the challenges of an efficient implementation, as discussed in e.g. The Spineless Tagless G-machine, is that this evaluation must be carried out only once for each thunk, and subsequent accesses must reuse the calculated value - failure to do this would lead to at least quadratic slowdown (perhaps exponential? I'm not sure off the top of my head.)
I'm looking for a simple example implementation whose operation is easily understood (as opposed to an industrial-strength implementation like GHC which is designed for performance over simplicity). I came across minihaskell at http://www.andrej.com/plzoo/ which contains the following code.
As it is dubbed "an efficient interpreter", I would assume it does indeed carry out each evaluation only once and save the calculated value for reuse, but I'm having difficulty seeing where and how; I can only see one assignment statement in the interpreter itself, and that doesn't look like it's overwriting part of a thunk record.
So my question is, is this interpreter indeed doing such caching, and if so where and how? (And if not, what's the simplest extant implementation that does do so?)
Code from http://www.andrej.com/plzoo/html/minihaskell.html
let rec interp env = function
| Var x ->
(try
let r = List.assoc x env in
match !r with
VClosure (env', e) -> let v = interp env' e in r := v ; v
| v -> v
with
Not_found -> runtime_error ("Unknown variable " ^ x))
... snipping the easy stuff ...
| Fun _ as e -> VClosure (env, e)
| Apply (e1, e2) ->
(match interp env e1 with
VClosure (env', Fun (x, _, e)) ->
interp ((x, ref (VClosure (env, e2)))::env') e
| _ -> runtime_error "Function expected in application")
| Pair _ as e -> VClosure (env, e)
| Fst e ->
(match interp env e with
VClosure (env', Pair (e1, e2)) -> interp env' e1
| _ -> runtime_error "Pair expected in fst")
| Snd e ->
(match interp env e with
VClosure (env', Pair (e1, e2)) -> interp env' e2
| _ -> runtime_error "Pair expected in snd")
| Rec (x, _, e) ->
let rec env' = (x,ref (VClosure (env',e))) :: env in
interp env' e
| Nil ty -> VNil ty
| Cons _ as e -> VClosure (env, e)
| Match (e1, _, e2, x, y, e3) ->
(match interp env e1 with
VNil _ -> interp env e2
| VClosure (env', Cons (d1, d2)) ->
interp ((x,ref (VClosure(env',d1)))::(y,ref (VClosure(env',d2)))::env) e3
| _ -> runtime_error "List expected in match")
The key are the records: notice !r, r := v. Whenever we lookup a variable from the environment, we actually get back a record, which we dereference to see if it's a thunk. If it is a thunk, we evaluate it and then save the result. We create thunks during application (notice the call to the ref constructor), recursive definitions and pattern matching, because those are constructs that bind variables.
Here are two call-by-need interpreters; one in Haskell, and one in Scheme. The key to both is that you can suspend evaluation inside procedures of no arguments (thunks). Whether your host language is call-by-need (Haskell) or call-by-value (Scheme, ML), lambda forms are considered values, so nothing under the lambda will be evaluated until the thunk is applied.
So, when an interpreted function is applied to an argument, you just wrap the unevaluated syntactic representation of the argument in a new thunk. Then, when you come across a variable, you look it up in the environment and promptly evaluate the thunk, giving you the value of the argument
Simply getting to this point makes your interpreter lazy, since arguments are not actually evaluated until they're used; this is a call-by-name interpreter. As you point out, though, an efficient lazy language will evaluate these arguments only once; such a language is call-by-need. To get this efficiency, you update the environment to instead contain a thunk containing just the value of the argument, rather than the entire argument expression.
The first interpreter here is in Haskell, and is fairly similar to the ML code you pasted. Of course, the challenges in Haskell are to 1) not trivially implement laziness, thanks to Haskell's built-in laziness, and 2) wrangle the side-effects into the code. Haskell's IORefs are used to allow the environment to be updated.
module Interp where
import Data.IORef
data Expr = ExprBool Bool
| ExprInt Integer
| ExprVar String
| ExprZeroP Expr
| ExprSub1 Expr
| ExprMult Expr Expr
| ExprIf Expr Expr Expr
| ExprLam String Expr
| ExprApp Expr Expr
deriving (Show)
data Val = ValBool Bool
| ValInt Integer
| ValClos ((() -> IO Val) -> IO Val)
instance Show Val where
show (ValBool b) = show b
show (ValInt n) = show n
show (ValClos c) = "Closure"
data Envr = EnvrEmpty
| EnvrExt String (IORef (() -> IO Val)) Envr
applyEnv :: Envr -> String -> IO (IORef (() -> IO Val))
applyEnv EnvrEmpty y = error $ "unbound variable " ++ y
applyEnv (EnvrExt x v env) y =
if x == y
then return v
else applyEnv env y
eval :: Expr -> Envr -> IO Val
eval exp env = case exp of
(ExprBool b) -> return $ ValBool b
(ExprInt n) -> return $ ValInt n
(ExprVar y) -> do
thRef <- applyEnv env y
th <- readIORef thRef
v <- th ()
writeIORef thRef (\() -> return v)
return v
(ExprZeroP e) -> do
(ValInt n) <- eval e env
return $ ValBool (n == 0)
(ExprSub1 e) -> do
(ValInt n) <- eval e env
return $ ValInt (n - 1)
(ExprMult e1 e2) -> do
(ValInt n1) <- eval e1 env
(ValInt n2) <- eval e2 env
return $ ValInt (n1 * n2)
(ExprIf te ce ae) -> do
(ValBool t) <- eval te env
if t then eval ce env else eval ae env
(ExprLam x body) ->
return $ ValClos (\a -> do
a' <- newIORef a
eval body (EnvrExt x a' env))
(ExprApp rator rand) -> do
(ValClos c) <- eval rator env
c (\() -> eval rand env)
-- "poor man's Y" factorial definition
fact = ExprApp f f
where f = (ExprLam "f" (ExprLam "n" (ExprIf (ExprZeroP (ExprVar "n"))
(ExprInt 1)
(ExprMult (ExprVar "n")
(ExprApp (ExprApp (ExprVar "f")
(ExprVar "f"))
(ExprSub1 (ExprVar "n")))))))
-- test factorial 5 = 120
testFact5 = eval (ExprApp fact (ExprInt 5)) EnvrEmpty
-- Omega, the delightful infinite loop
omega = ExprApp (ExprLam "x" (ExprApp (ExprVar "x") (ExprVar "x")))
(ExprLam "x" (ExprApp (ExprVar "x") (ExprVar "x")))
-- show that ((\y -> 5) omega) does not diverge, because the
-- interpreter is lazy
testOmega = eval (ExprApp (ExprLam "y" (ExprInt 5)) omega) EnvrEmpty
The second interpreter is in Scheme, where the only real boilerplate is Oleg's pattern-matching macro. I find that it's much easier to see where the laziness is coming from in the Scheme version. The box functions allow the environment to be updated; Chez Scheme includes them, but I've included definitions that should work for others.
(define box
(lambda (x)
(cons x '())))
(define unbox
(lambda (b)
(car b)))
(define set-box!
(lambda (b v)
(set-car! b v)))
;; Oleg Kiselyov's linear pattern matcher
(define-syntax pmatch
(syntax-rules (else guard)
((_ (rator rand ...) cs ...)
(let ((v (rator rand ...)))
(pmatch v cs ...)))
((_ v) (errorf 'pmatch "failed: ~s" v))
((_ v (else e0 e ...)) (begin e0 e ...))
((_ v (pat (guard g ...) e0 e ...) cs ...)
(let ((fk (lambda () (pmatch v cs ...))))
(ppat v pat (if (and g ...) (begin e0 e ...) (fk)) (fk))))
((_ v (pat e0 e ...) cs ...)
(let ((fk (lambda () (pmatch v cs ...))))
(ppat v pat (begin e0 e ...) (fk))))))
(define-syntax ppat
(syntax-rules (uscore quote unquote)
((_ v uscore kt kf)
; _ can't be listed in literals list in R6RS Scheme
(and (identifier? #'uscore) (free-identifier=? #'uscore #'_))
kt)
((_ v () kt kf) (if (null? v) kt kf))
((_ v (quote lit) kt kf) (if (equal? v (quote lit)) kt kf))
((_ v (unquote var) kt kf) (let ((var v)) kt))
((_ v (x . y) kt kf)
(if (pair? v)
(let ((vx (car v)) (vy (cdr v)))
(ppat vx x (ppat vy y kt kf) kf))
kf))
((_ v lit kt kf) (if (equal? v (quote lit)) kt kf))))
(define empty-env
(lambda ()
`(empty-env)))
(define extend-env
(lambda (x v env)
`(extend-env ,x ,v ,env)))
(define apply-env
(lambda (env y)
(pmatch env
[(extend-env ,x ,v ,env)
(if (eq? x y)
v
(apply-env env y))])))
(define value-of
(lambda (exp env)
(pmatch exp
[,b (guard (boolean? b)) b]
[,n (guard (integer? n)) n]
[,y (guard (symbol? y))
(let* ([box (apply-env env y)]
[th (unbox box)]
[v (th)])
(begin (set-box! box (lambda () v)) v))]
[(zero? ,e) (zero? (value-of e env))]
[(sub1 ,e) (sub1 (value-of e env))]
[(* ,e1 ,e2) (* (value-of e1 env) (value-of e2 env))]
[(if ,t ,c ,a) (if (value-of t env)
(value-of c env)
(value-of a env))]
[(lambda (,x) ,body)
(lambda (a) (value-of body (extend-env x a env)))]
[(,rator ,rand) ((value-of rator env)
(box (lambda () (value-of rand env))))])))
;; "poor man's Y" factorial definition
(define fact
(let ([f '(lambda (f)
(lambda (n)
(if (zero? n)
1
(* n ((f f) (sub1 n))))))])
`(,f ,f)))
;; test factorial 5 = 120
(define testFact5
(lambda ()
(value-of `(,fact 5) (empty-env))))
;; Omega, the delightful infinite loop
(define omega
'((lambda (x) (x x)) (lambda (x) (x x))))
;; show that ((lambda (y) 5) omega) does not diverge, because the interpreter
;; is lazy
(define testOmega
(lambda ()
(value-of `((lambda (y) 5) ,omega) (empty-env))))
You should have a look at graph reduction using combinators (SKI). It's beautiful and simple and illustrates how lazy evaluation works.
You might be interested in Alef (Alef Lazily Evaluates Functions), which is a very simple, pure, lazy functional programming language that I originally created specifically for explaining lazy evaluation via graph reduction. It is implemented in less than 500 lines of Common Lisp, including some neat visualization functions.
http://gergo.erdi.hu/blog/2013-02-17-write_yourself_a_haskell..._in_lisp/
Unfortunately, I haven't gotten around to finishing 'Typecheck Yourself a Haskell... in Lisp' yet, even though most of the code was already written around the time I posted part 1.

Resources