```-- Simple interpreter for combinator calculi ``` ``` ``` ```module Main where ``` ``` ``` ```import System.IO ``` ``` ``` ```data Value = Atom Char | Compound [Value] ``` ``` deriving (Eq) ``` ``` ``` ```instance Show Value where ``` ``` show (Atom c) = [c] ``` ``` show (Compound vs) = "(" ++ concatMap show vs ++ ")" ``` ``` ``` ```main :: IO () ``` ```main = do ``` ``` putStr "λ> " ``` ``` hFlush stdout ``` ``` input <- getLine ``` ``` stepEval \$ parse input ``` ``` main ``` ``` ``` ```stepEval :: [Value] -> IO [Value] ``` ```stepEval [] = return [] ``` ```stepEval (hed:rest) = do ``` ``` putStr \$ "~> " ++ (concatMap show (hed:rest)) ``` ``` hFlush stdout ``` ``` getLine ``` ``` case rest of ``` ``` [] -> return [hed] ``` ``` _ -> ``` ``` case hed of ``` ``` Atom combinator -> ``` ``` case combinator of ``` ``` 'I' -> stepEval rest ``` ``` 'S' -> apply s rest ``` ``` 'K' -> apply k rest ``` ``` 'B' -> apply b rest ``` ``` 'C' -> apply c rest ``` ``` 'W' -> apply w rest ``` ``` 'M' -> apply m rest ``` ``` 'T' -> apply t rest ``` ``` _ -> return (hed:rest) ``` ``` Compound expr -> do ``` ``` stepEval \$ expr ++ rest ``` ``` ``` ```apply :: Combinator -> [Value] -> IO [Value] ``` ```apply f vals = case f vals of ``` ``` Just xs -> stepEval xs ``` ``` Nothing -> do ``` ``` hPutStrLn stderr "Invalid application of combinator." ``` ``` stepEval [] ``` ``` ``` ```-- Parsing ``` ``` ``` ```parse s = parseAux s [] ``` ``` ``` ```-- uhhhh ``` ```parseAux :: String -> [Value] -> [Value] ``` ```parseAux [] v = reverse v ``` ```parseAux (x:rest) v ``` ``` | x == '(' = parseAux newRest (newVal:v) ``` ``` | otherwise = parseAux rest (Atom x:v) ``` ``` where (newRest, newVal) = compound rest [] ``` ``` compound :: String -> [Value] -> (String, Value) ``` ``` compound [] _ = error "parse error: unclosed parenthesis" ``` ``` compound (')':s) ret = (s, Compound \$ reverse ret) ``` ``` compound ('(':s) ret = ``` ``` let (r, v) = compound s [] in ``` ``` compound r (v:ret) ``` ``` compound (x:s) ret = compound s (Atom x:ret) ``` ``` ``` ```-- Combinators ``` ``` ``` ```type Combinator = [Value] -> Maybe [Value] ``` ``` ``` ```-- Sxyz ~> xz(yz) ``` ```s (x:y:z:rest) = Just \$ x:z:Compound [y,z]:rest ``` ```s _ = Nothing ``` ``` ``` ```-- Kxy ~> y ``` ```k (x:y:rest) = Just \$ x:rest ``` ```k _ = Nothing ``` ``` ``` ```-- Bxyz ~> x(yz) ``` ```b (x:y:z:rest) = Just \$ x:Compound [y,z]:rest ``` ```b _ = Nothing ``` ``` ``` ```-- Cxyz ~> xzy ``` ```c (x:y:z:rest) = Just \$ x:z:y:rest ``` ```c _ = Nothing ``` ``` ``` ```-- Wxy ~> xyy ``` ```w (x:y:rest) = Just \$ x:y:y:rest ``` ```w _ = Nothing ``` ``` ``` ```-- Mx ~> xx ``` ```m (x:rest) = Just \$ x:x:rest ``` ```m _ = Nothing ``` ``` ``` ```-- Txy ~> yx ``` ```t (x:y:rest) = Just \$ y:x:rest ``` ```t _ = Nothing ```