module Eval where
import AbsSRL
import AbsRL hiding (RL,Rlblk,Exp(..),Ident(..),Step(..))
import qualified AbsRL as RL (RL,Rlblk,Exp(..),Ident(..),Step(..))
import Data.Maybe(fromMaybe)

type Svalue = [Integer]
data Value = Vint Integer | Vsvalue Svalue
           deriving (Eq, Ord, Show, Read)
data Lvalue = Lstring String | Larr String Value
            deriving (Eq, Ord, Show, Read)
type Store = [(Lvalue,Value)]

vTrue = Vint 1
vFalse = Vint 0
isTrue x = x /= vFalse
isFalse x = x == vFalse

-- |Expの式の評価を行う関数
expeval :: Store -> Exp -> Value
expeval st e = case e of
  Econ n -> Vint n                                                                    -- c
  Evar (Ident x) -> let Just v = lookup (Lstring x) st in v                           -- x
  Earr (Evar (Ident x)) e1 -> let Just v = lookup (Larr x (expeval st e1)) st in v    -- x[e]
  Exor e1 e2 -> xor (expeval st e1) (expeval st e2)                                   -- ^
  Eeq  e1 e2 -> bool st (==) e1 e2                                                    -- =
  Ene  e1 e2 -> bool st (/=) e1 e2                                                    -- /=
  Elt  e1 e2 -> bool st (<) e1 e2                                                     -- <
  Egt  e1 e2 -> bool st (>) e1 e2                                                     -- >
  Ele  e1 e2 -> bool st (>=) e1 e2                                                    -- >=
  Ege  e1 e2 -> bool st (<=) e1 e2                                                    -- <=
  Eadd e1 e2 -> calc st (+) e1 e2                                                     -- +
  Emin e1 e2 -> calc st (-) e1 e2                                                     -- -
  Emul e1 e2 -> calc st (*) e1 e2                                                     -- *
  Ediv e1 e2 -> calc st div e1 e2                                                     -- /
  Etop (Evar (Ident x)) -> let Just (Vsvalue a) = lookup (Lstring x) st               -- top
                           in Vint (head a)
  Eempty (Evar (Ident x)) -> let Just (Vsvalue a) = lookup (Lstring x) st in          -- empty
                             if null a then vTrue else vFalse

-- |排他的論理和（^）を求める関数
xor :: Value -> Value -> Value
xor v1 v2 = if isFalse v1 && isFalse v2 || isTrue v1 && isTrue v2
            then vFalse
            else vTrue

-- |真偽（true /= 0 , false == 0）を求める関数
bool st op e1 e2 = if expeval st e1 `op` expeval st e2
                   then vTrue
                   else vFalse

-- |v1とv2にopの計算をする関数
liftInt op (Vint v1) (Vint v2) = Vint (v1 `op` v2)

-- |(+,-,*)を計算する関数
calc st op e1 e2 = liftInt op (expeval st e1) (expeval st e2)

{-
expevalのテスト
expeval [] (Econ 5)
Vint 5
expeval [(Lstring "x",Vint 5),(Lstring "r",Vint 7)] (Evar ((Ident "x")))
Vint 5
expeval [(Larr "x" (Vint 0) , Vint 5) , (Larr "y" (Vint 1) , Vint 10)] (Earr (Evar (Ident "x")) (Econ 0))
Vint 5
expeval [] (Exor (Econ 1) (Econ 0))
Vint 1
expeval [] (Ele (Econ 3) (Econ 5))
Vint 0
expeval [] (Ege (Econ 3) (Econ 5))
Vint 1
expeval [] (Eadd (Econ 3) (Econ 5))
Vint 8
expeval [] (Emin (Econ 3) (Econ 5))
Vint (-2)
expeval [] (Emul (Econ 3) (Econ 5))
Vint 15
expeval [] (Ediv (Econ 15) (Econ 5))
Vint 3
expeval [(Lstring "x", Vsvalue [77,2,3,4]),(Lstring "y", Vsvalue [5,6,7,8])] (Etop (Evar (Ident "x")))
Vint 77
expeval [(Lstring "x", Vsvalue [1,2,3,4]) , (Lstring "y", Vsvalue [5,6,7,8])] (Eempty (Evar (Ident "x")))
Vint 0
expeval [(Lstring "x", Vsvalue []) , (Lstring "y", Vsvalue [5,6,7,8])] (Eempty (Evar (Ident "x")))
Vint 1
-}

