X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FllvmGen%2FLlvm%2FTypes.hs;h=3637c864673ebd74f51c01f2ee3960ed3bc7cc1e;hb=86add45dbfb6f962b65e371143dd467ae783f9e7;hp=0d66dd3282ebc2d2f577326e5465391a43235154;hpb=fb218a784685dc0452f3e584d238c8db7826d499;p=ghc-hetmet.git

diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index 0d66dd3..3637c86 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -5,7 +5,6 @@
 module Llvm.Types where
 
 #include "HsVersions.h"
-#include "ghcconfig.h"
 
 import Data.Char
 import Numeric
@@ -22,24 +21,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
@@ -55,7 +56,7 @@ instance Show LlvmType where
   show (LMArray nr tp ) = "[" ++ show nr ++ " x " ++ show tp ++ "]"
   show (LMLabel       ) = "label"
   show (LMVoid        ) = "void"
-  show (LMStruct tys  ) = "{" ++ (commaCat tys) ++ "}"
+  show (LMStruct tys  ) = "<{" ++ (commaCat tys) ++ "}>"
 
   show (LMFunction (LlvmFunctionDecl _ _ _ r varg p _))
     = let args = ((drop 1).concat) $ -- use drop since it can handle empty lists
@@ -66,9 +67,9 @@ 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
+-- | An LLVM section definition. If Nothing then let LLVM decide the section
 type LMSection = Maybe LMString
 type LMAlign = Maybe Int
 type LMConst = Bool -- ^ is a variable constant or not
@@ -144,9 +145,9 @@ instance Show LlvmStatic where
 
   show (LMStaticStruc d t)
       = let struc = case d of
-              [] -> "{}"
-              ts -> "{" ++ show (head ts) ++
-                      concat (map (\x -> "," ++ show x) (tail ts)) ++ "}"
+              [] -> "<{}>"
+              ts -> "<{" ++ show (head ts) ++
+                      concat (map (\x -> "," ++ show x) (tail ts)) ++ "}>"
         in show t ++ " " ++ struc
 
   show (LMStaticPointer v) = show v
@@ -199,7 +200,8 @@ getName v@(LMLitVar    _          ) = getPlainName v
 -- in a plain textual representation (e.g. @x@, @y@ or @42@).
 getPlainName :: LlvmVar -> String
 getPlainName (LMGlobalVar x _ _ _ _ _) = unpackFS x
-getPlainName (LMLocalVar  x _        ) = show x
+getPlainName (LMLocalVar  x LMLabel  ) = show x
+getPlainName (LMLocalVar  x _        ) = "l" ++ show x
 getPlainName (LMNLocalVar x _        ) = unpackFS x
 getPlainName (LMLitVar    x          ) = getLit x
 
@@ -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
 
 
 -- -----------------------------------------------------------------------------