module Language.Grammars.ZipperAG.Examples.SmartParentesis where
import Data.Maybe
import Data.Data
import Prelude
import Data.Generics.Zipper
import Data.Data
import Language.Grammars.ZipperAG
data Root = Root Exp
deriving (Eq, Ord, Show, Typeable, Data)
data Exp = Add Exp Exp
| Mul Exp Exp
| Div Exp Exp
| Sub Exp Exp
| Lit Int
deriving (Eq, Ord, Show, Typeable, Data)
constructor :: Zipper Root -> String
constructor a = case (getHole a :: Maybe Exp) of
Just (Add _ _) -> "Add"
Just (Mul _ _) -> "Mul"
Just (Div _ _) -> "Div"
Just (Sub _ _) -> "Sub"
Just (Lit _) -> "Lit"
_ -> case (getHole a :: Maybe Root ) of
Just (Root _) -> "Root"
lexeme :: Zipper Root -> Int
lexeme t = let Lit v = fromJust (getHole t :: Maybe Exp)
in v
enclosingOpPrecedence :: Zipper Root -> Int
enclosingOpPrecedence t = case (constructor t) of
"Root" -> 0
"Add" -> 1
"Sub" -> 1
"Mul" -> 2
"Div" -> 2
leftOrRight :: Zipper Root -> String
leftOrRight t = case (constructor t) of
"Root" -> "none"
"Add" -> case t.|1 of
True -> "left"
False -> "right"
"Sub" -> case t.|1 of
True -> "left"
False -> "right"
"Mul" -> case t.|1 of
True -> "left"
False -> "right"
"Div" -> "left"
bpp :: Zipper Root -> String
bpp t = case (constructor t) of
"Root" -> bpp (t.$1)
"Lit" -> show (lexeme t)
"Add" -> if (wrapInParens (enclosingOpPrecedence t) 1 (leftOrRight t) "left")
then "(" ++ (bpp ( t.$1 )) ++ "+" ++ (bpp ( t.$2 )) ++ ")"
else (bpp ( t.$1 )) ++ "+" ++ (bpp ( t.$2 ))
"Sub" -> if (wrapInParens (enclosingOpPrecedence t) 1 (leftOrRight t) "left")
then "(" ++ (bpp ( t.$1 )) ++ "-" ++ (bpp ( t.$2 )) ++ ")"
else (bpp ( t.$1 )) ++ "-" ++ (bpp ( t.$2 ))
"Mul" -> if (wrapInParens (enclosingOpPrecedence t) 2 (leftOrRight t) "left")
then "(" ++ (bpp ( t.$1 )) ++ "*" ++ (bpp ( t.$2 )) ++ ")"
else (bpp ( t.$1 )) ++ "*" ++ (bpp ( t.$2 ))
"Div" -> if (wrapInParens (enclosingOpPrecedence t) 2 (leftOrRight t) "left")
then "(" ++ (bpp ( t.$1 )) ++ "/" ++ (bpp ( t.$2 )) ++ ")"
else (bpp ( t.$1 )) ++ "/" ++ (bpp ( t.$2 ))
wrapInParens enclosingP thisP thisPos opAssoc = (enclosingP > thisP) || ((enclosingP == thisP) && (thisPos /= opAssoc))
exp2str :: Exp -> String
exp2str (Add a b) = "(" ++ exp2str(a) ++ " + " ++ exp2str(b) ++ ")"
exp2str (Mul a b) = "(" ++ exp2str(a) ++ " * " ++ exp2str(b) ++ ")"
exp2str (Div a b) = "(" ++ exp2str(a) ++ " / " ++ exp2str(b) ++ ")"
exp2str (Sub a b) = "(" ++ exp2str(a) ++ " - " ++ exp2str(b) ++ ")"
exp2str (Lit f) = show f
expr = Root $ Mul (Sub (Div (Lit 5) (Lit 5)) (Lit 10)) (Add (Lit 4) (Lit 5))
semantics z = bpp (toZipper z)