-- |Stepを評価する関数
stepeval :: Store -> Step -> Store
stepeval st s = case s of
  SasnAdd (Ident x) e -> asnvarcalc st (+) (Lstring x) (expeval st e)                      -- x += e
  SasnMin (Ident x) e -> asnvarcalc st (-) (Lstring x) (expeval st e)                      -- x -= e
  SasnXor (Ident x) e -> asnvarXor st (Lstring x) (expeval st e)                           -- x ^= e
  SasnArrAdd (Ident x) e1 e2 -> asnvarcalc st (+) (Larr x (expeval st e1)) (expeval st e2) -- x[e] += e
  SasnArrMin (Ident x) e1 e2 -> asnvarcalc st (-) (Larr x (expeval st e1)) (expeval st e2) -- x[e] -= e
  SasnArrXor (Ident x) e1 e2 -> asnvarXor st (Larr x (expeval st e1)) (expeval st e2)      -- x[e] ^= e
  Sskip -> st                                                                              -- skip
  Spush (Ident x1) (Ident x2) -> let Just (Vsvalue a) = lookup (Lstring x1) st             -- push
                                     Just (Vsvalue b) = lookup (Lstring x2) st
                                 in pusheval st a b x1 x2
  Spop (Ident x1) (Ident x2) -> let Just (Vint a) = lookup (Lstring x1) st                 -- pop
                                    Just (Vsvalue b) = lookup (Lstring x2) st
                                in popeval st a b x1 x2

-- |(x += e , x -= e)を計算する関数
asnvarcalc [] op x c = []
asnvarcalc ((a,b):xs) op x c = (if a /= x then (a,b) else (a, liftInt op b c)) :
                               asnvarcalc xs op x c

-- |(x ^= e)を計算する関数
asnvarXor :: Store -> Lvalue -> Value -> Store
asnvarXor [] x c = []
asnvarXor ((a,b):xs) x c = if a /= x
                           then (a,b) : asnvarXor xs x c
                           else
                             let z = xor b (xor b c)
                             in (a,z) : asnvarXor xs x c

-- |pushを行う関数
pusheval :: Store -> [Integer] -> [Integer] -> String -> String -> Store
pusheval [] a b x1 x2 = []
pusheval ((Lstring v, Vsvalue w):xs) a b x1 x2 = if v == x2
                                                          then (Lstring v,Vsvalue(a ++ b)) : pusheval xs a b x1 x2
                                                          else
                                                            if v == x1
                                                            then (Lstring v,Vint 0) : pusheval xs a b x1 x2
                                                            else (Lstring v, Vsvalue w) : pusheval xs a b x1 x2

-- |popを行う関数
popeval :: Store -> Integer -> [Integer] -> String -> String -> Store
popeval [] a b x1 x2 = []
popeval ((Lstring v, Vsvalue w):xs) a (b:bs) x1 x2 = if x2 == v
                                                     then (Lstring v,Vsvalue bs) : popeval xs a (b:bs) x1 x2
                                                     else (Lstring v, Vsvalue w) : popeval xs a (b:bs) x1 x2
popeval ((Lstring v, Vint w):xs) a (b:bs) x1 x2 = if x1 == v
                                                  then (Lstring v,Vsvalue [b]) : popeval xs a (b:bs) x1 x2
                                                  else (Lstring v, Vint w) : popeval xs a (b:bs) x1 x2

