-- PCA machine implemented!
-- use like:
-- > ghc --make -o eval Main.hs
-- > ./eval "k(skk)(ss)k"
-- or:
-- ghci Main.hs
-- > run "skkk"
--
-- Note that the parser is hillariously permissive, stripping all non s,k,(,) symbols
-- before starting. It also parses (sk))k (and really shouldn't), so no guarantees
-- about what happens if your string is not a vaild expression. (WHY?)
--
-- ... It does work for all the valid expressions I have tried.

module Main where

import Text.ParserCombinators.Parsec hiding (State)
import System.Environment

main :: IO ()
main = do
         args <- getArgs
         putStrLn . show . run $ (args !! 0)


data PCAExpr = EK | ES | Ap PCAExpr PCAExpr
  deriving (Show)


parseTerm :: Parser PCAExpr
parseTerm = do
              apps <- many1 (parseBr <|> parseS <|> parseK)
              return $ foldl1 Ap apps


parseBr :: Parser PCAExpr
parseBr = do
            char '('
            x <- parseTerm
            char ')'
            return x

parseS :: Parser PCAExpr
parseS = (char 's' <|> char 'S') >> (return ES)

parseK :: Parser PCAExpr
parseK = (char 'k' <|> char 'K') >> (return EK)

-- next, operational semantics of machine

type State = (Code, Value, Stack)

type Code = Item

type Value = Item
https://forge.cpsc.ucalgary.ca/svn/research/pll/papers/Chad/PCAMachine/Main.hs
type Stack = [Item]

data Item = K
          | S
          | K0 Item
          | S0 Item
          | S1 (Item, Item)
          | C0 (Item, Item)
          | C1 (Item)
	  | End
  deriving (Show, Eq)

step :: State -> State
step (K, x, stk)                = (End, (K0 x), stk)
step (S, x, stk)                = (End, (S0 x), stk)
step (S0 x, y, stk)             = (End, (S1 (x,y)), stk)
step (K0 x, y, stk)             = (End, x, stk)
step (S1 (x,y), z, stk)         = (x, z, ((C0 (y,z)) : stk))
step (End, v, (C0 (y,z)) : stk) = (y, z, (C1 v) : stk)
step (End, v, (C1 w) : stk)     = (w, v, stk)

eval :: State -> Item
eval (End, x, []) = x
eval state        = eval (step state)

trace :: State -> IO ()
trace (End, x, []) = do putStrLn (show x)
trace st = do putStrLn (show st)
              trace (step st)

-- schenanigans to ignore parsing errors because It seems like too
-- much trouble.

generateCode :: PCAExpr -> Item -- should just be code, maybe state.
generateCode EK = K
generateCode ES = S
generateCode (Ap t1 t2) = eval ((generateCode t1), (generateCode t2), [])

run :: String -> Item
run = generateCode . erase . (parse parseTerm "error") . (filter cheatyPredicate)

-- our parser is really, really permissive :D

cheatyPredicate :: Char -> Bool
cheatyPredicate 's' = True
cheatyPredicate 'S' = True
cheatyPredicate 'k' = True
cheatyPredicate 'K' = True
cheatyPredicate '(' = True
cheatyPredicate ')' = True
cheatyPredicate _   = False

erase :: Either parseError PCAExpr -> PCAExpr
erase (Left _) = error "that didn't work!"
erase (Right exp) = exp

-- examples

skk = run "skk"

skkk = run "skkk"

ssss = run "ssss"

skss = run "skss"

ssks = run "ssks"

bigex = run "k(skk)(sk)k"

-- the thingy appears to work!