module Language.Qux.Annotated.Syntax (
Annotated(..),
Simplifiable(..),
Id(..), Program(..), Decl(..), Stmt(..), Expr(..), Type(..),
BinaryOp(..), UnaryOp(..), Value(..)
) where
import Language.Qux.Syntax (BinaryOp(..), UnaryOp(..), Value(..))
import qualified Language.Qux.Syntax as S
import Text.PrettyPrint.HughesPJClass
class Annotated n where
ann :: n a -> a
class Simplifiable n r | n -> r where
simp :: n -> r
data Id a = Id a String
deriving (Eq, Functor, Show)
instance Annotated Id where
ann (Id a _) = a
instance Simplifiable (Id a) [Char] where
simp (Id _ id_) = id_
instance Pretty (Id a) where
pPrint = text . simp
data Program a = Program a [Id a] [Decl a]
deriving (Eq, Functor, Show)
instance Annotated Program where
ann (Program a _ _) = a
instance Simplifiable (Program a) S.Program where
simp (Program _ module_ decls) = S.Program (map simp module_) (map simp decls)
instance Pretty (Program a) where
pPrint = pPrint . simp
data Decl a = FunctionDecl a (Id a) [(Type a, Id a)] [Stmt a]
deriving (Eq, Functor, Show)
instance Annotated Decl where
ann (FunctionDecl a _ _ _) = a
instance Simplifiable (Decl a) S.Decl where
simp (FunctionDecl _ name parameters stmts) = S.FunctionDecl (simp name) (map (tmap simp simp) parameters) (map simp stmts)
instance Pretty (Decl a) where
pPrint = pPrint . simp
data Stmt a = IfStmt a (Expr a) [Stmt a] [Stmt a]
| ReturnStmt a (Expr a)
| WhileStmt a (Expr a) [Stmt a]
deriving (Eq, Functor, Show)
instance Annotated Stmt where
ann (IfStmt a _ _ _) = a
ann (ReturnStmt a _) = a
ann (WhileStmt a _ _) = a
instance Simplifiable (Stmt a) S.Stmt where
simp (IfStmt _ condition trueStmts falseStmts) = S.IfStmt (simp condition) (map simp trueStmts) (map simp falseStmts)
simp (ReturnStmt _ expr) = S.ReturnStmt (simp expr)
simp (WhileStmt _ condition stmts) = S.WhileStmt (simp condition) (map simp stmts)
instance Pretty (Stmt a) where
pPrint = pPrint . simp
data Expr a = ApplicationExpr a (Id a) [Expr a]
| BinaryExpr a BinaryOp (Expr a) (Expr a)
| ListExpr a [Expr a]
| TypedExpr a S.Type (Expr a)
| UnaryExpr a UnaryOp (Expr a)
| ValueExpr a Value
deriving (Eq, Functor, Show)
instance Annotated Expr where
ann (ApplicationExpr a _ _) = a
ann (BinaryExpr a _ _ _) = a
ann (ListExpr a _) = a
ann (TypedExpr a _ _) = a
ann (UnaryExpr a _ _) = a
ann (ValueExpr a _) = a
instance Simplifiable (Expr a) S.Expr where
simp (ApplicationExpr _ id arguments) = S.ApplicationExpr (simp id) (map simp arguments)
simp (BinaryExpr _ op lhs rhs) = S.BinaryExpr op (simp lhs) (simp rhs)
simp (ListExpr _ elements) = S.ListExpr (map simp elements)
simp (TypedExpr _ type_ expr) = S.TypedExpr type_ (simp expr)
simp (UnaryExpr _ op expr) = S.UnaryExpr op (simp expr)
simp (ValueExpr _ value) = S.ValueExpr value
instance Pretty (Expr a) where
pPrint = pPrint . simp
data Type a = BoolType a
| IntType a
| ListType a (Type a)
| NilType a
deriving (Eq, Functor, Show)
instance Annotated Type where
ann (BoolType a) = a
ann (IntType a) = a
ann (ListType a _) = a
ann (NilType a) = a
instance Simplifiable (Type a) S.Type where
simp (BoolType _) = S.BoolType
simp (IntType _) = S.IntType
simp (ListType _ inner) = S.ListType $ simp inner
simp (NilType _) = S.NilType
instance Pretty (Type a) where
pPrint = pPrint . simp
tmap :: (a -> b) -> (c -> d) -> (a, c) -> (b, d)
tmap f g (a, c) = (f a, g c)