SKI

ski.hs

import Data.String.Utils (replace)
import Data.Char (isDigit)

data CLTerm = Var String
            | I
            | K
            | S
            | Cons CLTerm CLTerm
instance Show CLTerm where
    show I          = "I"
    show K          = "K"
    show S          = "S"
    show (Var s)    = s
    show (Cons x y) = concat ["(", show x, " ", show y, ")"]

reductions :: CLTerm -> CLTerm
reductions term
    | Just term' <- reduction term = reductions term'
    | otherwise                    = term

reduction :: CLTerm -> Maybe CLTerm
reduction (Cons I x)                   = Just x
reduction (Cons (Cons K x) y)          = Just x
reduction (Cons (Cons (Cons S x) y) z) = Just (Cons (Cons x z) (Cons y z))
reduction (Cons x y)
    | Just x' <- reduction x = Just (Cons x' y )
    | Just y' <- reduction y = Just (Cons x  y')
    | otherwise = Nothing
reduction _                            = Nothing

str2clt :: String -> Maybe CLTerm
str2clt s = fst $ str2clt' (Nothing, replaceKeywords $ words $ replacePar s)
    where
      str2clt' :: (Maybe CLTerm, [String]) -> (Maybe CLTerm, [String])
      str2clt' (term     , []    ) = (term, [])
      str2clt' (Nothing  , "(":xs) = str2clt' $ str2clt' (Nothing, xs)
      str2clt' (Nothing  , x:xs  ) = str2clt' (Just (convert x), xs)
      str2clt' (Just term, "(":xs) =
          let (Just term', xs') = str2clt' (Nothing, xs) in
          str2clt' (Just (Cons term term'), xs')
      str2clt' (Just term, ")":xs) = (Just term, xs)
      str2clt' (Just term, x:xs  ) =
          str2clt' (Just (Cons term (convert x)), xs)

convert :: String -> CLTerm
convert "I" = I
convert "K" = K
convert "S" = S
convert  s  = Var s

replacePar :: String -> String
replacePar  = replace "(" " ( " . replace ")" " ) "

replaceKeywords :: [String] -> [String]
replaceKeywords  = concat . map (words . replacePar . keywords)
    where
      keywords "T"    = "K"
      keywords "F"    = "(K I)"
      keywords "NOT"  = "(S (S I (K (K I))) (K K))"
      keywords "OR"   = "(S I (K K))"
      keywords "AND"  = "(S S (K (K (K I))))"
      keywords "ZERO" = "(K I)"
      keywords "ONE"  = "I"
      keywords "SUCC" = "(S (S (K S) K))"
      keywords "PLUS" = "(S I (K (S (S (K S) K))))"
      keywords "MULT" = "(S (S (K S) (S (K (S I)) (S (K K) (S I (K (S (S (K S) K))))))) (K (K (K I))))"
      keywords "POW"  = "(S (S (K S) (S (K (S I)) (S (K K) (S (S (K S) (S (K (S I)) (S (K K) (S I (K (S (S (K S) K))))))) (K (K (K I))))))) (K (K I)))"
      keywords s
          | and $ map isDigit s = unwords $ replaceKeywords
                            $ words $ replacePar $ int2keyword $ read s
          | otherwise = s

int2keyword :: Int -> String
int2keyword 0 = "ZERO"
int2keyword 1 = "ONE"
int2keyword n = "(SUCC " ++ int2keyword (n-1) ++ ")"