{-# LANGUAGE DeriveDataTypeable #-} module Language.C.Abs where import Control.DeepSeq import Data.Generics import Grm.Prims import Grm.Lex import Text.PrettyPrint.Leijen myLexemes = ["\n","\n#define","\n#endif","!","#ifndef","#include","&","(",")","*","++",",","--","->",".",":",";","<","=",">","[","]","alloca","break","case","default:","else","enum","if","return","sizeof","struct","switch","typedef","union","while","{","}"] grmLexFilePath = lexFilePath myLexemes grmLexContents = lexContents myLexemes data Module = HModule Uident Uident ImportList DeclareList | CModule ImportList DefineList deriving (Show,Eq,Ord,Data,Typeable) data Import = Import String | GImport Lident deriving (Show,Eq,Ord,Data,Typeable) data Declare = Declare FunDecl | Typedef Decl deriving (Show,Eq,Ord,Data,Typeable) data Define = Define FunDecl StmtList deriving (Show,Eq,Ord,Data,Typeable) data FunDecl = FunFD Type Lident ArgDeclList | RetFunFD Type Lident ArgDeclList TypeList deriving (Show,Eq,Ord,Data,Typeable) data Type = TyName Uident | TyPtr Type | TyFun Type TypeList | TyArray Type Number | TyEnum EnumCList | TyStruct DeclList | TyUnion DeclList deriving (Show,Eq,Ord,Data,Typeable) data EnumC = EnumC Uident deriving (Show,Eq,Ord,Data,Typeable) data Decl = Decl Type Lident | FunD Type Lident TypeList deriving (Show,Eq,Ord,Data,Typeable) data Exp = AllocaE Type | VarE Lident | LitE Lit | CastE Type Exp | LoadE Exp | ArrowE Exp Exp | DotE Exp Exp | AddrE Exp | IdxE Exp Exp | CallE Exp ExpList | BinOpE Exp Usym Exp | ParenE Exp | NotE Exp deriving (Show,Eq,Ord,Data,Typeable) data Stmt = DeclS Decl | AssignS Exp Exp | CallS Exp ExpList | SwitchS Exp SwitchAltList | BreakS | IfS Exp StmtList StmtList | WhenS Exp StmtList | WhileS Exp StmtList | ReturnS Exp | RetVoidS | NoOpS | BlockS StmtList | IncS Exp | DecS Exp deriving (Show,Eq,Ord,Data,Typeable) data SwitchAlt = SwitchAlt Lit StmtList | DefaultAlt StmtList deriving (Show,Eq,Ord,Data,Typeable) data Lit = StringL String | CharL Char | NmbrL Number | EnumL Uident deriving (Show,Eq,Ord,Data,Typeable) type TypeList = [Type ] type ExpList = [Exp ] type EnumCList = [EnumC ] type DeclList = [Decl ] type ArgDeclList = [Decl ] type SwitchAltList = [SwitchAlt ] type StmtList = [Stmt ] type DeclareList = [Declare ] type DefineList = [Define ] type ImportList = [Import ] instance Pretty (Module ) where pretty = ppModule ppModule x = case x of HModule v1 v2 v3 v4 -> text "#ifndef" <+> ppUident v1 <+> text "\n#define" <+> ppUident v2 <+> text "\n" <+> ppImportList v3 <+> ppDeclareList v4 <+> text "\n#endif" CModule v1 v2 -> ppImportList v1 <+> ppDefineList v2 instance Pretty (Import ) where pretty = ppImport ppImport x = case x of Import v1 -> text "#include" <+> ppString v1 GImport v1 -> text "#include" <+> text "<" <> ppLident v1 <> text ">" instance Pretty (Declare ) where pretty = ppDeclare ppDeclare x = case x of Declare v1 -> ppFunDecl v1 Typedef v1 -> text "typedef" <+> ppDecl v1 instance Pretty (Define ) where pretty = ppDefine ppDefine x = case x of Define v1 v2 -> ppFunDecl v1 <+> text "{" <+> ppStmtList v2 <+> text "}" instance Pretty (FunDecl ) where pretty = ppFunDecl ppFunDecl x = case x of FunFD v1 v2 v3 -> ppType v1 <+> ppLident v2 <> text "(" <> ppArgDeclList v3 <> text ")" RetFunFD v1 v2 v3 v4 -> ppType v1 <+> text "(" <+> text "*" <+> ppLident v2 <+> text "(" <> ppArgDeclList v3 <> text ")" <+> text ")" <+> text "(" <> ppTypeList v4 <> text ")" instance Pretty (Type ) where pretty = ppType ppType x = case x of TyName v1 -> ppUident v1 TyPtr v1 -> ppType v1 <> text "*" TyFun v1 v2 -> ppType v1 <+> text "(" <> text "*" <> text ")" <+> text "(" <> ppTypeList v2 <> text ")" TyArray v1 v2 -> ppType v1 <+> text "[" <+> ppNumber v2 <+> text "]" TyEnum v1 -> text "enum" <+> text "{" <+> ppEnumCList v1 <+> text "}" TyStruct v1 -> text "struct" <+> text "{" <+> ppDeclList v1 <+> text "}" TyUnion v1 -> text "union" <+> text "{" <+> ppDeclList v1 <+> text "}" instance Pretty (EnumC ) where pretty = ppEnumC ppEnumC x = case x of EnumC v1 -> ppUident v1 instance Pretty (Decl ) where pretty = ppDecl ppDecl x = case x of Decl v1 v2 -> ppType v1 <+> ppLident v2 FunD v1 v2 v3 -> ppType v1 <+> ppLident v2 <> text "(" <> ppTypeList v3 <> text ")" instance Pretty (Exp ) where pretty = ppExp ppExp x = case x of AllocaE v1 -> text "alloca" <+> text "(" <+> text "sizeof" <+> text "(" <+> ppType v1 <+> text ")" <+> text ")" VarE v1 -> ppLident v1 LitE v1 -> ppLit v1 CastE v1 v2 -> text "(" <+> ppType v1 <+> text ")" <+> ppExp v2 LoadE v1 -> text "*" <> ppExp v1 ArrowE v1 v2 -> ppExp v1 <> text "->" <> ppExp v2 DotE v1 v2 -> ppExp v1 <> text "." <> ppExp v2 AddrE v1 -> text "&" <> ppExp v1 IdxE v1 v2 -> ppExp v1 <> text "[" <> ppExp v2 <> text "]" CallE v1 v2 -> ppExp v1 <> text "(" <> ppExpList v2 <> text ")" BinOpE v1 v2 v3 -> text "(" <> ppExp v1 <+> ppUsym v2 <+> ppExp v3 <> text ")" ParenE v1 -> text "(" <+> ppExp v1 <+> text ")" NotE v1 -> text "!" <> ppExp v1 instance Pretty (Stmt ) where pretty = ppStmt ppStmt x = case x of DeclS v1 -> ppDecl v1 AssignS v1 v2 -> ppExp v1 <+> text "=" <+> ppExp v2 CallS v1 v2 -> ppExp v1 <> text "(" <> ppExpList v2 <> text ")" SwitchS v1 v2 -> text "switch" <+> text "(" <+> ppExp v1 <+> text ")" <+> text "{" <+> ppSwitchAltList v2 <+> text "}" BreakS -> text "break" IfS v1 v2 v3 -> text "if" <+> text "(" <+> ppExp v1 <+> text ")" <+> text "{" <+> ppStmtList v2 <+> text "}" <+> text "else" <+> text "{" <+> ppStmtList v3 <+> text "}" WhenS v1 v2 -> text "if" <+> text "(" <+> ppExp v1 <+> text ")" <+> text "{" <+> ppStmtList v2 <+> text "}" WhileS v1 v2 -> text "while" <+> text "(" <+> ppExp v1 <+> text ")" <+> text "{" <+> ppStmtList v2 <+> text "}" ReturnS v1 -> text "return" <> text "(" <> ppExp v1 <> text ")" RetVoidS -> text "return" NoOpS -> Text.PrettyPrint.Leijen.empty BlockS v1 -> ppStmtList v1 IncS v1 -> ppExp v1 <> text "++" DecS v1 -> ppExp v1 <> text "--" instance Pretty (SwitchAlt ) where pretty = ppSwitchAlt ppSwitchAlt x = case x of SwitchAlt v1 v2 -> text "case" <+> ppLit v1 <> text ":" <+> ppStmtList v2 DefaultAlt v1 -> text "default:" <+> ppStmtList v1 instance Pretty (Lit ) where pretty = ppLit ppLit x = case x of StringL v1 -> ppString v1 CharL v1 -> ppChar v1 NmbrL v1 -> ppNumber v1 EnumL v1 -> ppUident v1 ppTypeList = ppList ppType Separator "," Horiz ppExpList = ppList ppExp Separator "," Horiz ppEnumCList = ppList ppEnumC Separator "," Horiz ppDeclList = ppList ppDecl Terminator ";" Horiz ppArgDeclList = ppList ppDecl Separator "," Horiz ppSwitchAltList = ppList ppSwitchAlt Terminator "" Vert ppStmtList = ppList ppStmt Terminator ";" Vert ppDeclareList = ppList ppDeclare Terminator ";" Vert ppDefineList = ppList ppDefine Terminator ";" Vert ppImportList = ppList ppImport Terminator "" Vert