Added nullary applications and generalized eta reductions.
parent
2e95783c3a
commit
5f87100363
32
README.md
32
README.md
|
@ -13,7 +13,35 @@ Exit the prompt with `Ctrl-C` (or however else you kill a program in your termin
|
||||||
|
|
||||||
Bound variables will be printed followed by a number representing the number of binders
|
Bound variables will be printed followed by a number representing the number of binders
|
||||||
between it and its definition for disambiguation.
|
between it and its definition for disambiguation.
|
||||||
This is not guaranteed not to capture free variables.
|
|
||||||
|
## Differences from the traditional lambda calculus
|
||||||
|
This version of the lambda calculus is completely compatible
|
||||||
|
with the traditional lambda calculus, but features a few extensions.
|
||||||
|
|
||||||
|
### Nullary applications
|
||||||
|
In any binary application `(f x)`, the `f` is a function and the `x` is a variable.
|
||||||
|
Applications are left-associative, meaning `(f x y)` equals `((f x) y)`.
|
||||||
|
Any term `x` may be expanded to an application `(id x)`.
|
||||||
|
Working backwards, we have `(f x y)` equals `(((id f) x) y)`.
|
||||||
|
Thus we may reasonably say that `() = id`
|
||||||
|
and thus that `(f x y)` equals `(((() f) x) y)`,
|
||||||
|
and that `(x)` equals `(() x)`, which reduces to just `x`.
|
||||||
|
|
||||||
|
### Nullary functions and generalized eta reductions
|
||||||
|
We can apply a similar argument to the function syntax.
|
||||||
|
`(\x y z. E)` is the same as `(\x.(\y.(\z.E)))` because lambda is right-associative.
|
||||||
|
Any term `x` may be eta-expanded into a lambda `(\y. ((() x) y))`.
|
||||||
|
Working backwards, we have `(\x. (() x))` eta-reducing to `()`.
|
||||||
|
Therefore, the identity function eta-reduces to just `()`.
|
||||||
|
|
||||||
|
Again similarly we have the nulladic lambda syntax `(\.E)`
|
||||||
|
which trivially beta-reduces to `E`.
|
||||||
|
|
||||||
|
I also take any series of ordered applications
|
||||||
|
`(\v v1 v2 ... vn. v:n v2:(n-1) ... v(n-1):1 vn:0)`
|
||||||
|
to eta-reduce to `()` (including `()` itself and, trivially, `(\x. x)`).
|
||||||
|
|
||||||
|
### Nullary functions
|
||||||
|
|
||||||
### Examples
|
### Examples
|
||||||
```
|
```
|
||||||
|
@ -28,7 +56,7 @@ y
|
||||||
## Syntax
|
## Syntax
|
||||||
* Variables are alphanumeric, beginning with a letter.
|
* Variables are alphanumeric, beginning with a letter.
|
||||||
* Applications are left-associative, and parentheses are not necessary.
|
* Applications are left-associative, and parentheses are not necessary.
|
||||||
* Lambdas are represented by `\\`, bind as far right as possible, and parentheses are not necessary.
|
* Lambdas are represented by `\`, bind as far right as possible, and parentheses are not necessary.
|
||||||
|
|
||||||
### Examples
|
### Examples
|
||||||
* Variables: `x`, `abc`, `D`, `fooBar`, `f10`
|
* Variables: `x`, `abc`, `D`, `fooBar`, `f10`
|
||||||
|
|
|
@ -1,11 +1,12 @@
|
||||||
{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable, MultiWayIf #-}
|
{-# LANGUAGE TemplateHaskell, TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable, MultiWayIf #-}
|
||||||
module UntypedLambdaCalculus (Expr (Free, Var, Lam, App), ReaderAlg, eval, cataReader) where
|
module UntypedLambdaCalculus (Expr (Free, Var, Lam, App, Nil), ReaderAlg, eval, cataReader) where
|
||||||
|
|
||||||
import Control.Monad.Reader (Reader, runReader, local, reader, ask)
|
import Control.Monad.Reader (Reader, runReader, local, reader, ask)
|
||||||
import Data.Bifunctor (bimap)
|
import Data.Foldable (fold)
|
||||||
import Data.Functor ((<&>))
|
import Data.Functor ((<&>))
|
||||||
import Data.Functor.Foldable (Base, Recursive, cata)
|
import Data.Functor.Foldable (Base, Recursive, cata, embed, project)
|
||||||
import Data.Functor.Foldable.TH (makeBaseFunctor)
|
import Data.Functor.Foldable.TH (makeBaseFunctor)
|
||||||
|
import Data.Monoid (Any (Any, getAny))
|
||||||
|
|
||||||
-- | A lambda calculus expression where variables are identified
|
-- | A lambda calculus expression where variables are identified
|
||||||
-- | by their distance from their binding site (De Bruijn indices).
|
-- | by their distance from their binding site (De Bruijn indices).
|
||||||
|
@ -13,6 +14,7 @@ data Expr = Free String
|
||||||
| Var Int
|
| Var Int
|
||||||
| Lam String Expr
|
| Lam String Expr
|
||||||
| App Expr Expr
|
| App Expr Expr
|
||||||
|
| Nil
|
||||||
|
|
||||||
makeBaseFunctor ''Expr
|
makeBaseFunctor ''Expr
|
||||||
|
|
||||||
|
@ -25,55 +27,75 @@ cataReader f initialState x = runReader (cata f x) initialState
|
||||||
instance Show Expr where
|
instance Show Expr where
|
||||||
show = cataReader alg []
|
show = cataReader alg []
|
||||||
where alg :: ReaderAlg ExprF [String] String
|
where alg :: ReaderAlg ExprF [String] String
|
||||||
alg (FreeF v) = return v
|
alg (FreeF v) = return v
|
||||||
alg (VarF v) = reader (\vars -> vars !! v ++ ':' : show v)
|
alg (VarF i) = reader (\vars -> vars !! i ++ ':' : show i)
|
||||||
alg (LamF v e) = do
|
alg (LamF v e) = do
|
||||||
body <- local (v :) e
|
body <- local (v :) e
|
||||||
return $ "(\\" ++ v ++ ". " ++ body ++ ")"
|
return $ "(\\" ++ v ++ ". " ++ body ++ ")"
|
||||||
alg (AppF f' x') = do
|
alg (AppF f' x') = do
|
||||||
f <- f'
|
f <- f'
|
||||||
x <- x'
|
x <- x'
|
||||||
return $ "(" ++ f ++ " " ++ x ++ ")"
|
return $ "(" ++ f ++ " " ++ x ++ ")"
|
||||||
|
alg NilF = return "()"
|
||||||
|
|
||||||
-- | Determine whether the variable bound by a lambda expression is used in its body.
|
-- | Is the innermost bound variable of this subexpression (`Var 0`) used in its body?
|
||||||
-- | This is used in eta reduction, where `(\x. f x)` reduces to `f` when `x` is not bound in `f`.
|
-- | For example: in `\x. a:1 x:0 b:2`, `x:0` is bound in `a:1 x:0 b:2`.
|
||||||
|
-- | On the other hand, in `\x. a:3 b:2 c:1`, it is not.
|
||||||
|
bound :: Expr -> Bool
|
||||||
|
bound = getAny . cataReader alg 0
|
||||||
|
where alg :: ReaderAlg ExprF Int Any
|
||||||
|
alg (VarF index) = reader (Any . (== index))
|
||||||
|
alg (LamF _ e) = local (+ 1) e
|
||||||
|
alg x = fold <$> sequenceA x
|
||||||
|
|
||||||
|
-- | Opposite of `bound`.
|
||||||
unbound :: Expr -> Bool
|
unbound :: Expr -> Bool
|
||||||
unbound = cataReader alg 0
|
unbound = not . bound
|
||||||
where alg :: ReaderAlg ExprF Int Bool
|
|
||||||
alg (FreeF _) = return True
|
|
||||||
alg (VarF v) = reader (/= v)
|
|
||||||
alg (AppF f x) = (&&) <$> f <*> x
|
|
||||||
alg (LamF _ e) = local (+ 1) e
|
|
||||||
|
|
||||||
-- | When we bind a new variable, we enter a new scope.
|
-- | When we bind a new variable, we enter a new scope.
|
||||||
-- | Since variables are identified by their distance from their binder,
|
-- | Since variables are identified by their distance from their binder,
|
||||||
-- | we must increment them to account for the incremented distance,
|
-- | we must increment them to account for the incremented distance,
|
||||||
-- | thus embedding them into the new expression.
|
-- | thus embedding them into the new expression.
|
||||||
embed :: Expr -> Expr
|
liftExpr :: Int -> Expr -> Expr
|
||||||
embed (Var v) = Var $ v + 1
|
liftExpr n (Var i) = Var $ i + n
|
||||||
embed (App f x) = App (embed f) (embed x)
|
liftExpr _ o@(Lam _ _) = o
|
||||||
embed x = x
|
liftExpr n x = embed $ fmap (liftExpr n) $ project x
|
||||||
|
|
||||||
subst :: Expr -> Expr -> Expr
|
subst :: Expr -> Expr -> Expr
|
||||||
subst val = cataReader alg (0, val)
|
subst val = cataReader alg 0
|
||||||
where alg :: ReaderAlg ExprF (Int, Expr) Expr
|
where alg :: ReaderAlg ExprF Int Expr
|
||||||
alg (FreeF x) = return $ Free x
|
alg (VarF i) = ask <&> \bindingDepth -> if
|
||||||
alg (VarF x) = ask <&> \(x', value) -> if
|
| i == bindingDepth -> liftExpr bindingDepth val
|
||||||
| x == x' -> value
|
| i > bindingDepth -> Var $ i - 1
|
||||||
| x > x' -> Var $ x - 1
|
| otherwise -> Var i
|
||||||
| otherwise -> Var x
|
alg (LamF v e) = Lam v <$> local (+ 1) e
|
||||||
alg (AppF f x) = App <$> f <*> x
|
alg x = embed <$> sequence x
|
||||||
alg (LamF v e) = Lam v <$> local (bimap (+ 1) embed) e
|
|
||||||
|
-- | Generalized eta reduction. I (almost certainly re-)invented it myself.
|
||||||
|
etaReduce :: Expr -> Expr
|
||||||
|
-- Degenerate case
|
||||||
|
-- The identity function reduces to the syntactic identity, `Nil`.
|
||||||
|
etaReduce (Lam _ (Var 0)) = Nil
|
||||||
|
-- `\x. f x -> f` if `x` is not bound in `f`.
|
||||||
|
etaReduce o@(Lam _ (App f (Var 0)))
|
||||||
|
| unbound f = eval $ subst undefined f
|
||||||
|
| otherwise = o
|
||||||
|
-- `\x y. f y -> \x. f` if `y` is not bound in `f`;
|
||||||
|
-- the resultant term may itself be eta-reducible.
|
||||||
|
etaReduce (Lam v e'@(Lam _ _)) = case etaReduce e' of
|
||||||
|
e@(Lam _ _) -> Lam v e
|
||||||
|
e -> etaReduce $ Lam v e
|
||||||
|
etaReduce x = x
|
||||||
|
|
||||||
|
betaReduce :: Expr -> Expr
|
||||||
|
betaReduce (App f' x) = case eval f' of
|
||||||
|
Lam _ e -> eval $ subst x e
|
||||||
|
Nil -> eval x
|
||||||
|
f -> App f $ eval x
|
||||||
|
betaReduce x = x
|
||||||
|
|
||||||
-- | Evaluate an expression to normal form.
|
-- | Evaluate an expression to normal form.
|
||||||
eval :: Expr -> Expr
|
eval :: Expr -> Expr
|
||||||
eval (App f' x) = case eval f' of
|
eval a@(App _ _) = betaReduce a
|
||||||
-- Beta reduction.
|
eval l@(Lam _ _) = etaReduce l
|
||||||
Lam _ e -> eval $ subst x e
|
|
||||||
f -> App f (eval x)
|
|
||||||
eval o@(Lam _ (App f (Var 0)))
|
|
||||||
-- Eta reduction. We know that `0` is not bound in `f`,
|
|
||||||
-- so we can simply substitute it for undefined.
|
|
||||||
| unbound f = eval $ subst undefined f
|
|
||||||
| otherwise = o
|
|
||||||
eval o = o
|
eval o = o
|
||||||
|
|
|
@ -3,15 +3,15 @@ module UntypedLambdaCalculus.Parser (parseExpr) where
|
||||||
|
|
||||||
import Control.Applicative (liftA2)
|
import Control.Applicative (liftA2)
|
||||||
import Control.Monad.Reader (local, asks)
|
import Control.Monad.Reader (local, asks)
|
||||||
import Data.List (foldl1', elemIndex)
|
import Data.List (foldl', elemIndex)
|
||||||
import Data.Functor.Foldable.TH (makeBaseFunctor)
|
import Data.Functor.Foldable.TH (makeBaseFunctor)
|
||||||
import Text.Parsec (SourceName, ParseError, (<|>), many, sepBy1, letter, alphaNum, char, between, spaces, parse)
|
import Text.Parsec (SourceName, ParseError, (<|>), many, sepBy, letter, alphaNum, char, between, spaces, parse)
|
||||||
import Text.Parsec.String (Parser)
|
import Text.Parsec.String (Parser)
|
||||||
import UntypedLambdaCalculus (Expr (Free, Var, Lam, App), ReaderAlg, cataReader)
|
import UntypedLambdaCalculus (Expr (Free, Var, Lam, App, Nil), ReaderAlg, cataReader)
|
||||||
|
|
||||||
data Ast = AstVar String
|
data Ast = AstVar String
|
||||||
| AstLam String Ast
|
| AstLam [String] Ast
|
||||||
| AstApp Ast Ast
|
| AstApp [Ast]
|
||||||
|
|
||||||
makeBaseFunctor ''Ast
|
makeBaseFunctor ''Ast
|
||||||
|
|
||||||
|
@ -30,14 +30,14 @@ parens = between (char '(') (char ')')
|
||||||
-- | A lambda expression.
|
-- | A lambda expression.
|
||||||
lam :: Parser Ast
|
lam :: Parser Ast
|
||||||
lam = do
|
lam = do
|
||||||
vars <- between (char '\\') (char '.') $ name `sepBy1` spaces
|
vars <- between (char '\\') (char '.') $ name `sepBy` spaces
|
||||||
spaces
|
spaces
|
||||||
body <- app
|
body <- app
|
||||||
return $ foldr AstLam body vars
|
return $ AstLam vars body
|
||||||
|
|
||||||
-- | An application expression.
|
-- | An application expression.
|
||||||
app :: Parser Ast
|
app :: Parser Ast
|
||||||
app = foldl1' AstApp <$> safeExpr `sepBy1` spaces
|
app = AstApp <$> safeExpr `sepBy` spaces
|
||||||
|
|
||||||
-- | An expression, but where applications must be surrounded by parentheses,
|
-- | An expression, but where applications must be surrounded by parentheses,
|
||||||
-- | to avoid ambiguity (infinite recursion on `app` in the case where the first
|
-- | to avoid ambiguity (infinite recursion on `app` in the case where the first
|
||||||
|
@ -54,8 +54,9 @@ toExpr = cataReader alg []
|
||||||
return $ case bindingSite of
|
return $ case bindingSite of
|
||||||
Just index -> Var index
|
Just index -> Var index
|
||||||
Nothing -> Free varName
|
Nothing -> Free varName
|
||||||
alg (AstLamF varName body) = Lam varName <$> local (varName :) body
|
alg (AstLamF vars body) = foldr (\v e -> Lam v <$> local (v :) e) body vars
|
||||||
alg (AstAppF f x) = App <$> f <*>x
|
alg (AstAppF [e]) = e
|
||||||
|
alg (AstAppF es) = foldl' App Nil <$> sequenceA es
|
||||||
|
|
||||||
-- | Since applications do not require parentheses and can contain only a single item,
|
-- | Since applications do not require parentheses and can contain only a single item,
|
||||||
-- | the `app` parser is sufficient to parse any expression at all.
|
-- | the `app` parser is sufficient to parse any expression at all.
|
||||||
|
|
Loading…
Reference in New Issue