Lambda calculus

app/Main.hs

@@ -1,6 +1,10 @@
 module Main where
 
-import Lib
+import           Base
+import           ChurchBool
+import           ChurchNum
+import           Lib
+import           Tuple
 
 main :: IO ()
 main = someFunc

src/Base.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Base (
+  identity,
+  constant,
+  apply,
+  compose,
+  flip
+) where
+
+-- | Identity function.
+-- id :: a -> a
+-- identity = \x -> x
+identity x = x
+
+-- | Constant function.
+-- const :: a -> b -> a
+-- constant = \x y -> x
+constant x y = x
+
+-- apply :: (t1 -> t2) -> t1 -> t2
+-- apply = \f x -> f x
+apply f x = f x
+
+-- compose :: (t1 -> t2) -> (t3 -> t1) -> t3 -> t2
+-- compose = \x y z -> x ( y (z))
+compose x y z = x ( y ( z ) )
+
+-- flip :: (a -> b -> c) -> b -> a -> c
+-- flip = \f x y -> f y x
+flip f x y = f y x

src/ChurchBool.hs

@@ -0,0 +1,31 @@
+module ChurchBool  where
+import           Base
+import           ChurchNum
+
+-- true :: p1 -> p2 -> p1
+true a b = a
+
+-- false :: p1 -> p2 -> p2
+false a b = b
+
+-- cond :: (t1 -> t2 -> t3) -> t1 -> t2 -> t3
+-- cond = identity
+cond a b c = a b c
+
+-- ((p2 -> p1 -> p3 -> p3) -> (p4 -> p5 -> p4) -> t) -> t
+isZero n = n (Base.constant false) true
+
+-- toNum :: (((t1 -> t2) -> t1 -> t2) -> (p2 -> t3 -> t3) -> t) -> t
+toChurchNum x  = x one zero
+-- unchurch $ toChurchNum $ ChurchBool.isZero zero
+
+-- (t1 -> (p1 -> p2 -> p2) -> t2)
+  -- -> ((p3 -> p4 -> p3) -> (p5 -> p6 -> p6) -> t1) -> t2
+and' a b = cond a (cond b true false) false
+
+-- ((p1 -> p2 -> p1) -> t1 -> t2)
+-- -> ((p3 -> p4 -> p3) -> (p5 -> p6 -> p6) -> t1) -> t2
+or' a b = cond a true (cond b true false)
+
+-- not' :: ((p1 -> p2 -> p2) -> (p3 -> p4 -> p3) -> t) -> t
+not' a = cond a false true

src/ChurchNum.hs

@@ -0,0 +1,53 @@
+module ChurchNum (
+  zero, -- point free
+  one,  -- point free
+  two,  -- point free
+  inc,  -- point free
+  dec ,
+  add,
+  sub,
+  mul,  -- point free
+  church,
+  unchurch,-- point free
+  isZero
+) where
+
+import           Base
+import           Combinators
+
+-- zero :: p2 -> t3 -> t3
+zero = Base.flip Base.constant
+
+-- one :: (t1 -> t2) -> t1 -> t2
+one = apply
+
+-- two :: (t -> t) -> t -> t
+-- @help: can't figure out point free version (cause s-combinator is not)
+-- two x y = x $ x y
+two = s Base.compose Base.identity
+
+-- inc :: Num a => a -> a
+inc = (+1)
+
+-- dec :: Num a => a -> a
+-- dec x = x - 1
+dec = Base.flip (-) 1
+
+-- add :: Num a => a -> a -> a
+add = (+)
+
+-- sub :: Num a => a -> a -> a
+sub = (-)
+
+-- mult :: Num a => a -> a -> a
+mul a b = church a (+b) 0
+
+-- church :: (Eq t1, Num t1) => t1 -> (t2 -> t2) -> t2 -> t2
+church 0 = zero
+church n = \f x -> f $ church (n -1 ) f x
+
+-- unchurch :: ((Integer -> Integer) -> Integer -> t3) -> t3
+unchurch = Base.flip ($ (1 +)) 0
+
+-- isZero :: (Eq a, Num a) => a -> Bool
+isZero = (==) 0

src/Combinators.hs

@@ -0,0 +1,5 @@
+module Combinators where
+
+s f g x = f x (g x) -- S-combinator
+identity x = x -- I-combinator
+constant x y = y -- K -combinator

src/Tuple.hs

@@ -0,0 +1,24 @@
+module Tuple where
+
+import           Base
+
+constant' = Base.constant
+flip' = Base.flip
+
+-- tuple' :: t1 -> t2 -> (t1 -> t2 -> t3) -> t3
+tuple' a b f = f a b
+
+-- first' :: ((p1 -> p2 -> p1) -> b) -> b
+first' = ($ constant')
+
+-- second' :: ((p2 -> t3 -> t3) -> t) -> t
+second' t = t $ flip' constant'
+
+-- swap' :: ((p2 -> p2 -> p2) -> t1) -> (t1 -> t1 -> t2) -> t2
+swap' t = tuple' (second' t) (first' t)
+
+-- curry' :: (((t1 -> t2 -> t3) -> t3) -> t4) -> t1 -> t2 -> t4
+curry' f = f $ tuple'
+
+-- t1 -> (t1 -> t2) -> t2
+uncurry' f t = t f