103 lines
2.3 KiB
Haskell
103 lines
2.3 KiB
Haskell
-- 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
|