------------------------------------------------------------------------
-- |
-- Module           : Lang.Crucible.LLVM.QQ
-- Description      : QuasiQuoters for a subset of LLVM assembly syntax
-- Copyright        : (c) Galois, Inc 2019
-- License          : BSD3
-- Maintainer       : Rob Dockins <rdockins@galois.com>
-- Stability        : provisional
------------------------------------------------------------------------

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Lang.Crucible.LLVM.QQ
 ( llvmType
 , llvmDecl
 , llvmOvr
 ) where

import Control.Monad (void)
import qualified Data.Attoparsec.Text as AT
import Data.Char
import Data.Data
import Data.Int
import qualified Data.Text as T
import qualified Text.LLVM.AST as L

import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Quote

import qualified Data.Parameterized.Context as Ctx
import           Lang.Crucible.Types
import qualified Lang.Crucible.LLVM.Intrinsics.Common as IC
import           Lang.Crucible.LLVM.Types

-- | This type closely mirrors the type syntax from llvm-pretty,
--   but adds several additional constructors to represent
--   quasiquoter metavariables.
data QQType
  = QQVar String     -- ^ This constructor represents a type metavariable, e.g. @$var@
  | QQIntVar String  -- ^ This constructor represents a integer type metavariable, e.g. @#var@
  | QQVectorVar String QQType -- ^ This constructor represents a vector type with a metavariable for its size, e.g. @<#var x ty>@
  | QQSizeT          -- ^ This constructor represents an integer type that is the same width as a pointer
  | QQSSizeT          -- ^ This constructor represents a signed integer type that is the same width as a pointer
  | QQPrim L.PrimType
  | QQPtrTo QQType
  | QQPtrOpaque
  | QQAlias L.Ident
  | QQArray Int32 QQType
  | QQFunTy QQType [QQType] Bool
  | QQStruct [QQType]
  | QQPackedStruct [QQType]
  | QQVector Int32 QQType
  | QQOpaque
 deriving (Int -> QQType -> ShowS
[QQType] -> ShowS
QQType -> [Char]
(Int -> QQType -> ShowS)
-> (QQType -> [Char]) -> ([QQType] -> ShowS) -> Show QQType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QQType -> ShowS
showsPrec :: Int -> QQType -> ShowS
$cshow :: QQType -> [Char]
show :: QQType -> [Char]
$cshowList :: [QQType] -> ShowS
showList :: [QQType] -> ShowS
Show, QQType -> QQType -> Bool
(QQType -> QQType -> Bool)
-> (QQType -> QQType -> Bool) -> Eq QQType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QQType -> QQType -> Bool
== :: QQType -> QQType -> Bool
$c/= :: QQType -> QQType -> Bool
/= :: QQType -> QQType -> Bool
Eq, Eq QQType
Eq QQType =>
(QQType -> QQType -> Ordering)
-> (QQType -> QQType -> Bool)
-> (QQType -> QQType -> Bool)
-> (QQType -> QQType -> Bool)
-> (QQType -> QQType -> Bool)
-> (QQType -> QQType -> QQType)
-> (QQType -> QQType -> QQType)
-> Ord QQType
QQType -> QQType -> Bool
QQType -> QQType -> Ordering
QQType -> QQType -> QQType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: QQType -> QQType -> Ordering
compare :: QQType -> QQType -> Ordering
$c< :: QQType -> QQType -> Bool
< :: QQType -> QQType -> Bool
$c<= :: QQType -> QQType -> Bool
<= :: QQType -> QQType -> Bool
$c> :: QQType -> QQType -> Bool
> :: QQType -> QQType -> Bool
$c>= :: QQType -> QQType -> Bool
>= :: QQType -> QQType -> Bool
$cmax :: QQType -> QQType -> QQType
max :: QQType -> QQType -> QQType
$cmin :: QQType -> QQType -> QQType
min :: QQType -> QQType -> QQType
Ord, Typeable QQType
Typeable QQType =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> QQType -> c QQType)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c QQType)
-> (QQType -> Constr)
-> (QQType -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c QQType))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QQType))
-> ((forall b. Data b => b -> b) -> QQType -> QQType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> QQType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> QQType -> r)
-> (forall u. (forall d. Data d => d -> u) -> QQType -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> QQType -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> QQType -> m QQType)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> QQType -> m QQType)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> QQType -> m QQType)
-> Data QQType
QQType -> Constr
QQType -> DataType
(forall b. Data b => b -> b) -> QQType -> QQType
forall a.
Typeable a =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> QQType -> u
forall u. (forall d. Data d => d -> u) -> QQType -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> QQType -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> QQType -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> QQType -> m QQType
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQType -> m QQType
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QQType
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QQType -> c QQType
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QQType)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QQType)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QQType -> c QQType
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QQType -> c QQType
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QQType
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QQType
$ctoConstr :: QQType -> Constr
toConstr :: QQType -> Constr
$cdataTypeOf :: QQType -> DataType
dataTypeOf :: QQType -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QQType)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QQType)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QQType)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QQType)
$cgmapT :: (forall b. Data b => b -> b) -> QQType -> QQType
gmapT :: (forall b. Data b => b -> b) -> QQType -> QQType
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> QQType -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> QQType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> QQType -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> QQType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> QQType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> QQType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QQType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QQType -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> QQType -> m QQType
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> QQType -> m QQType
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQType -> m QQType
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQType -> m QQType
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQType -> m QQType
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQType -> m QQType
Data)