{-
stepevalのテスト
stepeval [(Lstring "x",Vint 5) , (Lstring "y",Vint 10), (Lstring "x",Vint 10)] (SasnAdd (Ident "x") (Econ 3))
[(Lstring "x",Vint 8),(Lstring "y",Vint 10),(Lstring "x",Vint 13)]
stepeval [(Lstring "x",Vint 5) , (Lstring "y",Vint 10), (Lstring "z",Vint 10)] (SasnMin (Ident "x") (Econ 3))
[(Lstring "x",Vint 2),(Lstring "y",Vint 10),(Lstring "z",Vint 10)]
stepeval [(Lstring "x",Vint 5) , (Lstring "y",Vint 10), (Lstring "z",Vint 10)] (SasnXor (Ident "x") (Econ 0))
[(Lstring "x",Vint 0),(Lstring "y",Vint 10),(Lstring "z",Vint 10)]
stepeval [(Larr "x" (Vint 0) , Vint 10) , (Larr "y" (Vint 1) , Vint 20) , (Larr "x" (Vint 2) , Vint 30)] (SasnArrAdd (Ident "x") (Econ 0) (Econ 7))
[(Larr "x" (Vint 0),Vint 17),(Larr "y" (Vint 1),Vint 20),(Larr "x" (Vint 2),Vint 30)]
stepeval [(Larr "x" (Vint 0) , Vint 10) , (Larr "y" (Vint 1) , Vint 20) , (Larr "x" (Vint 2) , Vint 30)] (SasnArrMin (Ident "x") (Econ 0) (Econ 7))
[(Larr "x" (Vint 0),Vint 3),(Larr "y" (Vint 1),Vint 20),(Larr "x" (Vint 2),Vint 30)]
stepeval [(Larr "x" (Vint 0) , Vint 10) , (Larr "y" (Vint 1) , Vint 20) , (Larr "x" (Vint 2) , Vint 30)] (SasnArrXor (Ident "x") (Econ 0) (Econ 7))
[(Larr "x" (Vint 0),Vint 1),(Larr "y" (Vint 1),Vint 20),(Larr "x" (Vint 2),Vint 30)]
stepeval [(Larr "x" (Vint 0) , Vint 10) , (Larr "y" (Vint 1) , Vint 20) , (Larr "x" (Vint 2) , Vint 30)] (Sskip)
[(Larr "x" (Vint 0),Vint 10),(Larr "y" (Vint 1),Vint 20),(Larr "x" (Vint 2),Vint 30)]
stepeval [(Lstring "x", Vsvalue [1,2,3,4]) , (Lstring "y" , Vsvalue [5,6,7,8])] (Spush (Ident "x") (Ident "y"))
[(Lstring "x",Vint 0),(Lstring "y",Vsvalue [1,2,3,4,5,6,7,8])]
stepeval [(Lstring "x", Vint 0) , (Lstring "y" , Vsvalue [5,6,7,8])] (Spop (Ident "x") (Ident "y"))
[(Lstring "x",Vsvalue [5]),(Lstring "y",Vsvalue [6,7,8])]
-}

-- |blkを評価する関数
blkeval :: Store -> [Blk] -> Store
blkeval st bs = foldl blkeval1 st bs
  where blkeval1 st b = case b of
          Bstep s -> stepeval st s
          Bif e1 b1 b2 e2 -> let v1  = expeval st e1
                                 st1 = blkeval st b1
                                 st2 = blkeval st b2
                                 v2  = expeval st1 e2
                                 v2' = expeval st2 e2 in
                             if isTrue v1 && isTrue v2
                               then st1
                               else if isFalse v2'
                               then st2
                               else error "error e2" --例外処理
          Bfrom e1 b1 b2 e2 -> if isTrue (expeval st e1) then
                                 let st2 = blkeval st b1
                                 in  loop st2 (e1,b1,b2,e2)
                               else error "error e1" --例外処理

-- |loop計算を行う関数
loop st (e1,b1,b2,e2)
  | isTrue  (expeval st  e2) = st
  | isFalse (expeval st2 e1) = loop st3 (e1,b1,b2,e2)
  | otherwise = error "error e1" --例外処理
  where st2 = blkeval st  b2
        st3 = blkeval st2 b1

-- |SRLを評価する関数
srleval :: Store -> SRL -> Store
srleval st (ESRL p) = blkeval st p

-- |型RL.IdentをIdentへ変換する関数
transId (RL.Ident x) = Ident x

