module DDC.Llvm.Syntax.Exp
(
Exp (..)
, typeOfExp
, isXVar, isXLit, isXUndef
, isClosedConstantExp
, Var (..)
, nameOfVar
, typeOfVar
, Name (..)
, Lit (..)
, typeOfLit
, makeLitString)
where
import DDC.Llvm.Syntax.Type
import DDC.Llvm.Syntax.Prim
import DDC.Llvm.Pretty.Prim ()
import Data.Text (Text)
import Data.Char
import Numeric
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString as BS
data Exp
= XVar Var
| XLit Lit
| XUndef Type
| XConv Type Conv Exp
| XGet Type Exp [Exp]
deriving (Eq, Show)
typeOfExp :: Exp -> Type
typeOfExp xx
= case xx of
XVar var -> typeOfVar var
XLit lit -> typeOfLit lit
XUndef t -> t
XConv t _ _ -> t
XGet t _ _ -> t
isXVar :: Exp -> Bool
isXVar xx
= case xx of
XVar{} -> True
_ -> False
isXLit :: Exp -> Bool
isXLit xx
= case xx of
XLit{} -> True
_ -> False
isXUndef :: Exp -> Bool
isXUndef xx
= case xx of
XUndef{} -> True
_ -> False
isClosedConstantExp :: Exp -> Bool
isClosedConstantExp xx
= case xx of
XVar{} -> False
XLit{} -> True
XUndef{} -> True
XConv _ _ x -> isClosedConstantExp x
XGet _ x1 xs -> isClosedConstantExp x1 && all isClosedConstantExp xs
data Var
= Var Name Type
deriving (Eq, Show)
nameOfVar :: Var -> Name
nameOfVar (Var n _) = n
typeOfVar :: Var -> Type
typeOfVar (Var _ t) = t
instance Ord Var where
compare (Var n1 _) (Var n2 _)
= compare n1 n2
data Name
= NameGlobal String
| NameLocal String
deriving (Show, Eq, Ord)
data Lit
= LitInt Type Integer
| LitFloat Type Double
| LitString
{ litSource :: Text
, litHexEncoded :: Text
, litEncodingLength :: Int }
| LitNull Type
| LitUndef Type
deriving (Eq, Show)
typeOfLit :: Lit -> Type
typeOfLit ll
= case ll of
LitInt t _ -> t
LitFloat t _ -> t
LitNull t -> t
LitUndef t -> t
LitString _ _ encLen
-> TArray (fromIntegral encLen) (TInt 8)
makeLitString :: Text -> Lit
makeLitString tx
= let (txEnc, nEncLen) = encodeText (tx `T.append` (T.pack [chr 0]))
in LitString tx txEnc nEncLen
encodeText :: Text -> (Text, Int)
encodeText tx
= go [] 0 tx
where
go accStr accLen xx
= case T.uncons xx of
Nothing
-> (T.concat $ reverse accStr, accLen)
Just (x, xs)
-> let (str, len) = encodeChar x
in go (str : accStr) (accLen + len) xs
encodeChar c
| c == ' '
|| (isAscii c && isAlphaNum c)
|| (isAscii c && isPunctuation c && c /= '"')
= (T.pack [c], 1)
| otherwise
= let bs = TE.encodeUtf8 $ T.pack [c]
len = BS.length bs
in ( T.pack $ concatMap (\b -> "\\" ++ (padL $ showHex b ""))
$ BS.unpack bs
, len)
padL x
| length x == 0 = "00"
| length x == 1 = "0" ++ x
| otherwise = x