-- | This type closely mirrors the function declaration syntax from llvm-pretty,
--   except that the types and the name of the declaration may be metavarables.
data QQDeclare =
  QQDeclare
  { QQDeclare -> QQType
qqDecRet     :: QQType
  , QQDeclare -> Either [Char] Symbol
qqDecName    :: Either String L.Symbol -- ^ a @Left@ value is a metavariable; @Right@ is a symbol
  , QQDeclare -> [QQType]
qqDecArgs    :: [QQType]
  , QQDeclare -> Bool
qqDecVarArgs :: Bool
  }
 deriving (Int -> QQDeclare -> ShowS
[QQDeclare] -> ShowS
QQDeclare -> [Char]
(Int -> QQDeclare -> ShowS)
-> (QQDeclare -> [Char])
-> ([QQDeclare] -> ShowS)
-> Show QQDeclare
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QQDeclare -> ShowS
showsPrec :: Int -> QQDeclare -> ShowS
$cshow :: QQDeclare -> [Char]
show :: QQDeclare -> [Char]
$cshowList :: [QQDeclare] -> ShowS
showList :: [QQDeclare] -> ShowS
Show, QQDeclare -> QQDeclare -> Bool
(QQDeclare -> QQDeclare -> Bool)
-> (QQDeclare -> QQDeclare -> Bool) -> Eq QQDeclare
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QQDeclare -> QQDeclare -> Bool
== :: QQDeclare -> QQDeclare -> Bool
$c/= :: QQDeclare -> QQDeclare -> Bool
/= :: QQDeclare -> QQDeclare -> Bool
Eq, Eq QQDeclare
Eq QQDeclare =>
(QQDeclare -> QQDeclare -> Ordering)
-> (QQDeclare -> QQDeclare -> Bool)
-> (QQDeclare -> QQDeclare -> Bool)
-> (QQDeclare -> QQDeclare -> Bool)
-> (QQDeclare -> QQDeclare -> Bool)
-> (QQDeclare -> QQDeclare -> QQDeclare)
-> (QQDeclare -> QQDeclare -> QQDeclare)
-> Ord QQDeclare
QQDeclare -> QQDeclare -> Bool
QQDeclare -> QQDeclare -> Ordering
QQDeclare -> QQDeclare -> QQDeclare
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: QQDeclare -> QQDeclare -> Ordering
compare :: QQDeclare -> QQDeclare -> Ordering
$c< :: QQDeclare -> QQDeclare -> Bool
< :: QQDeclare -> QQDeclare -> Bool
$c<= :: QQDeclare -> QQDeclare -> Bool
<= :: QQDeclare -> QQDeclare -> Bool
$c> :: QQDeclare -> QQDeclare -> Bool
> :: QQDeclare -> QQDeclare -> Bool
$c>= :: QQDeclare -> QQDeclare -> Bool
>= :: QQDeclare -> QQDeclare -> Bool
$cmax :: QQDeclare -> QQDeclare -> QQDeclare
max :: QQDeclare -> QQDeclare -> QQDeclare
$cmin :: QQDeclare -> QQDeclare -> QQDeclare
min :: QQDeclare -> QQDeclare -> QQDeclare
Ord, Typeable QQDeclare
Typeable QQDeclare =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> QQDeclare -> c QQDeclare)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c QQDeclare)
-> (QQDeclare -> Constr)
-> (QQDeclare -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c QQDeclare))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QQDeclare))
-> ((forall b. Data b => b -> b) -> QQDeclare -> QQDeclare)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> QQDeclare -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> QQDeclare -> r)
-> (forall u. (forall d. Data d => d -> u) -> QQDeclare -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> QQDeclare -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare)
-> Data QQDeclare
QQDeclare -> Constr
QQDeclare -> DataType
(forall b. Data b => b -> b) -> QQDeclare -> QQDeclare
forall a.
Typeable a =>
(forall (c :: Type -> Type).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: Type -> Type).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: Type -> Type -> Type) (c :: Type -> Type).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: Type -> Type).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: Type -> Type).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> QQDeclare -> u
forall u. (forall d. Data d => d -> u) -> QQDeclare -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QQDeclare -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QQDeclare -> r
forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare
forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare
forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QQDeclare
forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QQDeclare -> c QQDeclare
forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QQDeclare)
forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QQDeclare)
$cgfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QQDeclare -> c QQDeclare
gfoldl :: forall (c :: Type -> Type).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> QQDeclare -> c QQDeclare
$cgunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QQDeclare
gunfold :: forall (c :: Type -> Type).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c QQDeclare
$ctoConstr :: QQDeclare -> Constr
toConstr :: QQDeclare -> Constr
$cdataTypeOf :: QQDeclare -> DataType
dataTypeOf :: QQDeclare -> DataType
$cdataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QQDeclare)
dataCast1 :: forall (t :: Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c QQDeclare)
$cdataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QQDeclare)
dataCast2 :: forall (t :: Type -> Type -> Type) (c :: Type -> Type).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c QQDeclare)
$cgmapT :: (forall b. Data b => b -> b) -> QQDeclare -> QQDeclare
gmapT :: (forall b. Data b => b -> b) -> QQDeclare -> QQDeclare
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QQDeclare -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> QQDeclare -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QQDeclare -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> QQDeclare -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> QQDeclare -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> QQDeclare -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QQDeclare -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> QQDeclare -> u
$cgmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare
gmapM :: forall (m :: Type -> Type).
Monad m =>
(forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare
$cgmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare
gmapMp :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare
$cgmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare
gmapMo :: forall (m :: Type -> Type).
MonadPlus m =>
(forall d. Data d => d -> m d) -> QQDeclare -> m QQDeclare
Data)