-- |型RL.ExpをExpへ変換する関数
transExp :: RL.Exp -> Exp
transExp e = case e of
  RL.Etop e1 -> Etop (transExp e1)
  RL.Eempty e1 -> Eempty (transExp e1)
  RL.Exor e1 e2 -> Exor (transExp e1) (transExp e2)
  RL.Eeq e1 e2 -> Eeq (transExp e1) (transExp e2)
  RL.Ene e1 e2 -> Ene (transExp e1) (transExp e2)
  RL.Elt e1 e2 -> Elt (transExp e1) (transExp e2)
  RL.Egt e1 e2 -> Egt (transExp e1) (transExp e2)
  RL.Ele e1 e2 -> Ele (transExp e1) (transExp e2)
  RL.Ege e1 e2 -> Ege (transExp e1) (transExp e2)
  RL.Eadd e1 e2 -> Eadd (transExp e1) (transExp e2)
  RL.Emin e1 e2 -> Emin (transExp e1) (transExp e2)
  RL.Emul e1 e2 -> Emul (transExp e1) (transExp e2)
  RL.Ediv e1 e2 -> Ediv (transExp e1) (transExp e2)
  RL.Earr e1 e2 -> Earr (transExp e1) (transExp e2)
  RL.Econ e -> Econ e
  RL.Evar x -> Evar (transId x)

-- |型RL.Stepを型stepへ変換する関数
transStep :: RL.Step -> Step
transStep s = case s of
  RL.SasnAdd x e -> SasnAdd (transId x) (transExp e)
  RL.SasnMin x e -> SasnMin (transId x) (transExp e)
  RL.SasnXor x e -> SasnXor (transId x) (transExp e)
  RL.SasnArrAdd x e1 e2 -> SasnArrAdd (transId x) (transExp e1) (transExp e2)
  RL.SasnArrMin x e1 e2 -> SasnArrMin (transId x) (transExp e1) (transExp e2)
  RL.SasnArrXor x e1 e2 -> SasnArrXor (transId x) (transExp e1) (transExp e2)
  RL.Spush x y -> Spush (transId x) (transId y)
  RL.Spop x y -> Spop (transId x) (transId y)
  RL.Sskip -> Sskip

-- |Stepのリストを評価する関数
steplist :: Store -> [Step] -> Store
steplist st [] = st
steplist st (a:al) = steplist (stepeval st a) al

-- |型fromのラベル,entryをStringに変換する関数
fromstring :: Store -> From -> String
fromstring st k = case k of
  Fentry -> "entry"
  Ffrom (RL.Ident l) -> l
  Ffi e (RL.Ident l1) (RL.Ident l2) -> if isTrue (expeval st (transExp e))
                                       then l1
                                       else l2

-- |型jumpのラベル,exitをStringに変換する関数
jumpstring :: Store -> Jump -> String
jumpstring st j = case j of
  Jexit -> "exit"
  Jgoto (RL.Ident l) -> l
  Jif e (RL.Ident l1) (RL.Ident l2) -> if isTrue (expeval st (transExp e))
                                       then l1
                                       else l2

-- |[Rlblk]のリストから指定のラベルを探す関数
rlookup bs l = fromMaybe undefined $ lookup l $ map (\b@(Brlblk (RL.Ident i) _ _ _) -> (i,b)) bs

-- |指定した要素を１つ実行する関数
block (st,(l1,l2)) r = let Brlblk (RL.Ident i) k s l3 = rlookup r l2
                           st2 = steplist st (map transStep s)
                       in (st2,(l2,(jumpstring st l3)))

-- |RLを評価する関数（l2がexitとなった場合、終了する）
rleval2 (st,(l1,l2)) r = let (st2,(l3,l4)) = block (st,(l1,l2)) r in
                          if l4 == "exit"
                          then st2
                          else (rleval2 (st2,(l3,l4))r)

-- |RLを評価する関数
rleval :: Store -> RL.RL -> Store
rleval st (ERL r) = let Brlblk (RL.Ident l1) en _ _ = head r in
                    rleval2 (st,(fromstring st en,l1)) r

