Basic support for opaque pointers

src/Text/LLVM/AST.hs

@@ -260,10 +260,32 @@ data Type' ident
  | Array Word64 (Type' ident)
  | FunTy (Type' ident) [Type' ident] Bool
  | PtrTo (Type' ident)
+ -- ^ A pointer to a memory location of a particular type. See also
+ -- 'PtrOpaque', which represents a pointer without a pointee type.
+ --
+ -- LLVM pointers can also have an optional address space attribute, but this
+ -- is not currently represented in the @llvm-pretty@ AST.
+ | PtrOpaque
+ -- ^ A pointer to a memory location. Unlike 'PtrTo', a 'PtrOpaque' does not
+ -- have a pointee type. Instead, instructions interacting through opaque
+ -- pointers specify the type of the underlying memory they are interacting
+ -- with.
+ --
+ -- LLVM pointers can also have an optional address space attribute, but this
+ -- is not currently represented in the @llvm-pretty@ AST.
+ --
+ -- 'PtrOpaque' should not be confused with 'Opaque', which is a completely
+ -- separate type with a similar-sounding name.
  | Struct [Type' ident]
  | PackedStruct [Type' ident]
  | Vector Word64 (Type' ident)
  | Opaque
+ -- ^ An opaque structure type, used to represent structure types that do not
+ -- have a body specified. This is similar to C's notion of a
+ -- forward-declared structure.
+ --
+ -- 'Opaque' should not be confused with 'PtrOpaque', which is a completely
+ -- separate type with a similar-sounding name.
  deriving (Data, Eq, Functor, Generic, Generic1, Ord, Show, Typeable)
 
 -- | Applicatively traverse a type, updating or removing aliases.
@@ -274,6 +296,7 @@ updateAliasesA f = loop
  Array len ety -> Array len <$> (loop ety)
  FunTy res ps var -> FunTy <$> (loop res) <*> (traverse loop ps) <*> pure var
  PtrTo pty -> PtrTo <$> (loop pty)
+ PtrOpaque -> pure PtrOpaque
  Struct fs -> Struct <$> (traverse loop fs)
  PackedStruct fs -> PackedStruct <$> (traverse loop fs)
  Vector len ety -> Vector <$> pure len <*> (loop ety)
@@ -320,6 +343,7 @@ isArray ty = case ty of
 
 isPointer :: Type -> Bool
 isPointer (PtrTo _) = True
+isPointer PtrOpaque = True
 isPointer _ = False
 
 
@@ -345,6 +369,7 @@ floatTypeNull _ = error "must be a float type"
 typeNull :: Type -> NullResult lab
 typeNull (PrimType pt) = HasNull (primTypeNull pt)
 typeNull PtrTo{} = HasNull ValNull
+typeNull PtrOpaque = HasNull ValNull
 typeNull (Alias i) = ResolveNull i
 typeNull _ = HasNull ValZeroInit
 

src/Text/LLVM/PP.hs

@@ -241,6 +241,7 @@ ppType (PrimType pt) = ppPrimType pt
 ppType (Alias i) = ppIdent i
 ppType (Array len ty) = brackets (integral len <+> char 'x' <+> ppType ty)
 ppType (PtrTo ty) = ppType ty <> char '*'
+ppType PtrOpaque = "ptr"
 ppType (Struct ts) = structBraces (commas (map ppType ts))
 ppType (PackedStruct ts) = angles (structBraces (commas (map ppType ts)))
 ppType (FunTy r as va) = ppType r <> ppArgList va (map ppType as)
@@ -683,7 +684,7 @@ ppCall tc ty f args
 ppCallBr :: LLVM => Type -> Value -> [Typed Value] -> BlockLabel -> [BlockLabel] -> Doc
 ppCallBr ty f args to indirectDests =
  "callbr"
- <+> ppType res <+> ppValue f <> parens (commas (map (ppTyped ppValue) args))
+ <+> ppCallSym res f <> parens (commas (map (ppTyped ppValue) args))
  <+> "to" <+> ppLab to <+> brackets (commas (map ppLab indirectDests))
  where
  ppLab l = ppType (PrimType Label) <+> ppLabel l
@@ -692,9 +693,30 @@ ppCallBr ty f args to indirectDests =
  PtrTo (FunTy r _ _) -> r
  _ -> PrimType Void
 
+-- | Print out the @<ty>|<fnty> <fnptrval>@ portion of a @call@, @callbr@, or
+-- @invoke@ instruction, where:
+--
+-- * @<ty>@ is the return type.
+--
+-- * @<fnty>@ is the overall function type.
+--
+-- * @<fnptrval>@ is a pointer value, where the memory it points to is treated
+-- as a value of type @<fnty>@.
+--
+-- The LLVM Language Reference Manual indicates that either @<ty>@ or @<fnty>@
+-- can be used, but in practice, @<ty>@ is typically preferred unless the
+-- function type involves varargs. We adopt the same convention here.
 ppCallSym :: LLVM => Type -> Value -> Doc
-ppCallSym (PtrTo (FunTy res args va)) val = ppType res <+> ppArgList va (map ppType args) <+> ppValue val
-ppCallSym ty val = ppType ty <+> ppValue val
+ppCallSym ty val = pp_ty <+> ppValue val
+ where
+ pp_ty =
+ case ty of
+ FunTy res args va
+ | va
+ -> ppType res <+> ppArgList va (map ppType args)
+ | otherwise
+ -> ppType res
+ _ -> ppType ty
 
 ppGEP :: LLVM => Bool -> Typed Value -> [Typed Value] -> Doc
 ppGEP ib ptr ixs = "getelementptr" <+> inbounds
@@ -714,7 +736,7 @@ ppGEP ib ptr ixs = "getelementptr" <+> inbounds
 ppInvoke :: LLVM => Type -> Value -> [Typed Value] -> BlockLabel -> BlockLabel -> Doc
 ppInvoke ty f args to uw = body
  where
- body = "invoke" <+> ppType ty <+> ppValue f
+ body = "invoke" <+> ppCallSym ty f
  <> parens (commas (map (ppTyped ppValue) args))
  <+> "to" <+> ppType (PrimType Label) <+> ppLabel to
  <+> "unwind" <+> ppType (PrimType Label) <+> ppLabel uw

src/Text/LLVM/Parser.hs

@@ -73,6 +73,7 @@ pType = pType0 >>= pFunPtr
  , angles (braces (PackedStruct <$> pTypeList) <|> spaced (pNumType Vector))
  , string "opaque" >> return Opaque
  , PrimType <$> pPrimType
+ , string "ptr" >> return PtrOpaque
  ]
 
  pTypeList :: Parser [Type]