[commit: ghc] wip/kavon-nosplit-llvm: doing some refactoring to add CPSCall pp (35acd14)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/kavon-nosplit-llvm
Link       : http://ghc.haskell.org/trac/ghc/changeset/35acd142af52a201c71f151d03af4f5ad59468c6/ghc

>---------------------------------------------------------------

commit 35acd142af52a201c71f151d03af4f5ad59468c6
Author: Kavon Farvardin <kavon at farvard.in>
Date:   Wed May 31 16:27:24 2017 +0100

    doing some refactoring to add CPSCall pp


>---------------------------------------------------------------

35acd142af52a201c71f151d03af4f5ad59468c6
 compiler/llvmGen/Llvm/PpLlvm.hs | 35 +++++++++++++++++++----------------
 1 file changed, 19 insertions(+), 16 deletions(-)

diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
index 5812340..c1dd9fd 100644
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
@@ -251,30 +251,33 @@ ppLlvmExpression expr
 -- | Should always be a function pointer. So a global var of function type
 -- (since globals are always pointers) or a local var of pointer function type.
 ppCall :: LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
-ppCall ct fptr args attrs = case fptr of
-                           --
-    -- if local var function pointer, unwrap
-    LMLocalVar _ (LMPointer (LMFunction d)) -> ppCall' d
-
-    -- should be function type otherwise
-    LMGlobalVar _ (LMFunction d) _ _ _ _    -> ppCall' d
-
-    -- not pointer or function, so error
-    _other -> error $ "ppCall called with non LMFunction type!\nMust be "
-                ++ " called with either global var of function type or "
-                ++ "local var of pointer function type."
+ppCall ct fptr args attrs = let
+        decl = getDecl fptr
+    in case ct of 
+        TailCall -> ppRegularCall (text "tail ") decl
+        StdCall  -> ppRegularCall empty decl
+        CPSCall {} -> panic "pp CPSCall pls"
     
     where
-        ppCall' (LlvmFunctionDecl _ _ cc ret argTy params _) =
-            let tc = if ct == TailCall then text "tail " else empty
-                ppValues = hsep $ punctuate comma $ map ppCallMetaExpr args
+        getDecl fptr = case fptr of
+            -- if local var function pointer, unwrap
+            LMLocalVar _ (LMPointer (LMFunction d)) -> d
+            -- should be function type otherwise
+            LMGlobalVar _ (LMFunction d) _ _ _ _    -> d
+            -- not pointer or function, so error
+            _other -> error $ "ppCall called with non LMFunction type!\nMust be "
+                        ++ " called with either global var of function type or "
+                        ++ "local var of pointer function type."
+                        
+        ppRegularCall tailMarker (LlvmFunctionDecl _ _ cc ret argTy params _) =
+            let ppValues = hsep $ punctuate comma $ map ppCallMetaExpr args
                 ppArgTy  = (ppCommaJoin $ map fst params) <>
                            (case argTy of
                                VarArgs   -> text ", ..."
                                FixedArgs -> empty)
                 fnty = space <> lparen <> ppArgTy <> rparen
                 attrDoc = ppSpaceJoin attrs
-            in  tc <> text "call" <+> ppr cc <+> ppr ret
+            in  tailMarker <> text "call" <+> ppr cc <+> ppr ret
                     <> fnty <+> ppName fptr <> lparen <+> ppValues
                     <+> rparen <+> attrDoc