parseIdent :: AT.Parser L.Ident
parseIdent :: Parser Ident
parseIdent = [Char] -> Ident
L.Ident ([Char] -> Ident) -> Parser Text [Char] -> Parser Ident
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
AT.char Char
'%' Parser Char -> Parser Text [Char] -> Parser Text [Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> [Parser Text [Char]] -> Parser Text [Char]
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
AT.choice
  [ Text -> [Char]
T.unpack (Text -> [Char]) -> Parser Text Text -> Parser Text [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
AT.takeWhile1 Char -> Bool
isDigit
  , (:) (Char -> ShowS) -> Parser Char -> Parser Text ShowS
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Char
AT.satisfy ([Char] -> Char -> Bool
AT.inClass [Char]
"-a-zA-Z$._")
        Parser Text ShowS -> Parser Text [Char] -> Parser Text [Char]
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Text -> [Char]
T.unpack (Text -> [Char]) -> Parser Text Text -> Parser Text [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> Parser Text Text
AT.takeWhile ([Char] -> Char -> Bool
AT.inClass [Char]
"-a-zA-Z$._0-9")))
  ])


parseSymbol :: AT.Parser L.Symbol
parseSymbol :: Parser Symbol
parseSymbol = [Char] -> Symbol
L.Symbol ([Char] -> Symbol) -> Parser Text [Char] -> Parser Symbol
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
AT.char Char
'@' Parser Char -> Parser Text [Char] -> Parser Text [Char]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*>
  ( (:) (Char -> ShowS) -> Parser Char -> Parser Text ShowS
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Char
AT.satisfy ([Char] -> Char -> Bool
AT.inClass [Char]
"-a-zA-Z$._")
        Parser Text ShowS -> Parser Text [Char] -> Parser Text [Char]
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (Text -> [Char]
T.unpack (Text -> [Char]) -> Parser Text Text -> Parser Text [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> Parser Text Text
AT.takeWhile ([Char] -> Char -> Bool
AT.inClass [Char]
"-a-zA-Z$._0-9")))
  ))

parseFloatType :: AT.Parser L.FloatType
parseFloatType :: Parser FloatType
parseFloatType = [Parser FloatType] -> Parser FloatType
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
AT.choice
  [ FloatType -> Parser FloatType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure FloatType
L.Half      Parser FloatType -> Parser Text Text -> Parser FloatType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"half"
  , FloatType -> Parser FloatType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure FloatType
L.Float     Parser FloatType -> Parser Text Text -> Parser FloatType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"float"
  , FloatType -> Parser FloatType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure FloatType
L.Double    Parser FloatType -> Parser Text Text -> Parser FloatType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"double"
  , FloatType -> Parser FloatType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure FloatType
L.Fp128     Parser FloatType -> Parser Text Text -> Parser FloatType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"fp128"
  , FloatType -> Parser FloatType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure FloatType
L.X86_fp80  Parser FloatType -> Parser Text Text -> Parser FloatType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"x86_fp80"
  , FloatType -> Parser FloatType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure FloatType
L.PPC_fp128 Parser FloatType -> Parser Text Text -> Parser FloatType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"ppc_fp128"
  ]

parsePrimType :: AT.Parser L.PrimType
parsePrimType :: Parser PrimType
parsePrimType = [Parser PrimType] -> Parser PrimType
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
AT.choice
  [ PrimType -> Parser PrimType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure PrimType
L.Label    Parser PrimType -> Parser Text Text -> Parser PrimType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"label"
  , PrimType -> Parser PrimType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure PrimType
L.Void     Parser PrimType -> Parser Text Text -> Parser PrimType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"void"
  , PrimType -> Parser PrimType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure PrimType
L.Metadata Parser PrimType -> Parser Text Text -> Parser PrimType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"metadata"
  , PrimType -> Parser PrimType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure PrimType
L.X86mmx   Parser PrimType -> Parser Text Text -> Parser PrimType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"x86_mmx"
  , Word32 -> PrimType
L.Integer (Word32 -> PrimType) -> Parser Text Word32 -> Parser PrimType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
AT.char Char
'i' Parser Char -> Parser Text Word32 -> Parser Text Word32
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Parser Text Word32
forall a. Integral a => Parser a
AT.decimal)
  , FloatType -> PrimType