{-
（srleval , rlevalのテスト）
◯skip , skip
srleval [(Lstring "x",Vint 5) , (Lstring "y",Vint 10), (Lstring "z",Vint 10)] (ESRL [Bstep (AbsSRL.Sskip) , Bstep (AbsSRL.Sskip)])
[(Lstring "x",Vint 5),(Lstring "y",Vint 10),(Lstring "z",Vint 10)]
rleval [(Lstring "x",Vint 5) , (Lstring "y",Vint 10), (Lstring "z",Vint 10)] (ERL [Brlblk (RL.Ident "l0") Fentry [] (Jgoto (RL.Ident "l1")),Brlblk (RL.Ident "l1") (Ffrom (RL.Ident "l0")) [RL.Sskip] (Jgoto (RL.Ident "l4")),Brlblk (RL.Ident "l4") (Ffrom (RL.Ident "l1")) [] (Jgoto (RL.Ident "l5")),Brlblk (RL.Ident "l5") (Ffrom (RL.Ident "l4")) [RL.Sskip] (Jgoto (RL.Ident "l2")),Brlblk (RL.Ident "l2") (Ffrom (RL.Ident "l5")) [] (Jgoto (RL.Ident "l3")),Brlblk (RL.Ident "l3") (Ffrom (RL.Ident "l2")) [] Jexit])
[(Lstring "x",Vint 5),(Lstring "y",Vint 10),(Lstring "z",Vint 10)]
◯if y=5 then x += 3 else x -= 3 fi y = 5
(SRL)
srleval [(Lstring "x",Vint 10) , (Lstring "y",Vint 10), (Lstring "z",Vint 10)] (ESRL [Bif (Eeq (Evar (Ident "y")) (Econ 5)) [Bstep (SasnAdd (Ident "x") (Econ 3))] [Bstep (SasnMin (Ident "x") (Econ 3))] (Eeq (Evar (Ident "y")) (Econ 5))])
[(Lstring "x",Vint 7),(Lstring "y",Vint 10),(Lstring "z",Vint 10)]
(RL)
rleval [(Lstring "x",Vint 10) , (Lstring "y",Vint 10), (Lstring "z",Vint 10)] (ERL [Brlblk (RL.Ident "l0") Fentry [] (Jgoto (RL.Ident "l1")),Brlblk (RL.Ident "l1") (Ffrom (RL.Ident "l0")) [] (Jif (RL.Eeq (RL.Evar (RL.Ident "y")) (RL.Econ 5)) (RL.Ident "l4") (RL.Ident "l6")),Brlblk (RL.Ident "l2") (Ffi (RL.Eeq (RL.Evar (RL.Ident "y")) (RL.Econ 5)) (RL.Ident "l5") (RL.Ident "l7")) [] (Jgoto (RL.Ident "l3")),Brlblk (RL.Ident "l4") (Ffrom (RL.Ident "l1")) [RL.SasnAdd (RL.Ident "x") (RL.Econ 3)] (Jgoto (RL.Ident "l5")),Brlblk (RL.Ident "l5") (Ffrom (RL.Ident "l4")) [] (Jgoto (RL.Ident "l2")),Brlblk (RL.Ident "l6") (Ffrom (RL.Ident "l1")) [RL.SasnMin (RL.Ident "x") (RL.Econ 3)] (Jgoto (RL.Ident "l7")),Brlblk (RL.Ident "l7") (Ffrom (RL.Ident "l6")) [] (Jgoto (RL.Ident "l2")),Brlblk (RL.Ident "l3") (Ffrom (RL.Ident "l2")) [] Jexit])
[(Lstring "x",Vint 7),(Lstring "y",Vint 10),(Lstring "z",Vint 10)]
◯if y=5 then x += 3 else x -= 3 fi y = 5 , skip
(SRL)
srleval [(Lstring "x",Vint 10) , (Lstring "y",Vint 10), (Lstring "z",Vint 10)] (ESRL [Bif (Eeq (Evar (Ident "y")) (Econ 5)) [Bstep (SasnAdd (Ident "x") (Econ 3))] [Bstep (SasnMin (Ident "x") (Econ 3))] (Eeq (Evar (Ident "y")) (Econ 5)),Bstep (Sskip)])
[(Lstring "x",Vint 7),(Lstring "y",Vint 10),(Lstring "z",Vint 10)]
(RL)
rleval [(Lstring "x",Vint 10) , (Lstring "y",Vint 10), (Lstring "z",Vint 10)] (ERL [Brlblk (RL.Ident "l0") Fentry [] (Jgoto (RL.Ident "l1")),Brlblk (RL.Ident "l1") (Ffrom (RL.Ident "l0")) [] (Jif (RL.Eeq (RL.Evar (RL.Ident "y")) (RL.Econ 5)) (RL.Ident "l6") (RL.Ident "l8")),Brlblk (RL.Ident "l4") (Ffi (RL.Eeq (RL.Evar (RL.Ident "y")) (RL.Econ 5)) (RL.Ident "l7") (RL.Ident "l9")) [] (Jgoto (RL.Ident "l5")),Brlblk (RL.Ident "l6") (Ffrom (RL.Ident "l1")) [RL.SasnAdd (RL.Ident "x") (RL.Econ 3)] (Jgoto (RL.Ident "l7")),Brlblk (RL.Ident "l7") (Ffrom (RL.Ident "l6")) [] (Jgoto (RL.Ident "l4")),Brlblk (RL.Ident "l8") (Ffrom (RL.Ident "l1")) [RL.SasnMin (RL.Ident "x") (RL.Econ 3)] (Jgoto (RL.Ident "l9")),Brlblk (RL.Ident "l9") (Ffrom (RL.Ident "l8")) [] (Jgoto (RL.Ident "l4")),Brlblk (RL.Ident "l5") (Ffrom (RL.Ident "l4")) [RL.Sskip] (Jgoto (RL.Ident "l2")),Brlblk (RL.Ident "l2") (Ffrom (RL.Ident "l5")) [] (Jgoto (RL.Ident "l3")),Brlblk (RL.Ident "l3") (Ffrom (RL.Ident "l2")) [] Jexit])
[(Lstring "x",Vint 7),(Lstring "y",Vint 10),(Lstring "z",Vint 10)]
◯from y=5 do y += 1 loop x += 1 until y=10 , skip
(SRL)
srleval  [(Lstring "x",Vint 10) , (Lstring "y",Vint 5), (Lstring "z",Vint 10)] (ESRL [Bfrom (Eeq (Evar (Ident "y")) (Econ 5)) [Bstep (SasnAdd (Ident "y") (Econ 1))] [Bstep (SasnAdd (Ident "x") (Econ 1))] (Eeq (Evar (Ident "y")) (Econ 10)),Bstep (Sskip)])
[(Lstring "x",Vint 14),(Lstring "y",Vint 10),(Lstring "z",Vint 10)]
(RL)
rleval [(Lstring "x",Vint 10) , (Lstring "y",Vint 5), (Lstring "z",Vint 10)] (ERL [Brlblk (RL.Ident "l0") Fentry [] (Jgoto (RL.Ident "l1")),Brlblk (RL.Ident "l1") (Ffi (RL.Eeq (RL.Evar (RL.Ident "y")) (RL.Econ 5)) (RL.Ident "l0") (RL.Ident "l9")) [] (Jgoto (RL.Ident "l6")),Brlblk (RL.Ident "l4") (Ffrom (RL.Ident "l7")) [] (Jif (RL.Eeq (RL.Evar (RL.Ident "y")) (RL.Econ 10)) (RL.Ident "l5") (RL.Ident "l8")),Brlblk (RL.Ident "l6") (Ffrom (RL.Ident "l1")) [RL.SasnAdd (RL.Ident "y") (RL.Econ 1)] (Jgoto (RL.Ident "l7")),Brlblk (RL.Ident "l7") (Ffrom (RL.Ident "l6")) [] (Jgoto (RL.Ident "l4")),Brlblk (RL.Ident "l8") (Ffrom (RL.Ident "l4")) [RL.SasnAdd (RL.Ident "x") (RL.Econ 1)] (Jgoto (RL.Ident "l9")),Brlblk (RL.Ident "l9") (Ffrom (RL.Ident "l8")) [] (Jgoto (RL.Ident "l1")),Brlblk (RL.Ident "l5") (Ffrom (RL.Ident "l4")) [RL.Sskip] (Jgoto (RL.Ident "l2")),Brlblk (RL.Ident "l2") (Ffrom (RL.Ident "l5")) [] (Jgoto (RL.Ident "l3")),Brlblk (RL.Ident "l3") (Ffrom (RL.Ident "l2")) [] Jexit])
[(Lstring "x",Vint 14),(Lstring "y",Vint 10),(Lstring "z",Vint 10)]
-}
