Abs.hs

{-# LANGUAGE DeriveDataTypeable #-}
module Language.LLVM.Abs where
import Control.DeepSeq
import Data.Generics
import Grm.Prims
import Grm.Lex
import Text.PrettyPrint.Leijen
myLexemes = ["\"","(",")","*",",",", i32 0,",", i32 0, i32 0)",", label %","...",":","::",";","=","= private constant [","[","\\00\"","]","add nuw nsw","alloca","and","bitcast","br i1","br label %","call","declare","define","double","eq","fadd","false","fcmp","fdiv","float","fmul","fpext","fptosi","fptoui","fptrunc","frem","fsub","getelementptr inbounds","getelementptr inbounds ([","i","i8","icmp","load","lshr","mul nuw nsw","ne","oge","ogt","ole","olt","or","ret","sdiv","sext","sge","sgt","shl","sitofp","sle","slt","srem","store","sub nuw nsw","switch","to","true","trunc","type","udiv","uge","ugt","uitofp","ule","ult","urem","void","x","x i8 ] c","x i8 ]*","xor","zext","{","|","}"]
grmLexFilePath = lexFilePath myLexemes
grmLexContents = lexContents myLexemes
data Module 
  = Module  DefineList
  deriving (Show,Eq,Ord,Data,Typeable)
data Define 
  = Define  Type Lident TVarList StmtList
  | Declare  Type Lident TypeList
  | TypeD  Lident Type
  | StringD  Lident Number Lident
  deriving (Show,Eq,Ord,Data,Typeable)
data Stmt 
  = LetS  Lident Exp
  | StoreS  Atom TVar
  | CallS  TVar AtomList
  | SwitchS  Atom Lident SwitchAltList
  | ReturnS  Atom
  | LabelS  Lident
  | BrS  UAtom Lident Lident
  | Br0S  Lident
  | TagS  Atom
  | NoOpS 
  deriving (Show,Eq,Ord,Data,Typeable)
data Exp 
  = CallE  TVar AtomList
  | CastE  Cast TVar Type
  | AllocaE  Type
  | LoadE  TVar
  | AtomE  Atom
  | BinOpE  BinOp Type UAtom UAtom
  | IdxE  TVar Atom
  deriving (Show,Eq,Ord,Data,Typeable)
data Cast 
  = Bitcast 
  | Sitofp 
  | Uitofp 
  | Fptosi 
  | Fptoui 
  | Trunc 
  | Zext 
  | Sext 
  | Fptrunc 
  | Fpext 
  deriving (Show,Eq,Ord,Data,Typeable)
data BinOp 
  = Icmp  ICond
  | Fcmp  FCond
  | Add 
  | Fadd 
  | Sub 
  | Fsub 
  | Mul 
  | Fmul 
  | Udiv 
  | Sdiv 
  | Fdiv 
  | Urem 
  | Srem 
  | Frem 
  | Shl 
  | Lshr 
  | And 
  | Or 
  | Xor 
  deriving (Show,Eq,Ord,Data,Typeable)
data Atom 
  = LitA  TLit
  | VarA  TVar
  deriving (Show,Eq,Ord,Data,Typeable)
data UAtom 
  = LitUA  Lit
  | VarUA  Lident
  deriving (Show,Eq,Ord,Data,Typeable)
data ICond 
  = Equ 
  | Neq 
  | Ugt 
  | Sgt 
  | Uge 
  | Sge 
  | Ult 
  | Slt 
  | Ule 
  | Sle 
  deriving (Show,Eq,Ord,Data,Typeable)
data FCond 
  = Ogt 
  | Oge 
  | Olt 
  | Ole 
  deriving (Show,Eq,Ord,Data,Typeable)
data SwitchAlt 
  = SwitchAlt  TLit Lident
  deriving (Show,Eq,Ord,Data,Typeable)
data Lit 
  = NmbrL  Number
  | FalseL 
  | TrueL 
  | StringL  Number Lident
  | VoidL 
  deriving (Show,Eq,Ord,Data,Typeable)
data TVar 
  = TVar  Type Lident
  deriving (Show,Eq,Ord,Data,Typeable)
data TLit 
  = TLit  Type Lit
  deriving (Show,Eq,Ord,Data,Typeable)
data FieldT 
  = FieldT  Uident Type
  deriving (Show,Eq,Ord,Data,Typeable)
data ConC 
  = ConC  Uident Type
  deriving (Show,Eq,Ord,Data,Typeable)
data Type 
  = PtrT  Type
  | IntT  Number
  | FloatT 
  | DoubleT 
  | VoidT 
  | FunT  Type TypeList
  | VarArgsT 
  | UserT  Lident
  | StructT  TypeList
  | ArrayT  Number Type
  | CharT 
  deriving (Show,Eq,Ord,Data,Typeable)
type ConCList  = [ConC ]
type FieldTList  = [FieldT ]
type TypeList  = [Type ]
type ExpList  = [Exp ]
type AtomList  = [Atom ]
type TVarList  = [TVar ]
type SwitchAltList  = [SwitchAlt ]
type StmtList  = [Stmt ]
type DefineList  = [Define ]
instance Pretty (Module ) where
  pretty = ppModule
ppModule x = case x of
  Module  v1 -> ppDefineList v1
instance Pretty (Define ) where
  pretty = ppDefine
ppDefine x = case x of
  Define  v1 v2 v3 v4 -> text "define" <+> ppType v1 <+> ppLident v2 <+> text "(" <+> ppTVarList v3 <+> text ")" <+> text "{" <+> ppStmtList v4 <+> text "}"
  Declare  v1 v2 v3 -> text "declare" <+> ppType v1 <+> ppLident v2 <+> text "(" <+> ppTypeList v3 <+> text ")"
  TypeD  v1 v2 -> ppLident v1 <+> text "=" <+> text "type" <+> ppType v2
  StringD  v1 v2 v3 -> ppLident v1 <+> text "= private constant [" <+> ppNumber v2 <+> text "x i8 ] c" <> text "\"" <> ppLident v3 <> text "\\00\""
instance Pretty (Stmt ) where
  pretty = ppStmt
ppStmt x = case x of
  LetS  v1 v2 -> ppLident v1 <+> text "=" <+> ppExp v2
  StoreS  v1 v2 -> text "store" <+> ppAtom v1 <> text "," <+> ppTVar v2
  CallS  v1 v2 -> text "call" <+> ppTVar v1 <+> text "(" <+> ppAtomList v2 <+> text ")"
  SwitchS  v1 v2 v3 -> text "switch" <+> ppAtom v1 <> text ", label %" <> ppLident v2 <+> text "[" <+> ppSwitchAltList v3 <+> text "]"
  ReturnS  v1 -> text "ret" <+> ppAtom v1
  LabelS  v1 -> ppLident v1 <> text ":"
  BrS  v1 v2 v3 -> text "br i1" <+> ppUAtom v1 <> text ", label %" <> ppLident v2 <> text ", label %" <> ppLident v3
  Br0S  v1 -> text "br label %" <> ppLident v1
  TagS  v1 -> text "store" <+> ppAtom v1 <> text ","
  NoOpS   -> text ";"
instance Pretty (Exp ) where
  pretty = ppExp
ppExp x = case x of
  CallE  v1 v2 -> text "call" <+> ppTVar v1 <+> text "(" <+> ppAtomList v2 <+> text ")"
  CastE  v1 v2 v3 -> ppCast v1 <+> ppTVar v2 <+> text "to" <+> ppType v3
  AllocaE  v1 -> text "alloca" <+> ppType v1
  LoadE  v1 -> text "load" <+> ppTVar v1
  AtomE  v1 -> ppAtom v1
  BinOpE  v1 v2 v3 v4 -> ppBinOp v1 <+> ppType v2 <+> ppUAtom v3 <> text "," <+> ppUAtom v4
  IdxE  v1 v2 -> text "getelementptr inbounds" <+> ppTVar v1 <> text ", i32 0," <+> ppAtom v2
instance Pretty (Cast ) where
  pretty = ppCast
ppCast x = case x of
  Bitcast   -> text "bitcast"
  Sitofp   -> text "sitofp"
  Uitofp   -> text "uitofp"
  Fptosi   -> text "fptosi"
  Fptoui   -> text "fptoui"
  Trunc   -> text "trunc"
  Zext   -> text "zext"
  Sext   -> text "sext"
  Fptrunc   -> text "fptrunc"
  Fpext   -> text "fpext"
instance Pretty (BinOp ) where
  pretty = ppBinOp
ppBinOp x = case x of
  Icmp  v1 -> text "icmp" <+> ppICond v1
  Fcmp  v1 -> text "fcmp" <+> ppFCond v1
  Add   -> text "add nuw nsw"
  Fadd   -> text "fadd"
  Sub   -> text "sub nuw nsw"
  Fsub   -> text "fsub"
  Mul   -> text "mul nuw nsw"
  Fmul   -> text "fmul"
  Udiv   -> text "udiv"
  Sdiv   -> text "sdiv"
  Fdiv   -> text "fdiv"
  Urem   -> text "urem"
  Srem   -> text "srem"
  Frem   -> text "frem"
  Shl   -> text "shl"
  Lshr   -> text "lshr"
  And   -> text "and"
  Or   -> text "or"
  Xor   -> text "xor"
instance Pretty (Atom ) where
  pretty = ppAtom
ppAtom x = case x of
  LitA  v1 -> ppTLit v1
  VarA  v1 -> ppTVar v1
instance Pretty (UAtom ) where
  pretty = ppUAtom
ppUAtom x = case x of
  LitUA  v1 -> ppLit v1
  VarUA  v1 -> ppLident v1
instance Pretty (ICond ) where
  pretty = ppICond
ppICond x = case x of
  Equ   -> text "eq"
  Neq   -> text "ne"
  Ugt   -> text "ugt"
  Sgt   -> text "sgt"
  Uge   -> text "uge"
  Sge   -> text "sge"
  Ult   -> text "ult"
  Slt   -> text "slt"
  Ule   -> text "ule"
  Sle   -> text "sle"
instance Pretty (FCond ) where
  pretty = ppFCond
ppFCond x = case x of
  Ogt   -> text "ogt"
  Oge   -> text "oge"
  Olt   -> text "olt"
  Ole   -> text "ole"
instance Pretty (SwitchAlt ) where
  pretty = ppSwitchAlt
ppSwitchAlt x = case x of
  SwitchAlt  v1 v2 -> ppTLit v1 <> text ", label %" <> ppLident v2
instance Pretty (Lit ) where
  pretty = ppLit
ppLit x = case x of
  NmbrL  v1 -> ppNumber v1
  FalseL   -> text "false"
  TrueL   -> text "true"
  StringL  v1 v2 -> text "getelementptr inbounds ([" <+> ppNumber v1 <+> text "x i8 ]*" <+> ppLident v2 <> text ", i32 0, i32 0)"
  VoidL   -> Text.PrettyPrint.Leijen.empty
instance Pretty (TVar ) where
  pretty = ppTVar
ppTVar x = case x of
  TVar  v1 v2 -> ppType v1 <+> ppLident v2
instance Pretty (TLit ) where
  pretty = ppTLit
ppTLit x = case x of
  TLit  v1 v2 -> ppType v1 <+> ppLit v2
instance Pretty (FieldT ) where
  pretty = ppFieldT
ppFieldT x = case x of
  FieldT  v1 v2 -> ppUident v1 <+> text "::" <+> ppType v2
instance Pretty (ConC ) where
  pretty = ppConC
ppConC x = case x of
  ConC  v1 v2 -> ppUident v1 <+> ppType v2
instance Pretty (Type ) where
  pretty = ppType
ppType x = case x of
  PtrT  v1 -> ppType v1 <> text "*"
  IntT  v1 -> text "i" <> ppNumber v1
  FloatT   -> text "float"
  DoubleT   -> text "double"
  VoidT   -> text "void"
  FunT  v1 v2 -> ppType v1 <+> text "(" <+> ppTypeList v2 <+> text ")"
  VarArgsT   -> text "..."
  UserT  v1 -> ppLident v1
  StructT  v1 -> text "{" <+> ppTypeList v1 <+> text "}"
  ArrayT  v1 v2 -> text "[" <+> ppNumber v1 <+> text "x" <+> ppType v2 <+> text "]"
  CharT   -> text "i8"
ppConCList = ppList ppConC Separator "|" Horiz
ppFieldTList = ppList ppFieldT Separator "," Horiz
ppTypeList = ppList ppType Separator "," Horiz
ppExpList = ppList ppExp Separator "," Horiz
ppAtomList = ppList ppAtom Separator "," Horiz
ppTVarList = ppList ppTVar Separator "," Horiz
ppSwitchAltList = ppList ppSwitchAlt Terminator "" Vert
ppStmtList = ppList ppStmt Terminator "" Vert
ppDefineList = ppList ppDefine Terminator "" Vert