{-# LANGUAGE DeriveDataTypeable #-}

module Language.Grammars.ZipperAG.Examples.LET.Let_Meaning_HO_NestedST_Circ where

import Data.Generics.Zipper
import Language.Grammars.ZipperAG
import Data.Data

import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate
import Language.Grammars.ZipperAG.Examples.LET.Let_Scope
import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi

---- Approach 1: multiple, nested symbol tables
-- Always start searching on the nested symbol table
-- Go up if nothing was found, and so on
-- Similar to how the scope rules work

solve :: Zipper RootA -> Int
solve ag = let ho_st = toZipper (createSTRoot ag)
           in  pointFree ho_st isSolved calculate solveSTRoot

pointFree :: Zipper a -> (Zipper a -> Bool) -> (Zipper a -> b) -> (Zipper a -> Zipper a) -> b
pointFree ag cond calc incre = if   cond ag
                               then calc ag
                               else pointFree (incre ag) cond calc incre

solveSTRoot :: Zipper RootHO -> Zipper RootHO
solveSTRoot ag = toZipper $ RootHO (solveST $ ag.$1) (lexeme_RootHO ag)

solveST :: Zipper RootHO -> ListHO
solveST ag = case (constructorHO ag) of
              "ConsVarHO" -> if ((not $ isSolved $ ag.$2) && (isSolved $ ag.$3))
                             then ConsVarHO (lexeme_ConsVarHO_Var ag) (IsSolved $ calculate $ ag.$3) (lexeme_ConsVarHO_A ag) (solveST $ ag.$4)
                             else ConsVarHO (lexeme_ConsVarHO_Var ag) (lexeme_ConsVarHO_isSolved ag) (lexeme_ConsVarHO_A ag) (solveST $ ag.$4)
              "ConsLetHO" -> if ((not $ isSolved $ ag.$2) && (isSolved $ ag.$3))
                             then ConsLetHO (lexeme_ConsLetHO_Var ag) (IsSolved $ calculate $ ag.$3) (lexeme_ConsLetHO_NestedST ag) (solveST $ ag.$4)
                             else let nested_ST = ag.$3
                                      new_ST    = NestedListHO (solveST $ nested_ST.$1) (lexeme_NestedListHO $ nested_ST)
                                  in ConsLetHO (lexeme_ConsLetHO_Var ag) (lexeme_ConsLetHO_isSolved ag) (new_ST) (solveST $ ag.$4)
              "EmptyListHO"  -> EmptyListHO
              "NestedListHO" -> solveST $ ag.$1

calculate :: Zipper RootHO -> Int
calculate ag = case (constructorHO ag) of
                 "RootHO"       -> calculate $ ag.$2
                 "NestedListHO" -> calculate $ ag.$2
                 "Plus"         -> (calculate $ ag.$1) + (calculate $ ag.$2)
                 "Divide"       -> (calculate $ ag.$1) `div` (calculate $ ag.$2)
                 "Minus"        -> (calculate $ ag.$1) - (calculate $ ag.$2)
                 "Time"         -> (calculate $ ag.$1) * (calculate $ ag.$2)
                 "Variable"     -> getVarValue (lexeme_Variable ag) ag
                 "Constant"     -> lexeme_Constant ag

getVarValue :: String -> Zipper RootHO -> Int
getVarValue name ag = case (constructorHO ag) of
                       "RootHO"       -> auxGetVarValue name ag
                       "NestedListHO" -> auxGetVarValue name ag
                       _              -> getVarValue name (parent ag)

auxGetVarValue :: String -> Zipper RootHO -> Int
auxGetVarValue name ag = case (constructorHO ag) of
                           "RootHO"       -> auxGetVarValue name (ag.$1)
                           "NestedListHO" -> auxGetVarValue name (ag.$1)
                           "ConsVarHO" -> if (lexeme_ConsVarHO_Var ag == name) then (auxGetVarValue name (ag.$2))
                                          else (auxGetVarValue name (ag.$4))
                           "ConsLetHO" -> if (lexeme_ConsLetHO_Var ag == name) then (auxGetVarValue name (ag.$2))
                                          else (auxGetVarValue name (ag.$4))
                           "IsSolved"  -> lexeme_IsSolved ag
                           "EmptyListHO" -> oneUpGetVarValue name ag

oneUpGetVarValue :: String -> Zipper RootHO -> Int
oneUpGetVarValue name ag = case (constructorHO ag) of
                       "NestedListHO" -> getVarValue name (parent ag)
                       _              -> oneUpGetVarValue name (parent ag)

isSolved :: Zipper RootHO -> Bool
isSolved ag = case (constructorHO ag) of
                 "RootHO"       -> (isSolved $ ag.$1) || (isSolved $ ag.$2)
                 "NestedListHO" -> isSolved $ ag.$1
                 "ConsVarHO"    -> (isSolved $ ag.$2) && (isSolved $ ag.$4)
                 "ConsLetHO"    -> (isSolved $ ag.$2) && (isSolved $ ag.$4)
                 "EmptyListHO"  -> True
                 "IsSolved"     -> True
                 "NotSolved"    -> False
                 "Plus"         -> (isSolved $ ag.$1) && (isSolved $ ag.$2)
                 "Divide"       -> (isSolved $ ag.$1) && (isSolved $ ag.$2)
                 "Minus"        -> (isSolved $ ag.$1) && (isSolved $ ag.$2)
                 "Time"         -> (isSolved $ ag.$1) && (isSolved $ ag.$2)
                 "Variable"     -> isVarSolved (lexeme_Variable ag) ag
                 "Constant"     -> True

isVarSolved :: String -> Zipper RootHO -> Bool
isVarSolved name ag = case (constructorHO ag) of
                       "RootHO"       -> auxIsVarSolved name ag
                       "NestedListHO" -> auxIsVarSolved name ag
                       _ -> isVarSolved name (parent ag)

auxIsVarSolved :: String -> Zipper RootHO -> Bool
auxIsVarSolved name ag = case (constructorHO ag) of
                           "RootHO"       -> auxIsVarSolved name (ag.$1)
                           "NestedListHO" -> auxIsVarSolved name (ag.$1)
                           "ConsVarHO"    -> if (lexeme_ConsVarHO_Var ag == name) then (auxIsVarSolved name (ag.$2))
                                             else (auxIsVarSolved name (ag.$4))
                           "ConsLetHO"    -> if (lexeme_ConsLetHO_Var ag == name) then (auxIsVarSolved name (ag.$2))
                                             else (auxIsVarSolved name (ag.$4))
                           "IsSolved"     -> True
                           "NotSolved"    -> False
                           "EmptyListHO"  -> oneUpIsVarSolved name ag

oneUpIsVarSolved :: String -> Zipper RootHO -> Bool
oneUpIsVarSolved name ag = case (constructorHO ag) of
                       "NestedListHO" -> isVarSolved name (parent ag)
                       _        -> oneUpIsVarSolved name (parent ag)


---- Creating the symbol table
createSTRoot :: Zipper RootA -> RootHO
createSTRoot ag = case (constructorHO ag) of
             "RootA"  -> RootHO (createST ag) (lexeme_InA ((ag.$1).$2))

createST :: Zipper RootA -> ListHO
createST ag = case (constructorHO ag) of
                "RootA"       -> createST $ ag.$1
                "LetA"        -> createST $ ag.$1
                "ConsAssignA" -> ConsVarHO (lexeme_ConsAssignA_1 ag) (NotSolved) (lexeme_ConsAssignA_2 ag) (createST $ ag.$3)
                "ConsLetA"    -> ConsLetHO (lexeme_ConsLetA_1 ag)    (NotSolved) (NestedListHO (createST $ ag.$2) (lexeme_InA $ (ag.$2).$2)) (createST $ ag.$3)
                "EmptyListA"  -> EmptyListHO

--- Higher-Order Symbol Table
data RootHO = RootHO ListHO A
 deriving (Show, Data, Typeable)

data ListHO = ConsVarHO String IsSolved A ListHO
            | ConsLetHO String IsSolved ListHO ListHO
            | NestedListHO ListHO A
            | EmptyListHO
 deriving (Show, Data, Typeable)

data IsSolved = IsSolved Int | NotSolved
 deriving (Show, Data, Typeable)

lexeme_IsSolved :: Zipper a -> Int
lexeme_IsSolved ag = case (getHole ag :: Maybe IsSolved) of
                      Just (IsSolved n) -> n
                      _ -> error "Error on lexeme_IsSolved!"

lexeme_RootHO :: Zipper a -> A
lexeme_RootHO ag = case (getHole ag :: Maybe RootHO) of
                    Just(RootHO _ a) -> a
                    _ -> error "Error on lexeme_RootHO!"

lexeme_ConsVarHO_Var :: Zipper a -> String
lexeme_ConsVarHO_Var ag = case (getHole ag :: Maybe ListHO) of
                       Just(ConsVarHO v _ _ _) -> v
                       _ -> error "Error on lexeme_ConsVarHO_Var!"

lexeme_ConsVarHO_isSolved :: Zipper a -> IsSolved
lexeme_ConsVarHO_isSolved ag = case (getHole ag :: Maybe ListHO) of
                       Just(ConsVarHO _ v _ _) -> v
                       _ -> error "Error on lexeme_ConsVarHO_isSolved!"

lexeme_ConsVarHO_A :: Zipper a -> A
lexeme_ConsVarHO_A ag = case (getHole ag :: Maybe ListHO) of
                       Just(ConsVarHO _ _ v _) -> v
                       _ -> error "Error on lexeme_ConsVarHO_A!"

lexeme_ConsLetHO_Var :: Zipper a -> String
lexeme_ConsLetHO_Var ag = case (getHole ag :: Maybe ListHO) of
                       Just(ConsLetHO v _ _ _) -> v
                       _ -> error "Error on lexeme_ConsLetHO_Var!"

lexeme_ConsLetHO_isSolved :: Zipper a -> IsSolved
lexeme_ConsLetHO_isSolved ag = case (getHole ag :: Maybe ListHO) of
                       Just(ConsLetHO _ v _ _) -> v
                       _ -> error "Error on lexeme_ConsLetHO_isSolved!"

lexeme_ConsLetHO_NestedST :: Zipper a -> ListHO
lexeme_ConsLetHO_NestedST ag = case (getHole ag :: Maybe ListHO) of
                       Just(ConsLetHO _ _ v _) -> v
                       _ -> error "Error on lexeme_ConsLetHO_NestedST!"

lexeme_NestedListHO :: Zipper a -> A
lexeme_NestedListHO ag = case (getHole ag :: Maybe ListHO) of
                    Just(NestedListHO _ a) -> a
                    _ -> error "Error on lexeme_NestedListHO!"

constructorHO :: Zipper a -> String
constructorHO ag = case (getHole ag :: Maybe RootHO) of
                     Just(RootHO _ _) -> "RootHO"
                     _ -> case (getHole ag :: Maybe ListHO) of
                            Just(ConsVarHO _ _ _ _) -> "ConsVarHO"
                            Just(ConsLetHO _ _ _ _) -> "ConsLetHO"
                            Just(NestedListHO _ _   ) -> "NestedListHO"
                            Just(EmptyListHO      ) -> "EmptyListHO"
                            _ -> case (getHole ag :: Maybe IsSolved) of
                                  Just(IsSolved _) -> "IsSolved"
                                  Just(NotSolved)  -> "NotSolved"
                                  _ -> constructor ag

solve_ho_plus_circularity p = solve $ toZipper (getRootC_RootA $ toZipper p)