Add new mem{cpy,set,move} cmm prim ops.

[ghc-hetmet.git] / compiler / llvmGen / Llvm / PpLlvm.hs

diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
index 1a41954..82c6bfa 100644 (file)
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
@@ -161,6 +161,7 @@ ppLlvmStatement stmt
         Return      result        -> ppReturn result
         Expr        expr          -> ppLlvmExpression expr
         Unreachable               -> text "unreachable"
+        Nop                       -> empty
 
 
 -- | Print out an LLVM expression.
@@ -176,6 +177,7 @@ ppLlvmExpression expr
         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
 
 
 --------------------------------------------------------------------------------
@@ -263,9 +265,9 @@ ppAlloca tp amount =
   in text "alloca" <+> texts tp <> comma <+> texts amount'
 
 
-ppGetElementPtr :: Bool -> LlvmVar -> [Int] -> Doc
+ppGetElementPtr :: Bool -> LlvmVar -> [LlvmVar] -> Doc
 ppGetElementPtr inb ptr idx =
-  let indexes = hcat $ map ((comma <+> texts i32 <+>) . texts) idx
+  let indexes = comma <+> ppCommaJoin idx
       inbound = if inb then text "inbounds" else empty
   in text "getelementptr" <+> inbound <+> texts ptr <> indexes
 
@@ -299,6 +301,18 @@ ppSwitch scrut dflt targets =
         <+> 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
 --------------------------------------------------------------------------------