1import Prelude hiding (succ)
import Data.Functor
import Text.Parsec
import Text.Parsec.String
 
data Expr = V Int       -- Value (Index)
          | L Expr      -- Lambda
          | A Expr Expr -- Application
          deriving Show
 
beta :: Expr -> Expr    -- reduction
beta (A (L v) n)    = beta $ subst 0 v $ beta n
beta (A m n)        = beta $ A (beta m) n
beta e              = e
 
subst :: Int -> Expr -> Expr -> Expr -- substitude
subst v (L w) e     = L (subst (v + 1) w e)
subst v (A m n) e   = A (subst v m e) (subst v n e)
subst v (V n) e | n < v  = V n
                | n == v = subst' 0 v e
                | n > v  = V (n - 1)
                where subst' t v (L w)     = L (subst' (t + 1) v w)
                      subst' t v (A m n)   = A (subst' t v m) (subst' t v n)
                      subst' t v (V n) | n <= t = V n
                                       | n > t  = V (n + v - 1)
 
s = L (L (L (A (A (V 2) (V 0)) (A (V 1) (V 0)))))
k = L (L (V 1))
i = L (V 0)
 
zero = (L (L (V 0)))
succ = (L (L (L (A (V 1) (A (A (V 2) (V 1)) (V 0))))))
cons = (L (L (L (A (A (V 0) (V 2)) (V 1)))))
car  = (L (A (V 0) (L (L (V 1)))))
cdr  = (L (A (V 0) (L (L (V 0)))))
 
 
pExpr, pTerm, pS, pK, pI, pPa :: Parser Expr
pExpr = foldl1 A <$> many1 pTerm
pTerm = pS <|> pK <|> pI <|> pPa
 
pS = char 'S' >> return s
pK = char 'K' >> return k
pI = char 'I' >> return i
pPa = between (char '(') (char ')') pExpr
 
codeToExpr = parse pExpr ""
 
main = case codeToExpr "(SK)K" of
        Left err  -> print err
        Right val -> print (beta val) 

MWltcG9ydCBQcmVsdWRlIGhpZGluZyAoc3VjYykKaW1wb3J0IERhdGEuRnVuY3RvcgppbXBvcnQgVGV4dC5QYXJzZWMKaW1wb3J0IFRleHQuUGFyc2VjLlN0cmluZwoKZGF0YSBFeHByID0gViBJbnQgICAgICAgLS0gVmFsdWUgKEluZGV4KQogICAgICAgICAgfCBMIEV4cHIgICAgICAtLSBMYW1iZGEKICAgICAgICAgIHwgQSBFeHByIEV4cHIgLS0gQXBwbGljYXRpb24KICAgICAgICAgIGRlcml2aW5nIFNob3cKCmJldGEgOjogRXhwciAtPiBFeHByICAgIC0tIHJlZHVjdGlvbgpiZXRhIChBIChMIHYpIG4pICAgID0gYmV0YSAkIHN1YnN0IDAgdiAkIGJldGEgbgpiZXRhIChBIG0gbikgICAgICAgID0gYmV0YSAkIEEgKGJldGEgbSkgbgpiZXRhIGUgICAgICAgICAgICAgID0gZQoKc3Vic3QgOjogSW50IC0+IEV4cHIgLT4gRXhwciAtPiBFeHByIC0tIHN1YnN0aXR1ZGUKc3Vic3QgdiAoTCB3KSBlICAgICA9IEwgKHN1YnN0ICh2ICsgMSkgdyBlKQpzdWJzdCB2IChBIG0gbikgZSAgID0gQSAoc3Vic3QgdiBtIGUpIChzdWJzdCB2IG4gZSkKc3Vic3QgdiAoViBuKSBlIHwgbiA8IHYgID0gViBuCiAgICAgICAgICAgICAgICB8IG4gPT0gdiA9IHN1YnN0JyAwIHYgZQogICAgICAgICAgICAgICAgfCBuID4gdiAgPSBWIChuIC0gMSkKICAgICAgICAgICAgICAgIHdoZXJlIHN1YnN0JyB0IHYgKEwgdykgICAgID0gTCAoc3Vic3QnICh0ICsgMSkgdiB3KQogICAgICAgICAgICAgICAgICAgICAgc3Vic3QnIHQgdiAoQSBtIG4pICAgPSBBIChzdWJzdCcgdCB2IG0pIChzdWJzdCcgdCB2IG4pCiAgICAgICAgICAgICAgICAgICAgICBzdWJzdCcgdCB2IChWIG4pIHwgbiA8PSB0ID0gViBuCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgIHwgbiA+IHQgID0gViAobiArIHYgLSAxKQoKcyA9IEwgKEwgKEwgKEEgKEEgKFYgMikgKFYgMCkpIChBIChWIDEpIChWIDApKSkpKQprID0gTCAoTCAoViAxKSkKaSA9IEwgKFYgMCkKCnplcm8gPSAoTCAoTCAoViAwKSkpCnN1Y2MgPSAoTCAoTCAoTCAoQSAoViAxKSAoQSAoQSAoViAyKSAoViAxKSkgKFYgMCkpKSkpKQpjb25zID0gKEwgKEwgKEwgKEEgKEEgKFYgMCkgKFYgMikpIChWIDEpKSkpKQpjYXIgID0gKEwgKEEgKFYgMCkgKEwgKEwgKFYgMSkpKSkpCmNkciAgPSAoTCAoQSAoViAwKSAoTCAoTCAoViAwKSkpKSkKCgpwRXhwciwgcFRlcm0sIHBTLCBwSywgcEksIHBQYSA6OiBQYXJzZXIgRXhwcgpwRXhwciA9IGZvbGRsMSBBIDwkPiBtYW55MSBwVGVybQpwVGVybSA9IHBTIDx8PiBwSyA8fD4gcEkgPHw+IHBQYQoKcFMgPSBjaGFyICdTJyA+PiByZXR1cm4gcwpwSyA9IGNoYXIgJ0snID4+IHJldHVybiBrCnBJID0gY2hhciAnSScgPj4gcmV0dXJuIGkKcFBhID0gYmV0d2VlbiAoY2hhciAnKCcpIChjaGFyICcpJykgcEV4cHIKCmNvZGVUb0V4cHIgPSBwYXJzZSBwRXhwciAiIgoKbWFpbiA9IGNhc2UgY29kZVRvRXhwciAiKFNLKUsiIG9mCiAgICAgICAgTGVmdCBlcnIgIC0+IHByaW50IGVycgogICAgICAgIFJpZ2h0IHZhbCAtPiBwcmludCAoYmV0YSB2YWwpIA==