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