ppLlvmComment,
ppLlvmGlobals,
ppLlvmGlobal,
- ppLlvmType,
- ppLlvmTypes,
+ ppLlvmAlias,
+ ppLlvmAliases,
ppLlvmFunctionDecls,
ppLlvmFunctionDecl,
ppLlvmFunctions,
-- | Print out a whole LLVM module.
ppLlvmModule :: LlvmModule -> Doc
-ppLlvmModule (LlvmModule comments globals decls funcs)
+ppLlvmModule (LlvmModule comments aliases globals decls funcs)
= ppLlvmComments comments
$+$ empty
+ $+$ ppLlvmAliases aliases
+ $+$ empty
$+$ ppLlvmGlobals globals
$+$ empty
$+$ ppLlvmFunctionDecls decls
-- | Print out a list of LLVM type aliases.
-ppLlvmTypes :: [LlvmType] -> Doc
-ppLlvmTypes tys = vcat $ map ppLlvmType tys
+ppLlvmAliases :: [LlvmAlias] -> Doc
+ppLlvmAliases tys = vcat $ map ppLlvmAlias tys
-- | Print out an LLVM type alias.
-ppLlvmType :: LlvmType -> Doc
-
-ppLlvmType al@(LMAlias _ t)
- = texts al <+> equals <+> text "type" <+> texts t
-
-ppLlvmType (LMFunction t)
- = ppLlvmFunctionDecl t
-
-ppLlvmType _ = empty
+ppLlvmAlias :: LlvmAlias -> Doc
+ppLlvmAlias (name, ty) = text "%" <> ftext name <+> equals <+> text "type" <+> texts ty
-- | Print out a list of function definitions.
Return result -> ppReturn result
Expr expr -> ppLlvmExpression expr
Unreachable -> text "unreachable"
+ Nop -> empty
-- | Print out an LLVM expression.
Call tp fp args attrs -> ppCall tp fp args attrs
Cast op from to -> ppCast op from to
Compare op left right -> ppCmpOp op left right
- GetElemPtr ptr indexes -> ppGetElementPtr ptr indexes
+ GetElemPtr inb ptr indexes -> ppGetElementPtr inb ptr indexes
Load ptr -> ppLoad ptr
Malloc tp amount -> ppMalloc tp amount
Phi tp precessors -> ppPhi tp precessors
+ Asm asm c ty v se sk -> ppAsm asm c ty v se sk
--------------------------------------------------------------------------------
let cmpOp
| isInt (getVarType left) && isInt (getVarType right) = text "icmp"
| isFloat (getVarType left) && isFloat (getVarType right) = text "fcmp"
+ | otherwise = text "icmp" -- Just continue as its much easier to debug
+ {-
| otherwise = error ("can't compare different types, left = "
++ (show $ getVarType left) ++ ", right = "
++ (show $ getVarType right))
+ -}
in cmpOp <+> texts op <+> texts (getVarType left)
<+> (text $ getName left) <> comma <+> (text $ getName right)
in text "alloca" <+> texts tp <> comma <+> texts amount'
-ppGetElementPtr :: LlvmVar -> [Int] -> Doc
-ppGetElementPtr ptr idx =
- let indexes = hcat $ map ((comma <+> texts i32 <+>) . texts) idx
- in text "getelementptr" <+> texts ptr <> indexes
+ppGetElementPtr :: Bool -> LlvmVar -> [LlvmVar] -> Doc
+ppGetElementPtr inb ptr idx =
+ let indexes = comma <+> ppCommaJoin idx
+ inbound = if inb then text "inbounds" else empty
+ in text "getelementptr" <+> inbound <+> texts ptr <> indexes
ppReturn :: Maybe LlvmVar -> Doc
<+> ppTargets targets
+ppAsm :: LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> Doc
+ppAsm asm constraints rty vars sideeffect alignstack =
+ let asm' = doubleQuotes $ ftext asm
+ cons = doubleQuotes $ ftext constraints
+ rty' = texts rty
+ vars' = lparen <+> ppCommaJoin vars <+> rparen
+ side = if sideeffect then text "sideeffect" else empty
+ align = if alignstack then text "alignstack" else empty
+ in text "call" <+> rty' <+> text "asm" <+> side <+> align <+> asm' <> comma
+ <+> cons <> vars'
+
+
--------------------------------------------------------------------------------
-- * Misc functions
--------------------------------------------------------------------------------