Skip to content

Instantly share code, notes, and snippets.

@matsubara0507
Created October 28, 2020 02:08
Show Gist options
  • Save matsubara0507/c678c9d31e1b939b058b80087641da0d to your computer and use it in GitHub Desktop.
Save matsubara0507/c678c9d31e1b939b058b80087641da0d to your computer and use it in GitHub Desktop.
SKI
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) ++ ")"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment