module Language.Grammars.ZipperAG.Examples.LET.Let_Circular_Flatening 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
data VarList = VarList String VarList
| NoVar
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
solve :: Zipper RootA -> Zipper RootA
solve ag = pointFree ag isSolved id (toZipper . flatAG)
isSolved :: Zipper RootA -> Bool
isSolved ag = case (constructor ag) of
"RootA" -> isSolved $ ag.$1
"LetA" -> (isSolved $ ag.$1) || (isSolved $ ag.$2)
"InA" -> isConstant $ ag.$1
"ConsAssignA" -> (isConstant $ ag.$2) && (isSolved $ ag.$3)
"ConsLetA" -> False
"EmptyListA" -> True
isSolvable :: Zipper RootA -> Bool
isSolvable ag = case (constructor ag) of
"Plus" -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2)
"Divide" -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2)
"Minus" -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2)
"Time" -> (isSolvable $ ag.$1) && (isSolvable $ ag.$2)
"Variable" -> isVarSolved (lexeme_Variable ag) ag
"Constant" -> True
flatAG :: Zipper RootA -> RootA
flatAG ag = case (constructor ag) of
"RootA" -> RootA (flatLetAG $ ag.$1) Empty
flatLetAG :: Zipper RootA -> LetA
flatLetAG ag = case (constructor ag) of
"LetA" -> LetA (flatListAG $ ag.$1) (lexme_LetA_2 ag) Empty
flatListAG :: Zipper RootA -> ListA
flatListAG ag = case (constructor ag) of
"ConsLetA" -> if (isSolved $ ag.$2)
then ConsAssignA (lexeme_ConsLetA_1 ag) (Constant (calculate $ ag.$2) Empty) (flatListAG $ ag.$3) Empty
else ConsLetA (lexeme_ConsLetA_1 ag) (flatLetAG $ ag.$2) (flatListAG $ ag.$3) Empty
"ConsAssignA" -> if ((not . isConstant $ ag.$2) && (isSolvable $ ag.$2))
then ConsAssignA (lexeme_ConsAssignA_1 ag) (Constant (calculate $ ag.$2) Empty) (flatListAG $ ag.$3) Empty
else ConsAssignA (lexeme_ConsAssignA_1 ag) (lexeme_ConsAssignA_2 ag) (flatListAG $ ag.$3) Empty
"EmptyListA" -> EmptyListA Empty
isConstant :: Zipper RootA -> Bool
isConstant ag = case (constructor ag) of
"Constant" -> True
_ -> False
calculate :: Zipper RootA -> Int
calculate ag = case (constructor ag) of
"RootA" -> calculate $ ag.$1
"LetA" -> calculate $ ag.$2
"InA" -> calculate $ ag.$1
"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 RootA -> Int
getVarValue name ag = case (constructor ag) of
"RootA" -> auxGetVarValue name ag
"ConsLetA" -> auxGetVarValue name (ag.$2)
_ -> getVarValue name (parent ag)
auxGetVarValue :: String -> Zipper RootA -> Int
auxGetVarValue name ag = case (constructor ag) of
"RootA" -> auxGetVarValue name (ag.$1)
"LetA" -> auxGetVarValue name (ag.$1)
"ConsAssignA" -> if (lexeme_ConsAssignA_1 ag == name) then (lexeme_Constant $ ag.$2)
else (auxGetVarValue name (ag.$3))
"ConsLetA" -> auxGetVarValue name (ag.$3)
"EmptyListA" -> oneUpGetVarValue name ag
oneUpGetVarValue :: String -> Zipper RootA -> Int
oneUpGetVarValue name ag = case (constructor ag) of
"ConsLetA" -> getVarValue name (parent ag)
_ -> oneUpGetVarValue name (parent ag)
isVarSolved :: String -> Zipper RootA -> Bool
isVarSolved name ag = case (constructor ag) of
"RootA" -> auxIsVarSolved name ag
"ConsLetA" -> auxIsVarSolved name ag
_ -> isVarSolved name (parent ag)
auxIsVarSolved :: String -> Zipper RootA -> Bool
auxIsVarSolved name ag = case (constructor ag) of
"RootA" -> auxIsVarSolved name (ag.$1)
"LetA" -> auxIsVarSolved name (ag.$1)
"ConsAssignA" -> if (lexeme_ConsAssignA_1 ag == name) then (isConstant $ ag.$2)
else (auxIsVarSolved name (ag.$3))
"ConsLetA" -> if (lexeme_ConsLetA_1 ag == name) then False
else (auxIsVarSolved name (ag.$3))
"EmptyListA" -> oneUpIsVarSolved name ag
oneUpIsVarSolved :: String -> Zipper RootA -> Bool
oneUpIsVarSolved name ag = case (constructor ag) of
"ConsLetA" -> isVarSolved name (parent ag)
_ -> oneUpIsVarSolved name (parent ag)
flatten_Let p = solve $ toZipper (getRootC_RootA $ toZipper p)