L.FloatType (FloatType -> PrimType) -> Parser FloatType -> Parser PrimType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FloatType
parseFloatType
  ]

parseSeqType ::
  Char ->
  Char ->
  AT.Parser seqSz ->
  (seqSz -> QQType -> QQType) ->
  AT.Parser QQType
parseSeqType :: forall seqSz.
Char
-> Char
-> Parser seqSz
-> (seqSz -> QQType -> QQType)
-> Parser QQType
parseSeqType Char
start Char
end Parser seqSz
parseSz seqSz -> QQType -> QQType
cnstr =
  do Parser Char -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
start
     Parser Text ()
AT.skipSpace
     seqSz
n <- Parser seqSz
parseSz
     Parser Text ()
AT.skipSpace
     Parser Char -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
'x'
     Parser Text ()
AT.skipSpace
     QQType
tp <- Parser QQType
parseType
     Parser Text ()
AT.skipSpace
     Parser Char -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
end
     QQType -> Parser QQType
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (QQType -> Parser QQType) -> QQType -> Parser QQType
forall a b. (a -> b) -> a -> b
$! seqSz -> QQType -> QQType
cnstr seqSz
n QQType
tp

parseVectorType :: AT.Parser QQType
parseVectorType :: Parser QQType
parseVectorType = Char
-> Char
-> Parser Int32
-> (Int32 -> QQType -> QQType)
-> Parser QQType
forall seqSz.
Char
-> Char
-> Parser seqSz
-> (seqSz -> QQType -> QQType)
-> Parser QQType
parseSeqType Char
'<' Char
'>' Parser Int32
forall a. Integral a => Parser a
AT.decimal Int32 -> QQType -> QQType
QQVector

parseVectorVar :: AT.Parser QQType
parseVectorVar :: Parser QQType
parseVectorVar = Char
-> Char
-> Parser Text [Char]
-> ([Char] -> QQType -> QQType)
-> Parser QQType
forall seqSz.
Char
-> Char
-> Parser seqSz
-> (seqSz -> QQType -> QQType)
-> Parser QQType
parseSeqType Char
'<' Char
'>' Parser Text [Char]
parseIntVar [Char] -> QQType -> QQType
QQVectorVar

parseArrayType :: AT.Parser QQType
parseArrayType :: Parser QQType
parseArrayType = Char
-> Char
-> Parser Int32
-> (Int32 -> QQType -> QQType)
-> Parser QQType
forall seqSz.
Char
-> Char
-> Parser seqSz
-> (seqSz -> QQType -> QQType)
-> Parser QQType
parseSeqType Char
'[' Char
']' Parser Int32
forall a. Integral a => Parser a
AT.decimal Int32 -> QQType -> QQType
QQArray

parseCommaSeparatedTypes :: AT.Parser [QQType]
parseCommaSeparatedTypes :: Parser [QQType]
parseCommaSeparatedTypes = [Parser [QQType]] -> Parser [QQType]
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
AT.choice
  [ do Parser Text ()
AT.skipSpace
       QQType
f  <- Parser QQType
parseType
       [QQType]
fs <- Parser QQType -> Parser [QQType]
forall (m :: Type -> Type) a. MonadPlus m => m a -> m [a]
AT.many' (Parser Text ()
AT.skipSpace Parser Text () -> Parser Char -> Parser Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
AT.char Char
',' Parser Char -> Parser Text () -> Parser Text ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
AT.skipSpace Parser Text () -> Parser QQType -> Parser QQType
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Parser QQType
parseType)
       [QQType] -> Parser [QQType]
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (QQType
fQQType -> [QQType] -> [QQType]
forall a. a -> [a] -> [a]
:[QQType]
fs)
  , [QQType] -> Parser [QQType]
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
  ]

parseStructType :: AT.Parser QQType
parseStructType :: Parser QQType
parseStructType =
  do Parser Char -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
'{'
     [QQType]
fs <- Parser [QQType]
parseCommaSeparatedTypes
     Parser Text ()
AT.skipSpace
     Parser Char -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
'}'
     QQType -> Parser QQType
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (QQType -> Parser QQType) -> QQType -> Parser QQType
forall a b. (a -> b) -> a -> b
$ [QQType] -> QQType
QQStruct [QQType]
fs

parsePackedStructType :: AT.Parser QQType
parsePackedStructType :: Parser QQType
parsePackedStructType =
  do Parser Text Text -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser Text ())
-> Parser Text Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
AT.string Text
"<{"
     [QQType]
fs <- Parser [QQType]
parseCommaSeparatedTypes
     Parser Text ()
AT.skipSpace
     Parser Text Text -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser Text ())
-> Parser Text Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
AT.string Text
"}>"
     QQType -> Parser QQType
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (QQType -> Parser QQType) -> QQType -> Parser QQType
forall a b. (a -> b) -> a -> b
$ [QQType] -> QQType
QQPackedStruct [QQType]
fs

parseArgList :: AT.Parser ([QQType], Bool)
parseArgList :: Parser ([QQType], Bool)
parseArgList =
  do Parser Char -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
'('
     [QQType]
tps <- Parser [QQType]
parseCommaSeparatedTypes
     Parser Text ()
AT.skipSpace
     Bool
varargs <- [Parser Text Bool] -> Parser Text Bool
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
AT.choice
                [ do Parser Char -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
','
                     Parser Text ()
AT.skipSpace
                     Parser Text Text -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Text Text -> Parser Text ())
-> Parser Text Text -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
AT.string Text
"..."
                     Parser Text ()
AT.skipSpace
                     Parser Char -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
')'
                     Bool -> Parser Text Bool
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
True
                , do Parser Char -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
')'
                     Bool -> Parser Text Bool
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Bool
False
                ]
     ([QQType], Bool) -> Parser ([QQType], Bool)
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([QQType]
tps, Bool
varargs)

parseVar :: AT.Parser String
parseVar :: Parser Text [Char]
parseVar = Text -> [Char]
T.unpack (Text -> [Char]) -> Parser Text Text -> Parser Text [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
AT.char Char
'$' Parser Char -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
AT.takeWhile1 Char -> Bool
varChar)
 where
 varChar :: Char -> Bool
varChar Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

parseIntVar :: AT.Parser String
parseIntVar :: Parser Text [Char]
parseIntVar = Text -> [Char]
T.unpack (Text -> [Char]) -> Parser Text Text -> Parser Text [Char]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
AT.char Char
'#' Parser Char -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
AT.takeWhile1 Char -> Bool
varChar)
 where
 varChar :: Char -> Bool
varChar Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

parseType :: AT.Parser QQType
parseType :: Parser QQType
parseType =
  do QQType
base <- [Parser QQType] -> Parser QQType
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
AT.choice
             [ Parser QQType
parseVectorType
             , Parser QQType
parseVectorVar
             , Parser QQType
parseArrayType
             , Parser QQType
parseStructType
             , Parser QQType
parsePackedStructType
             , [Char] -> QQType
QQVar ([Char] -> QQType) -> Parser Text [Char] -> Parser QQType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Char]
parseVar
             , [Char] -> QQType
QQIntVar ([Char] -> QQType) -> Parser Text [Char] -> Parser QQType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [Char]
parseIntVar
             , Ident -> QQType
QQAlias (Ident -> QQType) -> Parser Ident -> Parser QQType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Ident
parseIdent
             , PrimType -> QQType
QQPrim (PrimType -> QQType) -> Parser PrimType -> Parser QQType
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PrimType
parsePrimType
             , QQType -> Parser QQType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure QQType
QQOpaque Parser QQType -> Parser Text Text -> Parser QQType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"opaque"
             , QQType -> Parser QQType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure QQType
QQSizeT  Parser QQType -> Parser Text Text -> Parser QQType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"size_t"
             , QQType -> Parser QQType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure QQType
QQSSizeT  Parser QQType -> Parser Text Text -> Parser QQType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"ssize_t"
             , QQType -> Parser QQType
forall a. a -> Parser Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure QQType
QQPtrOpaque Parser QQType -> Parser Text Text -> Parser QQType
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
AT.string Text
"ptr"
             ]
     QQType
base' <- [Parser QQType] -> Parser QQType
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
AT.choice
              [ do Parser Text ()
AT.skipSpace
                   ([QQType]
args,Bool
varargs) <- Parser ([QQType], Bool)
parseArgList
                   QQType -> Parser QQType
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (QQType -> [QQType] -> Bool -> QQType
QQFunTy QQType
base [QQType]
args Bool
varargs)
              , QQType -> Parser QQType
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return QQType
base
              ]
     QQType -> Parser QQType
parseStars QQType
base'

  where
  parseStars :: QQType -> Parser QQType
parseStars QQType
x =
    [Parser QQType] -> Parser QQType
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
AT.choice
    [ do Parser Text ()
AT.skipSpace
         Parser Char -> Parser Text ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (Parser Char -> Parser Text ()) -> Parser Char -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
AT.char Char
'*'
         QQType -> Parser QQType
parseStars (QQType -> QQType
QQPtrTo QQType
x)
    , QQType -> Parser QQType
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return QQType
x
    ]

parseDeclare :: AT.Parser QQDeclare
parseDeclare :: Parser QQDeclare
parseDeclare =
  do Parser Text ()
AT.skipSpace
     QQType
ret <- Parser QQType
parseType
     Parser Text ()
AT.skipSpace
     Either [Char] Symbol
sym <- Parser Text [Char]
-> Parser Symbol -> Parser Text (Either [Char] Symbol)
forall (f :: Type -> Type) a b.
Alternative f =>
f a -> f b -> f (Either a b)
AT.eitherP Parser Text [Char]
parseVar Parser Symbol
parseSymbol
     Parser Text ()
AT.skipSpace
     ([QQType]
args, Bool
varargs) <- Parser ([QQType], Bool)
parseArgList
     Parser Text ()
AT.skipSpace
     QQDeclare -> Parser QQDeclare
forall a. a -> Parser Text a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
       QQDeclare
       { qqDecRet :: QQType
qqDecRet     = QQType
ret
       , qqDecName :: Either [Char] Symbol
qqDecName    = Either [Char] Symbol
sym
       , qqDecArgs :: [QQType]
qqDecArgs    = [QQType]
args
       , qqDecVarArgs :: Bool
qqDecVarArgs = Bool
varargs
       }


liftQQType :: QQType -> Q Exp
liftQQType :: QQType -> Q Exp
liftQQType QQType
tp =
  case QQType
tp of
    QQVar [Char]
nm     -> Name -> Q Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE ([Char] -> Name
mkName [Char]
nm)
    QQIntVar [Char]
nm  -> [| L.PrimType (L.Integer (fromInteger (intValue $(Name -> Q Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE ([Char] -> Name
mkName [Char]
nm)) ))) |]
    QQVectorVar [Char]
nm QQType
t -> [| L.Vector (fromInteger (intValue $(Name -> Q Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE ([Char] -> Name
mkName [Char]
nm)))) $(QQType -> Q Exp
liftQQType QQType
t) |]
    QQType
QQSizeT      -> Name -> Q Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE 'IC.llvmSizeT
    QQType
QQSSizeT      -> Name -> Q Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE 'IC.llvmSSizeT
    QQAlias Ident
nm   -> [| L.Alias nm |]
    QQPrim PrimType
pt    -> [| L.PrimType pt |]
    QQPtrTo QQType
t    -> [| L.PtrTo $(QQType -> Q Exp
liftQQType QQType
t) |]
    QQType
QQPtrOpaque  -> [| L.PtrOpaque |]
    QQArray Int32
n QQType
t  -> [| L.Array n $(QQType -> Q Exp
liftQQType QQType
t) |]
    QQVector Int32
n QQType
t -> [| L.Vector n $(QQType -> Q Exp
liftQQType QQType
t) |]
    QQStruct [QQType]
ts  -> [| L.Struct $([Q Exp] -> Q Exp
forall (m :: Type -> Type). Quote m => [m Exp] -> m Exp
listE ((QQType -> Q Exp) -> [QQType] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map QQType -> Q Exp
liftQQType [QQType]
ts)) |]
    QQPackedStruct [QQType]
ts -> [| L.PackedStruct $([Q Exp] -> Q Exp
forall (m :: Type -> Type). Quote m => [m Exp] -> m Exp
listE ((QQType -> Q Exp) -> [QQType] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map QQType -> Q Exp
liftQQType [QQType]
ts)) |]
    QQType
QQOpaque -> [| L.Opaque |]
    QQFunTy QQType
ret [QQType]
args Bool
varargs -> [| L.FunTy $(QQType -> Q Exp
liftQQType QQType
ret) $([Q Exp] -> Q Exp
forall (m :: Type -> Type). Quote m => [m Exp] -> m Exp
listE ((QQType -> Q Exp) -> [QQType] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map QQType -> Q Exp
liftQQType [QQType]
args)) $(Bool -> Q Exp
forall t (m :: Type -> Type). (Lift t, Quote m) => t -> m Exp
forall (m :: Type -> Type). Quote m => Bool -> m Exp
lift Bool
varargs) |]

liftQQDecl :: QQDeclare -> Q Exp
liftQQDecl :: QQDeclare -> Q Exp
liftQQDecl (QQDeclare QQType
ret Either [Char] Symbol
nm [QQType]
args Bool
varargs) =
   [| L.Declare
      { L.decLinkage    = Nothing
      , L.decVisibility = Nothing
      , L.decRetType    = $(QQType -> Q Exp
liftQQType QQType
ret)
      , L.decName       = $(Either [Char] Symbol -> Q Exp
forall {m :: Type -> Type} {t}.
(Quote m, Lift t) =>
Either [Char] t -> m Exp
f Either [Char] Symbol
nm)
      , L.decArgs       = $([Q Exp] -> Q Exp
forall (m :: Type -> Type). Quote m => [m Exp] -> m Exp
listE ((QQType -> Q Exp) -> [QQType] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
map QQType -> Q Exp
liftQQType [QQType]
args))
      , L.decVarArgs    = $(Bool -> Q Exp
forall t (m :: Type -> Type). (Lift t, Quote m) => t -> m Exp
forall (m :: Type -> Type). Quote m => Bool -> m Exp
lift Bool
varargs)
      , L.decAttrs      = []
      , L.decComdat     = Nothing
      }
    |]
  where
  f :: Either [Char] t -> m Exp
