{-# LANGUAGE DeriveDataTypeable #-}

module Language.Grammars.ZipperAG.Examples.DESK.DESK where

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

data Root = Root Program
			   deriving (Show, Typeable, Data)

data Program = PRINT Expression ConstPart
			   deriving (Show, Typeable, Data)

{- Keeping it simple by just having sums -}
data Expression = Add Expression Factor
				| Fact Factor
			   deriving (Show, Typeable, Data)

data Factor = Name ConstName
			| Number String
			   deriving (Show, Typeable, Data)

data ConstName = Id String
			   deriving (Show, Typeable, Data)
{-----------------------------------------}
data ConstPart = EmptyConstPart
			   | WHERE ConstDefList
			   deriving (Show, Typeable, Data)

data ConstDefList = Comma ConstDefList ConstDef
				  | Def ConstDef
			   deriving (Show, Typeable, Data)

data ConstDef = Equal ConstName String
			   deriving (Show, Typeable, Data)

type SymbolTable = [(String,String)]

constructor :: Zipper Root -> String
constructor a = case ( getHole a :: Maybe Program ) of
				   Just (PRINT _ _) -> "PRINT"
				   otherwise -> case ( getHole a :: Maybe Expression ) of
				   				Just (Add _ _) -> "Add"
				   				Just (Fact _) -> "Fact"
				   				otherwise -> case ( getHole a :: Maybe Factor ) of
				   							 Just (Name _) -> "Name"
				   							 Just (Number _) -> "Number"
				   							 otherwise -> case ( getHole a :: Maybe ConstName ) of
				   										  Just (Id _) -> "Id"
				   										  otherwise -> case ( getHole a :: Maybe ConstPart ) of
				   													   Just (EmptyConstPart) -> "EmptyConstPart"
				   													   Just (WHERE _) -> "WHERE"
				   													   otherwise -> case ( getHole a :: Maybe ConstDefList ) of
				   													   				Just (Comma _ _) -> "Comma"
				   													   				Just (Def _) -> "Def"
				   													   				otherwise -> case ( getHole a :: Maybe ConstDef ) of
				   													   							 Just (Equal _ _) -> "Equal"
				   													   							 otherwise -> case ( getHole a :: Maybe Root) of
				   													   							 	Just (Root _) -> "Root"
				   													   							 	_ -> "That production does not exist!"

lexeme :: Zipper Root -> String
lexeme t = case ( getHole t :: Maybe ConstName ) of
              Just (Id x) -> x
              _ -> case( getHole t :: Maybe ConstDef ) of
                   Just (Equal _ x) -> x
                   _ -> case ( getHole t :: Maybe Factor ) of
                         Just (Number x) -> x

---- AG ----

---- Inherited -----
envi t = case (constructor t) of
			"PRINT" -> envs ( t.$2 )
			_ -> envi (parent t)

---- Synthesized ----
code :: Zipper Root -> String
code t = case (constructor t) of
			"Root" -> code ( t.$1 )
			"PRINT" -> if ok ( t.$2 )
						then code ( t.$1 ) ++ "PRINT, 0\n" ++ "HALT,  0\n"
						else "HALT,  0\n"
			"Add" -> if (ok ( t.$2 ))
						then code ( t.$1 ) ++ "ADD,   " ++ value ( t.$2 ) ++ "\n"
						else "HALT,  0\n"
			"Fact" -> if (ok ( t.$1 ))
			 		   then "LOAD,  " ++ value ( t.$1 ) ++ "\n"
			 		   else "HALT,  0\n"

value :: Zipper Root -> String
value t = case (constructor t) of
			"Name" -> getValue (name ( t.$1 )) (envi t)
			"Number" -> lexeme t
			"Equal" -> lexeme t

ok :: Zipper Root -> Bool
ok t = case (constructor t) of
		"Name" -> isInST (name ( t.$1 )) (envi t)
		"Number" -> True
		"EmptyConstPart" -> True
		"WHERE" -> ok ( t.$1 )
		"Comma" -> ok ( t.$1 ) && (not (isInST (name ( t.$2 )) (envs ( t.$1 ))) )
		"Def" -> True

name :: Zipper Root -> String
name t = case (constructor t) of
			"Id" -> lexeme t
			"Equal" -> name $ (t.$1)

envs :: Zipper Root -> SymbolTable            
envs t = case (constructor t) of
			"EmptyConstPart" -> []
			"WHERE" -> envs( t.$1 )
			"Comma" -> envs( t.$1 ) ++ [(name ( t.$2 ), value ( t.$2 ))]
			"Def" -> [( name ( t.$1 ), value ( t.$1) )]

{-Semantic Functions-}
isInST :: String -> SymbolTable -> Bool
isInST _ [] = False 
isInST c ((a,b):xs) = if (c==a) then True else isInST c xs

getValue :: String -> SymbolTable -> String
getValue c ((a,b):xs) = if (c==a) then b else (getValue c xs)

{---------------Tests---------------}
expr = Add (Add (Fact (Name (Id "x"))) (Name (Id "y"))) (Number "1")
deflst = WHERE (Comma (Def (Equal (Id "x") ("2"))) (Equal (Id "y") ("3")))
program = Root (PRINT expr deflst)

--PRINT x + y + 1 WHERE y = 2, x = 3

semantics t = putStrLn ("\n" ++ (code (toZipper t)))