From: David Terei Date: Wed, 7 Jul 2010 14:20:53 +0000 (+0000) Subject: LLVM: Add alias type defenitions to LlvmModule. X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=e553a60151dc282c8b8c201871212cba0c3bf2a0 LLVM: Add alias type defenitions to LlvmModule. --- diff --git a/compiler/llvmGen/Llvm.hs b/compiler/llvmGen/Llvm.hs index dcb8706..aec492e 100644 --- a/compiler/llvmGen/Llvm.hs +++ b/compiler/llvmGen/Llvm.hs @@ -29,7 +29,7 @@ module Llvm ( -- * Variables and Type System LlvmVar(..), LlvmStatic(..), LlvmLit(..), LlvmType(..), - LMGlobal, LMString, LMSection, LMAlign, + LlvmAlias, LMGlobal, LMString, LMSection, LMAlign, -- ** Some basic types i64, i32, i16, i8, i1, i8Ptr, llvmWord, llvmWordPtr, @@ -42,7 +42,7 @@ module Llvm ( -- * Pretty Printing ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmGlobals, ppLlvmGlobal, ppLlvmFunctionDecls, ppLlvmFunctionDecl, ppLlvmFunctions, - ppLlvmFunction, ppLlvmType, ppLlvmTypes, llvmSDoc + ppLlvmFunction, ppLlvmAlias, ppLlvmAliases, llvmSDoc ) where diff --git a/compiler/llvmGen/Llvm/AbsSyn.hs b/compiler/llvmGen/Llvm/AbsSyn.hs index 7a5b700..6b61368 100644 --- a/compiler/llvmGen/Llvm/AbsSyn.hs +++ b/compiler/llvmGen/Llvm/AbsSyn.hs @@ -28,6 +28,9 @@ data LlvmModule = LlvmModule { -- | Comments to include at the start of the module. modComments :: [LMString], + -- | LLVM Alias type defenitions. + modAliases :: [LlvmAlias], + -- | Global variables to include in the module. modGlobals :: [LMGlobal], diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs index 4391fc5..1a41954 100644 --- a/compiler/llvmGen/Llvm/PpLlvm.hs +++ b/compiler/llvmGen/Llvm/PpLlvm.hs @@ -10,8 +10,8 @@ module Llvm.PpLlvm ( ppLlvmComment, ppLlvmGlobals, ppLlvmGlobal, - ppLlvmType, - ppLlvmTypes, + ppLlvmAlias, + ppLlvmAliases, ppLlvmFunctionDecls, ppLlvmFunctionDecl, ppLlvmFunctions, @@ -38,9 +38,11 @@ import Unique -- | 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 @@ -83,19 +85,12 @@ ppLlvmGlobal oth = error $ "Non Global var ppr as global! " ++ show oth -- | 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. diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs index 0a39d38..0a4fff2 100644 --- a/compiler/llvmGen/Llvm/Types.hs +++ b/compiler/llvmGen/Llvm/Types.hs @@ -22,24 +22,26 @@ import PprBase -- -- | A global mutable variable. Maybe defined or external -type LMGlobal = (LlvmVar, Maybe LlvmStatic) +type LMGlobal = (LlvmVar, Maybe LlvmStatic) -- | A String in LLVM -type LMString = FastString +type LMString = FastString +-- | A type alias +type LlvmAlias = (LMString, LlvmType) --- | Llvm Types. +-- | Llvm Types data LlvmType - = LMInt Int -- ^ An integer with a given width in bits. - | LMFloat -- ^ 32 bit floating point - | LMDouble -- ^ 64 bit floating point - | LMFloat80 -- ^ 80 bit (x86 only) floating point - | LMFloat128 -- ^ 128 bit floating point - | LMPointer LlvmType -- ^ A pointer to a 'LlvmType' - | LMArray Int LlvmType -- ^ An array of 'LlvmType' - | LMLabel -- ^ A 'LlvmVar' can represent a label (address) - | LMVoid -- ^ Void type - | LMStruct [LlvmType] -- ^ Structure type - | LMAlias LMString LlvmType -- ^ A type alias + = LMInt Int -- ^ An integer with a given width in bits. + | LMFloat -- ^ 32 bit floating point + | LMDouble -- ^ 64 bit floating point + | LMFloat80 -- ^ 80 bit (x86 only) floating point + | LMFloat128 -- ^ 128 bit floating point + | LMPointer LlvmType -- ^ A pointer to a 'LlvmType' + | LMArray Int LlvmType -- ^ An array of 'LlvmType' + | LMLabel -- ^ A 'LlvmVar' can represent a label (address) + | LMVoid -- ^ Void type + | LMStruct [LlvmType] -- ^ Structure type + | LMAlias LlvmAlias -- ^ A type alias -- | Function type, used to create pointers to functions | LMFunction LlvmFunctionDecl @@ -66,7 +68,7 @@ instance Show LlvmType where _otherwise -> "" in show r ++ " (" ++ args ++ varg' ++ ")" - show (LMAlias s _ ) = "%" ++ unpackFS s + show (LMAlias (s,_)) = "%" ++ unpackFS s -- | An LLVM section defenition. If Nothing then let LLVM decide the section type LMSection = Maybe LMString @@ -318,7 +320,7 @@ llvmWidthInBits LMLabel = 0 llvmWidthInBits LMVoid = 0 llvmWidthInBits (LMStruct tys) = sum $ map llvmWidthInBits tys llvmWidthInBits (LMFunction _) = 0 -llvmWidthInBits (LMAlias _ t) = llvmWidthInBits t +llvmWidthInBits (LMAlias (_,t)) = llvmWidthInBits t -- ----------------------------------------------------------------------------- diff --git a/compiler/llvmGen/LlvmCodeGen/Data.hs b/compiler/llvmGen/LlvmCodeGen/Data.hs index 3cf6cda..6214d11 100644 --- a/compiler/llvmGen/LlvmCodeGen/Data.hs +++ b/compiler/llvmGen/LlvmCodeGen/Data.hs @@ -47,7 +47,7 @@ genLlvmData (sec, CmmDataLabel lbl:xs) = getStatTypes (Right x) = getStatType x strucTy = LMStruct types - alias = LMAlias (label `appendFS` structStr) strucTy + alias = LMAlias ((label `appendFS` structStr), strucTy) in (lbl, sec, alias, static) genLlvmData _ = panic "genLlvmData: CmmData section doesn't start with label!" diff --git a/compiler/llvmGen/LlvmCodeGen/Ppr.hs b/compiler/llvmGen/LlvmCodeGen/Ppr.hs index 2a96efb..064aed8 100644 --- a/compiler/llvmGen/LlvmCodeGen/Ppr.hs +++ b/compiler/llvmGen/LlvmCodeGen/Ppr.hs @@ -67,7 +67,11 @@ pprLlvmData (globals, types) = let tryConst (v, Just s ) = ppLlvmGlobal (v, Just s) tryConst g@(_, Nothing) = ppLlvmGlobal g - types' = ppLlvmTypes types + ppLlvmTys (LMAlias a) = ppLlvmAlias a + ppLlvmTys (LMFunction f) = ppLlvmFunctionDecl f + ppLlvmTys _other = empty + + types' = vcat $ map ppLlvmTys types globals' = vcat $ map tryConst globals in types' $+$ globals'