Commit e553a601 authored by dterei's avatar dterei

LLVM: Add alias type defenitions to LlvmModule.

parent d7b86136
......@@ -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
......
......@@ -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],
......
......@@ -10,8 +10,8 @@ module Llvm.PpLlvm (
ppLlvmComment,
ppLlvmGlobals,
ppLlvmGlobal,
ppLlvmType,
ppLlvmTypes,
ppLlvmAlias,
ppLlvmAliases,
ppLlvmFunctionDecls,
ppLlvmFunctionDecl,
ppLlvmFunctions,
......@@ -38,8 +38,10 @@ 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
......@@ -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.
......
......@@ -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
-- -----------------------------------------------------------------------------
......
......@@ -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!"
......
......@@ -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'
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment