LLVM: Add alias type defenitions to LlvmModule.

diff --git a/compiler/llvmGen/Llvm.hs b/compiler/llvmGen/Llvm.hs
index dcb8706..aec492e 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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'