{-# LANGUAGE DeriveDataTypeable #-}

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

import Data.Generics.Zipper
import Language.Grammars.ZipperAG
import Language.Grammars.ZipperAG.Examples.LET.Let_DataTypes_Boilerplate
import Language.Grammars.ZipperAG.Examples.LET.Let_Bidi

---- Synthesized Attributes ----
dclo :: Zipper RootA -> [(String, Zipper RootA)]
dclo ag = case (constructor ag) of
           "RootA"       -> dclo $ ag.$1
           "LetA"        -> dclo $ ag.$1
           "ConsLetA"    -> dclo $ ag.$3
           "ConsAssignA" -> dclo $ ag.$3
           "EmptyListA"  -> dcli ag

errs :: Zipper RootA -> [String]
errs ag = case (constructor ag) of
           "RootA"       -> errs $ ag.$1
           "LetA"        -> (errs $ ag.$1) ++ (errs $ ag.$2)
           "InA"         -> (errs $ ag.$1)
           "ConsAssignA" -> mNBIn (lexeme_ConsAssignA_1 ag, ag) (dcli ag) ++ (errs $ ag.$2) ++ (errs $ ag.$3)
           "ConsLetA"    -> mNBIn (lexeme_ConsLetA_1    ag, ag) (dcli ag) ++ (errs $ ag.$2) ++ (errs $ ag.$3)
           "EmptyListA"  -> []
           "Plus"        -> (errs $ ag.$1) ++ (errs $ ag.$2)
           "Divide"      -> (errs $ ag.$1) ++ (errs $ ag.$2)
           "Minus"       -> (errs $ ag.$1) ++ (errs $ ag.$2)
           "Time"        -> (errs $ ag.$1) ++ (errs $ ag.$2)
           "Variable"    -> mBIn (lexeme_Variable ag) (env ag)
           "Constant"    -> []

---- Inheritted Attributes ----
dcli :: Zipper RootA -> [(String, Zipper RootA)]
dcli ag = case (constructor ag) of
           "RootA" -> []
           "LetA"  -> case (constructor $ parent ag) of
                             "RootA"    -> dcli $ parent ag
                             "ConsLetA" -> env $ parent ag
           _       -> case (constructor $ parent ag) of
                             "ConsAssignA" -> (dcli $ parent ag) ++ [(lexeme_ConsAssignA_1 $ parent ag, parent ag)]
                             "ConsLetA"    -> (dcli $ parent ag) ++ [(lexeme_ConsLetA_1 $ parent ag, parent ag)]
                             _             -> dcli $ parent ag

env :: Zipper RootA -> [(String, Zipper RootA)]
env ag = case (constructor ag) of
           "RootA"       -> dclo ag
           "LetA"        -> case (constructor $ parent ag) of
                             "ConsLetA" -> dclo ag
                             _          -> env $ parent ag
           -- autocopy, ow yeah
           _             -> env $ parent ag

lev :: Zipper RootA -> Int
lev ag = case (constructor ag) of
           "RootA"       -> 0
           "LetA"        -> case (constructor $ parent ag) of
                             "ConsLetA" -> (lev $ parent ag) + 1
                             _          -> 0
           _             -> lev $ parent ag

{- Environment lookup functions -}
mBIn :: String -> [(String, Zipper RootA)] -> [String]
mBIn name [] = [name]
mBIn name ((n,l):es) = if (n==name) then [] else mBIn name es

mNBIn :: (String, Zipper RootA) -> [(String, Zipper RootA)] -> [String]
mNBIn tuple [] = [] 
mNBIn (a1,r1) ((a2,r2):es) = if (a1==a2) && (lev r1 == lev r2) then [a1] else mNBIn (a1,r1) es

test_scope_block_rules p = errs $ toZipper (getRootC_RootA $ toZipper p)