f (Left [Char]
v)    = Name -> m Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE ([Char] -> Name
mkName [Char]
v)
  f (Right t
sym) = t -> m Exp
forall t (m :: Type -> Type). (Lift t, Quote m) => t -> m Exp
forall (m :: Type -> Type). Quote m => t -> m Exp
lift t
sym

liftKnownNat :: Integral a => a -> Q Exp
liftKnownNat :: forall a. Integral a => a -> Q Exp
liftKnownNat a
n = [| knownNat @($(Q TyLit -> Q Type
forall (m :: Type -> Type). Quote m => m TyLit -> m Type
litT (Integer -> Q TyLit
forall (m :: Type -> Type). Quote m => Integer -> m TyLit
numTyLit (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
n)))) |]

liftTypeRepr :: QQType -> Q Exp
liftTypeRepr :: QQType -> Q Exp
liftTypeRepr QQType
t = case QQType
t of
    QQVar [Char]
nm      -> Name -> Q Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE ([Char] -> Name
mkName ([Char]
nm[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
"_repr"))
    QQIntVar [Char]
nm   -> [| BVRepr $(Name -> Q Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE ([Char] -> Name
mkName [Char]
nm)) |]
    QQVectorVar [Char]
_ QQType
t' -> [| VectorRepr $(QQType -> Q Exp
liftTypeRepr QQType
t') |]
    QQType
QQSizeT       -> [| SizeT |]
    QQType
QQSSizeT      -> [| SSizeT |]
    QQPrim PrimType
pt     -> PrimType -> Q Exp
liftPrim PrimType
pt
    QQPtrTo QQType
_t    -> [| PtrRepr |]
    QQType
QQPtrOpaque   -> [| PtrRepr |]
    QQArray Int32
_ QQType
t'  -> [| VectorRepr $(QQType -> Q Exp
liftTypeRepr QQType
t') |]
    QQVector Int32
_ QQType
t' -> [| VectorRepr $(QQType -> Q Exp
liftTypeRepr QQType
t') |]
    QQStruct [QQType]
ts   -> [| StructRepr $([QQType] -> Bool -> Q Exp
liftArgs [QQType]
ts Bool
False) |]
    QQPackedStruct [QQType]
ts -> [| StructRepr $([QQType] -> Bool -> Q Exp
liftArgs [QQType]
ts Bool
False) |]
    QQAlias{} -> [Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot lift alias type to repr"
    QQType
QQOpaque  -> [Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot lift opaque type to repr"
    QQFunTy{} -> [Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot lift function type to repr"
 where
  liftPrim :: PrimType -> Q Exp
liftPrim PrimType
pt = case PrimType
pt of
    PrimType
L.Void         -> [| UnitRepr |]
    L.Integer Word32
n    -> [| BVRepr $(Word32 -> Q Exp
forall a. Integral a => a -> Q Exp
liftKnownNat Word32
n) |]
    L.FloatType FloatType
ft -> [| FloatRepr $(FloatType -> Q Exp
forall {m :: Type -> Type}. Quote m => FloatType -> m Exp
liftFloatType FloatType
ft) |]
    PrimType
L.Label    -> [Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot lift label type to repr"
    PrimType
L.X86mmx   -> [Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot lift X86mmx type to repr"
    PrimType
L.Metadata -> [Char] -> Q Exp
forall a. [Char] -> Q a
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot lift metatata type to repr"

  liftFloatType :: FloatType -> m Exp
liftFloatType FloatType
ft = case FloatType
ft of
    FloatType
L.Half      -> [| HalfFloatRepr |]
    FloatType
L.Float     -> [| SingleFloatRepr |]
    FloatType
L.Double    -> [| DoubleFloatRepr |]
    FloatType
L.Fp128     -> [| QuadFloatRepr |]
    FloatType
L.X86_fp80  -> [| X86_80FloatRepr |]
    FloatType
L.PPC_fp128 -> [| DoubleDoubleFloatRepr|]

liftArgs :: [QQType] -> Bool -> Q Exp
liftArgs :: [QQType] -> Bool -> Q Exp
liftArgs = Q Exp -> [QQType] -> Bool -> Q Exp
go [| Ctx.Empty |]
 where
 go :: Q Exp -> [QQType] -> Bool -> Q Exp
 go :: Q Exp -> [QQType] -> Bool -> Q Exp
go Q Exp
xs [] Bool
True  = [| $(Q Exp
xs) Ctx.:> VectorRepr AnyRepr |]
 go Q Exp
xs [] Bool
False = Q Exp
xs
 go Q Exp
xs (QQType
t:[QQType]
ts) Bool
varargs = Q Exp -> [QQType] -> Bool -> Q Exp
go [| $(Q Exp
xs) Ctx.:> $(QQType -> Q Exp
liftTypeRepr QQType
t) |] [QQType]
ts Bool
varargs


liftQQDeclToOverride :: QQDeclare -> Q Exp
liftQQDeclToOverride :: QQDeclare -> Q Exp
liftQQDeclToOverride qqd :: QQDeclare
qqd@(QQDeclare QQType
ret Either [Char] Symbol
_nm [QQType]
args Bool
varargs) =
  [| IC.LLVMOverride $(QQDeclare -> Q Exp
liftQQDecl QQDeclare
qqd) $([QQType] -> Bool -> Q Exp
liftArgs [QQType]
args Bool
varargs) $(QQType -> Q Exp
liftTypeRepr QQType
ret) |]

-- | This quasiquoter parses values in LLVM type syntax, extended
--   with metavariables, and builds values of @Text.LLVM.AST.Type@.
--
--   Type metavariables start with a @$@ and splice in the named
--   program variable, which is expected to have type @Type@.
--
--   Numeric metavariables start with @#@ and splice in an integer
--   type whose width is given by the named program variable, which
--   is expected to be a @NatRepr@.
llvmType :: QuasiQuoter
llvmType :: QuasiQuoter
llvmType =
  QuasiQuoter
  { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
str ->
       do case Parser QQType -> Text -> Either [Char] QQType
forall a. Parser a -> Text -> Either [Char] a
AT.parseOnly Parser QQType
parseType ([Char] -> Text
T.pack [Char]
str) of
            Left [Char]
msg -> [Char] -> Q Exp
forall a. HasCallStack => [Char] -> a
error [Char]
msg
            Right QQType
x  -> QQType -> Q Exp
liftQQType QQType
x

  , quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"llvmType cannot quasiquote a pattern"
  , quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"llvmType cannot quasiquote a Haskell type"
  , quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"llvmType cannot quasiquote a declaration"
  }

-- | This quasiquoter parses values in LLVM function declaration syntax,
--   extended with metavariables, and builds values of @Text.LLVM.AST.Declare@.
--
--   Type metavariables start with a @$@ and splice in the named
--   program variable, which is expected to have type @Type@.
--
--   Numeric metavariables start with @#@ and splice in an integer
--   type whose width is given by the named program variable, which
--   is expected to be a @NatRepr@.
--
--   The name of the declaration may also be a @$@ metavariable, in which
--   case the named variable is expeted to be a @Symbol@.
llvmDecl :: QuasiQuoter
llvmDecl :: QuasiQuoter
llvmDecl =
  QuasiQuoter
  { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
str ->
       do case Parser QQDeclare -> Text -> Either [Char] QQDeclare
forall a. Parser a -> Text -> Either [Char] a
AT.parseOnly Parser QQDeclare
parseDeclare ([Char] -> Text
T.pack [Char]
str) of
            Left [Char]
msg -> [Char] -> Q Exp
forall a. HasCallStack => [Char] -> a
error [Char]
msg
            Right QQDeclare
x  -> QQDeclare -> Q Exp
liftQQDecl QQDeclare
x

  , quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"llvmDecl cannot quasiquote a pattern"
  , quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"llvmDecl cannot quasiquote a Haskell type"
  , quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"llvmDecl cannot quasiquote a declaration"
  }

-- | This quasiquoter parses values in LLVM function declaration syntax,
--   extended with metavariables, and partially applies the
--   @LLVMOverride@ constructor so that it expectes a single remaining
--   argument to populate the @llvmOverride_def@ field.
--
--   Type metavariables start with a @$@ and splice in the named
--   program variable, which is expected to have type @Type@.
--   In addition a related variable must be in scope to give the
--   crucible @TypeRepr@ associated.  For example variable @$x@
--   should be a LLVM @Type@ and @$x_repr@ should be a Crucible @TypeRepr@.
--
--   Numeric metavariables start with @#@ and splice in an integer
--   type whose width is given by the named program variable, which
--   is expected to be a @NatRepr@.  Both the LLVM type and the Crucible
--   @TypeRepr@ are built from the @NatRepr@.
--
--   The name of the declaration may also be a @$@ metavariable, in which
--   case the named variable is expeted to be a @Symbol@.
llvmOvr :: QuasiQuoter
llvmOvr :: QuasiQuoter
llvmOvr =
  QuasiQuoter
  { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
str ->
       do case Parser QQDeclare -> Text -> Either [Char] QQDeclare
forall a. Parser a -> Text -> Either [Char] a
AT.parseOnly Parser QQDeclare
parseDeclare ([Char] -> Text
T.pack [Char]
str) of
            Left [Char]
msg -> [Char] -> Q Exp
forall a. HasCallStack => [Char] -> a
error [Char]
msg
            Right QQDeclare
x  -> QQDeclare -> Q Exp
liftQQDeclToOverride QQDeclare
x

  , quotePat :: [Char] -> Q Pat
quotePat = [Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"llvmOvr cannot quasiquote a pattern"
  , quoteType :: [Char] -> Q Type
quoteType = [Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"llvmOvr cannot quasiquote a Haskell type"
  , quoteDec :: [Char] -> Q [Dec]
quoteDec = [Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"llvmOvr cannot quasiquote a declaration"
  }