module StackLang where

import Prelude hiding (Num)

--
-- * Syntax of StackLang
--

-- Grammar for StackLang:
-- 
--    num ::= (any integer)
--   bool ::= `true`  |  `false`
--   prog ::= cmd*
--    cmd ::= num           push a number on the stack
--         |  bool          push a boolean on the stack
--         |  `+`           add the top two numbers on the stack
--         |  `*`           multiply the top two numbers on the stack
--         |  `<=`          is the top number LEQ the second number on the stack
--         |  `if`   prog   if the value on the top is true, then run
--            `else` prog   the first program, else run the second
--            `end`


-- 1. Encode the above grammar as a set of Haskell data types

type Num = Int

type Prog = [Cmd]

data Cmd
   = PushN Num
   | PushB Bool
   | Add
   | Mul
   | LEq
   | IfElse Prog Prog
  deriving (Eq,Show)


-- 2. Write the following StackLang program as a Haskell value:
--
--   3 4 + 5 <=
--
ex1 :: Prog
ex1 = [PushN 3, PushN 4, Add, PushN 5, LEq]


-- 3. Write a StackLang program that:
--     * checks whether 3 is less than or equal to 4
--     * if so, returns the result of adding 5 and 6
--     * if not, returns the value false
--    First write it in concrete syntax, then in abstract syntax
--    as a Haskell value.
--
--    4 3 <= if 5 6 + else false end
--
ex2 :: Prog
ex2 = [PushN 4, PushN 3, LEq,
       IfElse [PushN 5, PushN 6, Add] [PushB False]]


-- 4. Write a Haskell function that takes two arguments x and y
--    and generates a StackLang program that adds both x and y to
--    the number on the top of the stack.
addXY :: Num -> Num -> Prog
addXY x y = [PushN x, PushN y, Add, Add]
-- addXY x y = [PushN x, Add, PushN y, Add]


-- 5. Write a Haskell function that takes a list of integers and
--    generates a StackLang program that computes the sum of all the
--    integers.
sumNs :: [Int] -> Prog
sumNs []     = [PushN 0]
sumNs (i:is) = sumNs is ++ [PushN i, Add]
-- sumNs (i:is) = (PushN i : sumNs is) ++ [Add]


--
-- * Operational Semantics of StackLang (now!)
--

-- 6. Identify/define the machine state for a StackLang program.

-- data Either a b
--    = Left a
--    | Right b

type Stack = [Either Bool Int]
-- Example: [Left True, Right 3, Right 4]

type State = (Prog, Stack)


-- 7. Define a one-step reduction relation for a StackLang program,
--    and implement it as a function.
step :: State -> Maybe State
-- reduction rules
step (PushN n : p, s) = Just (p, Right n : s)
step (PushB b : p, s) = Just (p, Left b : s)
step (Add : p, Right n : Right m : s) = Just (p, Right (n + m) : s)
step (Mul : p, Right n : Right m : s) = Just (p, Right (n * m) : s)
step (LEq : p, Right n : Right m : s) = Just (p, Left (n <= m) : s)
step (IfElse t e : p, Left True  : s) = Just (t ++ p, s)
step (IfElse t e : p, Left False : s) = Just (e ++ p, s)
-- no congruence rules!
-- error cases
step _ = Nothing


-- 8. Implement the reflexive, transitive closure of the one-step
--    reduction to evaluate a StackLang program.
steps :: State -> Maybe State
-- reflexive case
steps ([],s) = Just ([],s)
-- transitive case
steps u      = case step u of
                 Just u' -> steps u'
                 Nothing -> Nothing


-- | Run a program on an initially empty stack.
--
--   >>> runOpSem ex2
--   Just [Right 11]
--
--   >>> runOpSem (sumNs [1..10])
--   Just [Right 55]
--
--   >>> runOpSem [PushN 3, Add, PushN 4]
--   Nothing
--
runOpSem :: Prog -> Maybe Stack
runOpSem p = case steps (p,[]) of
               Just ([],s) -> Just s
               _ -> Nothing


--
-- * Denotational Semantics of StackLang (even later)
--

-- 9. Identify/define a semantics domain for Cmd and for Prog.
--
--    Domain: Stack -> Maybe Stack

-- 10. Define the semantics of a StackLang command (ignore If at first).
cmd :: Cmd -> Stack -> Maybe Stack
cmd (PushN n)    s                       = Just (Right n : s)
cmd (PushB b)    s                       = Just (Left b : s)
cmd Add          (Right i : Right j : s) = Just (Right (i+j) : s)
cmd LEq          (Right i : Right j : s) = Just (Left (i <= j) : s)
cmd (IfElse t e) (Left True  : s)        = prog t s
cmd (IfElse t e) (Left False : s)        = prog e s
cmd _ _ = Nothing

-- 11. Define the semantics of a StackLang program.
prog :: Prog -> Stack -> Maybe Stack
prog []     s = Just s
prog (c:cs) s = case cmd c s of
                  Just s' -> prog cs s'
                  Nothing -> Nothing


-- | Run a program on an initially empty stack.
--
--   >>> runDenSem ex2
--   Just [Right 11]
--
--   >>> runDenSem (sumNs [1..10])
--   Just [Right 55]
--
--   >>> runDenSem [PushN 3, Add, PushN 4]
--   Nothing
--
runDenSem :: Prog -> Maybe Stack
runDenSem p = prog p []