Store basis type separately in GEP/ConstGEP

With opaque pointers, one cannot tell what the basis type for a `getelementptr`
instruction (or constant expression) is by inspecting the parent pointer. As a
result, we now store the basis type separately in `GEP`/`ConstGEP` so that it
can be determined regardless of whether opaque pointers are used or not.

See #102.

src/Text/LLVM.hs

@@ -694,8 +694,8 @@ select c t f = observe (typedType t)
              $ Select (toValue `fmap` c) (toValue `fmap` t) (toValue f)
 
 getelementptr :: IsValue a
-              => Type -> Typed a -> [Typed Value] -> BB (Typed Value)
-getelementptr ty ptr ixs = observe ty (GEP False (toValue `fmap` ptr) ixs)
+              => Type -> a -> [Typed Value] -> BB (Typed Value)
+getelementptr ty ptr ixs = observe ty (GEP False ty (toValue ptr) ixs)
 
 -- | Emit a call instruction, and generate a new variable for its result.
 call :: IsValue a => Typed a -> [Typed Value] -> BB (Typed Value)

src/Text/LLVM/AST.hs

@@ -881,10 +881,11 @@ data Instr' lab
          * Middle of basic block.
          * Returns a value of the specified type. -}
 
-  | GEP Bool (Typed (Value' lab)) [Typed (Value' lab)]
+  | GEP Bool Type (Value' lab) [Typed (Value' lab)]
     {- ^ * "Get element pointer",
             compute the address of a field in a structure:
             inbounds check (value poisoned if this fails);
+            type to use as a basis for calculations;
             pointer to parent structure;
             path to a sub-component of a structure.
          * Middle of basic block.
@@ -1118,8 +1119,11 @@ extendMetadata md stmt = case stmt of
 -- Constant Expressions --------------------------------------------------------
 
 data ConstExpr' lab
-  = ConstGEP Bool (Maybe Word64) (Maybe Type) [Typed (Value' lab)]
-  -- ^ Element type introduced in LLVM 3.7
+  = ConstGEP Bool (Maybe Word64) Type (Value' lab) [Typed (Value' lab)]
+  -- ^ Since LLVM 3.7, constant @getelementptr@ expressions include an explicit
+  -- type to use as a basis for calculations. For older versions of LLVM, this
+  -- type can be reconstructed by inspecting the pointee type of the parent
+  -- pointer value.
   | ConstConv ConvOp (Typed (Value' lab)) Type
   | ConstSelect (Typed (Value' lab)) (Typed (Value' lab)) (Typed (Value' lab))
   | ConstBlockAddr (Typed (Value' lab)) lab

src/Text/LLVM/Labels.hs

@@ -63,8 +63,8 @@ instance HasLabel Instr' where
   relabel f (FCmp op l r)         = FCmp op
                                 <$> traverse (relabel f) l
                                 <*> relabel f r
-  relabel f (GEP ib a is)         = GEP ib
-                                <$> traverse (relabel f) a
+  relabel f (GEP ib t a is)       = GEP ib t
+                                <$> relabel f a
                                 <*> traverse (traverse (relabel f)) is
   relabel f (Select c l r)        = Select
                                 <$> traverse (relabel f) c

src/Text/LLVM/PP.hs

@@ -554,7 +554,7 @@ ppInstr instr = case instr of
   ShuffleVector a b m    -> "shufflevector" <+> ppTyped ppValue a
                          <> comma <+> ppTyped ppValue (b <$ a)
                          <> comma <+> ppTyped ppValue m
-  GEP ib ptr ixs         -> ppGEP ib ptr ixs
+  GEP ib ty ptr ixs      -> ppGEP ib ty ptr ixs
   Comment str            -> char ';' <+> text str
   Jump i                 -> "br"
                         <+> ppTypedLabel i
@@ -711,17 +711,15 @@ ppCallSym ty val = pp_ty <+> ppValue val
           -> ppType res
         _ -> ppType ty
 
-ppGEP :: LLVM => Bool -> Typed Value -> [Typed Value] -> Doc
-ppGEP ib ptr ixs = "getelementptr" <+> inbounds
-               <+> (if isImplicit then empty else explicit)
-               <+> commas (map (ppTyped ppValue) (ptr:ixs))
+ppGEP :: LLVM => Bool -> Type -> Value -> [Typed Value] -> Doc
+ppGEP ib ty ptr ixs =
+  "getelementptr" <+> inbounds
+    <+> (if isImplicit then empty else explicit)
+    <+> commas (ppValue ptr : map (ppTyped ppValue) ixs)
   where
   isImplicit = checkConfig cfgGEPImplicitType
 
-  explicit =
-    case typedType ptr of
-      PtrTo ty -> ppType ty <> comma
-      ty       -> ppType ty <> comma
+  explicit = ppType ty <> comma
 
   inbounds | ib        = "inbounds"
            | otherwise = empty
@@ -869,10 +867,10 @@ ppAsm s a i c =
 ppConstExpr' :: LLVM => (i -> Doc) -> ConstExpr' i -> Doc
 ppConstExpr' pp expr =
   case expr of
-    ConstGEP inb _mix mp ixs  ->
+    ConstGEP inb _mix ty ptr ixs  ->
       "getelementptr"
         <+> opt inb "inbounds"
-        <+> parens (mcommas ((ppType <$> mp) : (map (pure . ppTyp') ixs)))
+        <+> parens (commas (ppType ty : ppVal' ptr : map ppTyp' ixs))
     ConstConv op tv t  -> ppConvOp op <+> parens (ppTyp' tv <+> "to" <+> ppType t)
     ConstSelect c l r  ->
       "select" <+> parens (commas [ ppTyp' c, ppTyp' l , ppTyp' r])