65 lines
1.6 KiB
Haskell
65 lines
1.6 KiB
Haskell
|
module Ucc where
|
||
|
|
import UccGen
|
||
|
|
import Text.Parsec
|
||
|
|
import Data.Functor.Identity
|
||
|
|
import Control.Applicative hiding ((<|>))
|
||
|
|
import System.IO
|
||
|
|
|
||
|
|
instance Show Intrinsic where
|
||
|
|
show Swap = "swap"
|
||
|
|
show Clone = "clone"
|
||
|
|
show Drop = "drop"
|
||
|
|
show Quote = "quote"
|
||
|
|
show Compose = "compose"
|
||
|
|
show Apply = "apply"
|
||
|
|
|
||
|
|
instance Show Expr where
|
||
|
|
show (E_int i) = show i
|
||
|
|
show (E_quote e) = "[" ++ show e ++ "]"
|
||
|
|
show (E_comp e1 e2) = show e1 ++ " " ++ show e2
|
||
|
|
|
||
|
|
instance Show Value where
|
||
|
|
show (V_quote e) = show (E_quote e)
|
||
|
|
|
||
|
|
type Parser a = ParsecT String () Identity a
|
||
|
|
|
||
|
|
intrinsic :: Parser Intrinsic
|
||
|
|
intrinsic = (<* spaces) $ foldl1 (<|>) $ map (\(s, i) -> try (string s >> return i))
|
||
|
|
[ ("swap", Swap)
|
||
|
|
, ("clone", Clone)
|
||
|
|
, ("drop", Drop)
|
||
|
|
, ("quote", Quote)
|
||
|
|
, ("compose", Compose)
|
||
|
|
, ("apply", Apply)
|
||
|
|
]
|
||
|
|
|
||
|
|
expression :: Parser Expr
|
||
|
|
expression = foldl1 E_comp <$> many1 single
|
||
|
|
where
|
||
|
|
single
|
||
|
|
= (E_int <$> intrinsic)
|
||
|
|
<|> (fmap E_quote $ char '[' *> spaces *> expression <* char ']' <* spaces)
|
||
|
|
|
||
|
|
parseExpression :: String -> Either ParseError Expr
|
||
|
|
parseExpression = runParser expression () "<inline>"
|
||
|
|
|
||
|
|
eval :: [Value] -> Expr -> Maybe [Value]
|
||
|
|
eval s e =
|
||
|
|
case eval_step s e of
|
||
|
|
Err -> Nothing
|
||
|
|
Final s' -> Just s'
|
||
|
|
Middle e' s' -> eval s' e'
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = do
|
||
|
|
putStr "> "
|
||
|
|
hFlush stdout
|
||
|
|
str <- getLine
|
||
|
|
case parseExpression str of
|
||
|
|
Right e ->
|
||
|
|
case eval [] e of
|
||
|
|
Just st -> putStrLn $ show st
|
||
|
|
_ -> putStrLn "Evaluation error"
|
||
|
|
_ -> putStrLn "Parse error"
|
||
|
|
main
|