Abs.hs

{-# LANGUAGE DeriveDataTypeable #-}
module Language.Pir.Abs where
import Control.DeepSeq
import Data.Generics
import Grm.Prims
import Grm.Lex
import Text.PrettyPrint.Leijen
myLexemes = ["(",")",",","->","::",":=",";","=","alloca","call","cast","define","enum","if","import","load","module","noop","record","return","switch","tagged","when","while","{","|","}"]
grmLexFilePath = lexFilePath myLexemes
grmLexContents = lexContents myLexemes
data Module 
  = Module  Uident ImportList DefineList
  deriving (Show,Eq,Ord,Data,Typeable)
data Import 
  = Import  Uident
  deriving (Show,Eq,Ord,Data,Typeable)
data Define 
  = Define  Type Lident TVarList StmtList
  deriving (Show,Eq,Ord,Data,Typeable)
data Stmt 
  = LetS  TVar Exp
  | StoreS  TVar Atom
  | CallS  TVar AtomList
  | SwitchS  Atom StmtList SwitchAltList
  | IfS  Atom StmtList StmtList
  | WhenS  Atom StmtList
  | WhileS  StmtList Atom StmtList
  | ReturnS  Atom
  | NoOpS 
  deriving (Show,Eq,Ord,Data,Typeable)
data Exp 
  = CallE  TVar AtomList
  | CastE  TVar Type
  | AllocaE  Type
  | LoadE  TVar
  | AtomE  Atom
  deriving (Show,Eq,Ord,Data,Typeable)
data Atom 
  = LitA  TLit
  | VarA  TVar
  deriving (Show,Eq,Ord,Data,Typeable)
data SwitchAlt 
  = SwitchAlt  TLit StmtList
  deriving (Show,Eq,Ord,Data,Typeable)
data Lit 
  = StringL  String
  | NmbrL  Number
  | CharL  Char
  | EnumL  Uident
  | VoidL 
  deriving (Show,Eq,Ord,Data,Typeable)
data TyDecl 
  = TyEnum  EnumCList
  | TyRecord  FieldTList
  | TyTagged  ConCList
  deriving (Show,Eq,Ord,Data,Typeable)
data TVar 
  = TVar  Lident Type
  deriving (Show,Eq,Ord,Data,Typeable)
data TLit 
  = TLit  Lit Type
  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 
  = Type  Uident TypeList
  deriving (Show,Eq,Ord,Data,Typeable)
data EnumC 
  = EnumC  Uident
  deriving (Show,Eq,Ord,Data,Typeable)
type ConCList  = [ConC ]
type FieldTList  = [FieldT ]
type EnumCList  = [EnumC ]
type TypeList  = [Type ]
type ExpList  = [Exp ]
type AtomList  = [Atom ]
type TVarList  = [TVar ]
type SwitchAltList  = [SwitchAlt ]
type StmtList  = [Stmt ]
type DefineList  = [Define ]
type ImportList  = [Import ]
instance Pretty (Module ) where
  pretty = ppModule
ppModule x = case x of
  Module  v1 v2 v3 -> text "module" <+> ppUident v1 <+> ppImportList v2 <+> ppDefineList v3
instance Pretty (Import ) where
  pretty = ppImport
ppImport x = case x of
  Import  v1 -> text "import" <+> ppUident 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 "=" <+> text "{" <+> ppStmtList v4 <+> text "}"
instance Pretty (Stmt ) where
  pretty = ppStmt
ppStmt x = case x of
  LetS  v1 v2 -> ppTVar v1 <+> text "=" <+> ppExp v2
  StoreS  v1 v2 -> ppTVar v1 <+> text ":=" <+> ppAtom v2
  CallS  v1 v2 -> text "call" <+> ppTVar v1 <+> text "(" <+> ppAtomList v2 <+> text ")"
  SwitchS  v1 v2 v3 -> text "switch" <+> ppAtom v1 <+> text "{" <+> ppStmtList v2 <+> text "}" <+> text "{" <+> ppSwitchAltList v3 <+> text "}"
  IfS  v1 v2 v3 -> text "if" <+> ppAtom v1 <+> text "{" <+> ppStmtList v2 <+> text "}" <+> text "{" <+> ppStmtList v3 <+> text "}"
  WhenS  v1 v2 -> text "when" <+> ppAtom v1 <+> text "{" <+> ppStmtList v2 <+> text "}"
  WhileS  v1 v2 v3 -> text "while" <+> text "{" <+> ppStmtList v1 <+> text "}" <+> ppAtom v2 <+> text "{" <+> ppStmtList v3 <+> text "}"
  ReturnS  v1 -> text "return" <+> ppAtom v1
  NoOpS   -> text "noop"
instance Pretty (Exp ) where
  pretty = ppExp
ppExp x = case x of
  CallE  v1 v2 -> ppTVar v1 <+> text "(" <+> ppAtomList v2 <+> text ")"
  CastE  v1 v2 -> text "cast" <+> ppTVar v1 <+> ppType v2
  AllocaE  v1 -> text "alloca" <+> ppType v1
  LoadE  v1 -> text "load" <+> text "(" <+> ppTVar v1 <+> text ")"
  AtomE  v1 -> ppAtom v1
instance Pretty (Atom ) where
  pretty = ppAtom
ppAtom x = case x of
  LitA  v1 -> ppTLit v1
  VarA  v1 -> ppTVar v1
instance Pretty (SwitchAlt ) where
  pretty = ppSwitchAlt
ppSwitchAlt x = case x of
  SwitchAlt  v1 v2 -> ppTLit v1 <+> text "->" <+> text "{" <+> ppStmtList v2 <+> text "}"
instance Pretty (Lit ) where
  pretty = ppLit
ppLit x = case x of
  StringL  v1 -> ppString v1
  NmbrL  v1 -> ppNumber v1
  CharL  v1 -> ppChar v1
  EnumL  v1 -> ppUident v1
  VoidL   -> Text.PrettyPrint.Leijen.empty
instance Pretty (TyDecl ) where
  pretty = ppTyDecl
ppTyDecl x = case x of
  TyEnum  v1 -> text "enum" <+> ppEnumCList v1
  TyRecord  v1 -> text "record" <+> text "{" <+> ppFieldTList v1 <+> text "}"
  TyTagged  v1 -> text "tagged" <+> ppConCList v1
instance Pretty (TVar ) where
  pretty = ppTVar
ppTVar x = case x of
  TVar  v1 v2 -> ppLident v1 <+> text "::" <+> ppType v2
instance Pretty (TLit ) where
  pretty = ppTLit
ppTLit x = case x of
  TLit  v1 v2 -> ppLit v1 <+> text "::" <+> ppType 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
  Type  v1 v2 -> ppUident v1 <+> text "(" <+> ppTypeList v2 <+> text ")"
instance Pretty (EnumC ) where
  pretty = ppEnumC
ppEnumC x = case x of
  EnumC  v1 -> ppUident v1
ppConCList = ppList ppConC Separator "|" Horiz
ppFieldTList = ppList ppFieldT Separator "," Horiz
ppEnumCList = ppList ppEnumC 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
ppImportList = ppList ppImport Terminator ";" Vert