Name.hs

{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RoleAnnotations       #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : LLVM.AST.Type.Name
-- Copyright   : [2015..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module LLVM.AST.Type.Name
  where

import Data.ByteString.Short                                        ( ShortByteString )
import qualified Data.ByteString.Short                              as SBS
import qualified Data.ByteString.Short.Char8                        as SBS8
import Data.Data
import Data.Semigroup
import Data.Hashable
import Data.String
import Data.Word
import Prelude

import qualified Data.Array.Accelerate.LLVM.Internal.LLVMPretty     as LLVM


-- | Objects of various sorts in LLVM IR are identified by address in the LLVM
-- C++ API, and may be given a string name. When printed to (resp. read from)
-- human-readable LLVM assembly, objects without string names are numbered
-- sequentially (resp. must be numbered sequentially). String names may be
-- quoted, and are quoted when printed if they would otherwise be misread - e.g.
-- when containing special characters.
--
-- > 7
--
-- means the seventh unnamed object, while
--
-- > "7"
--
-- means the object named with the string "7".
--
-- This libraries handling of 'UnName's during translation of the AST down into
-- C++ IR is somewhat more forgiving than the LLVM assembly parser: it does not
-- require that unnamed values be numbered sequentially; however, the numbers of
-- 'UnName's passed into C++ cannot be preserved in the C++ objects. If the C++
-- IR is printed as assembly or translated into a Haskell AST, unnamed nodes
-- will be renumbered sequentially. Thus unnamed node numbers should be thought
-- of as having any scope limited to the 'LLVM.AST.Module' in which they
-- are used.
--
type role Name representational
data Name a
  = Name   {-# UNPACK #-} !ShortByteString    -- ^ a string name
  | UnName {-# UNPACK #-} !Word               -- ^ a number for a nameless thing
  deriving (Eq, Ord, Read, Show, Typeable, Data)

instance IsString (Name a) where
  fromString = Name . fromString


-- TLM: 'Name' is used a lot over the place, to refer to things like variables
--      as well as basic block labels. In the first case the type makes sense,
--      but what about the latter? Should basic blocks have type '()', or 'IO
--      ()', or the type of the thing that they "return" (although, from memory
--      BBs don't really return anything, they just compute a bunch of stuff
--      which is now in scope. Hmm... the only types that we can truly know are
--      the inputs to the basic block bound via phi nodes, but this is
--      unsatisfactory... )
--

data Label = Label {-# UNPACK #-} !ShortByteString
  deriving (Eq, Ord, Read, Show, Typeable, Data)

instance IsString Label where
  fromString = Label . fromString

instance Semigroup Label where
  Label x <> Label y = Label (x <> y)

instance Monoid Label where
  mempty = Label mempty

instance Hashable Label where
  hashWithSalt salt (Label sbs) = hashWithSalt salt sbs

-- | Some names are not external function references but instead references to
-- definitions that we provide inline in the module to be compiled by LLVM. See
-- 'Data.Array.Accelerate.LLVM.CodeGen.Base.call' for more details. This
-- function checks whether the given label is one of those inline-provided
-- functions.
labelIsAccPrelude :: Label -> Bool
labelIsAccPrelude (Label x) = SBS.take (SBS.length prefix) x == prefix
  where Label prefix = makeAccPreludeLabel SBS.empty

-- | Create a reference to an inline-provided function. See
-- 'labelIsAccPrelude'.
makeAccPreludeLabel :: ShortByteString -> Label
makeAccPreludeLabel s = Label (SBS8.pack "accprelude_" <> s)


-- | Convert to llvm-pretty
--
-- We only explicit conversion functions for symbols and identifiers separately.
--
nameToPrettyS :: Name a -> LLVM.Symbol
nameToPrettyS (Name s) = LLVM.Symbol (SBS8.unpack s)
nameToPrettyS (UnName n) = LLVM.Symbol ("tollpr_s_" ++ show n)

nameToPrettyI :: Name a -> LLVM.Ident
nameToPrettyI (Name s) = LLVM.Ident (SBS8.unpack s)
nameToPrettyI (UnName n) = LLVM.Ident ("tollpr_i_" ++ show n)

labelToPrettyS :: Label -> LLVM.Symbol
labelToPrettyS (Label s) = LLVM.Symbol (SBS8.unpack s)

labelToPrettyI :: Label -> LLVM.Ident
labelToPrettyI (Label s) = LLVM.Ident (SBS8.unpack s)

labelToPrettyBL :: Label -> LLVM.BlockLabel
labelToPrettyBL (Label s) = LLVM.Named (LLVM.Ident (SBS8.unpack s))