Copyright | (c) Christian Gram Kalhauge 2017 |
---|---|
License | MIT |
Maintainer | kalhuage@cs.ucla.edu |
Safe Haskell | None |
Language | Haskell2010 |
Synopsis
- data Attribute r = Attribute {
- aName :: !(Ref Text r)
- aInfo' :: !SizedByteString32
- aInfo :: Attribute r -> ByteString
- toAttribute :: (IsAttribute (a Low), Staged a, DevolveM m) => a High -> m (Attribute Low)
- toBCAttribute :: (IsAttribute (a Low), ByteCodeStaged a, DevolveM m) => (ByteCodeIndex -> m ByteCodeOffset) -> a High -> m (Attribute Low)
- devolveAttribute :: (IsAttribute (a Low), DevolveM m) => (a High -> m (a Low)) -> a High -> m (Attribute Low)
- fromAttribute' :: IsAttribute a => Attribute r -> Either String a
- toAttribute' :: forall a. IsAttribute a => a -> Attribute High
- class Binary a => IsAttribute a where
- type Attributes b r = Choice (SizedList16 (Attribute r)) (b r) r
- fromAttributes :: (Foldable f, EvolveM m, Monoid a) => AttributeLocation -> f (Attribute Low) -> (Attribute High -> m a) -> m a
- collect :: forall c m. EvolveM m => [AttributeCollector c] -> (Attribute High -> c -> c) -> Attribute High -> m (Endo c)
- collectBC :: forall c m. EvolveM m => (ByteCodeOffset -> m ByteCodeIndex) -> [ByteCodeAttributeCollector c] -> (Attribute High -> c -> c) -> Attribute High -> m (Endo c)
- data AttributeCollector c = (IsAttribute (a Low), Staged a) => Attr (a High -> c -> c)
- data ByteCodeAttributeCollector c = (IsAttribute (a Low), ByteCodeStaged a) => BCAttr (a High -> c -> c)
- firstOne :: [a] -> Maybe a
- newtype Const a (b :: k) :: forall k. Type -> k -> Type = Const {
- getConst :: a
Documentation
An Attribute, simply contains of a reference to a name and contains info.
Instances
aInfo :: Attribute r -> ByteString Source #
A small helper function to extract the info as a
lazy ByteString
.
toAttribute :: (IsAttribute (a Low), Staged a, DevolveM m) => a High -> m (Attribute Low) Source #
toBCAttribute :: (IsAttribute (a Low), ByteCodeStaged a, DevolveM m) => (ByteCodeIndex -> m ByteCodeOffset) -> a High -> m (Attribute Low) Source #
devolveAttribute :: (IsAttribute (a Low), DevolveM m) => (a High -> m (a Low)) -> a High -> m (Attribute Low) Source #
fromAttribute' :: IsAttribute a => Attribute r -> Either String a Source #
Generate an attribute in a low stage Low
.
toAttribute' :: forall a. IsAttribute a => a -> Attribute High Source #
Helpers
class Binary a => IsAttribute a where Source #
A class-type that describes a data-type a
as an Attribute. Most notable
it provides the fromAttribute'
method that enables converting an Attribute
to a data-type a
.
Instances
type Attributes b r = Choice (SizedList16 (Attribute r)) (b r) r Source #
A list of attributes and described by the expected values.
fromAttributes :: (Foldable f, EvolveM m, Monoid a) => AttributeLocation -> f (Attribute Low) -> (Attribute High -> m a) -> m a Source #
collect :: forall c m. EvolveM m => [AttributeCollector c] -> (Attribute High -> c -> c) -> Attribute High -> m (Endo c) Source #
collectBC :: forall c m. EvolveM m => (ByteCodeOffset -> m ByteCodeIndex) -> [ByteCodeAttributeCollector c] -> (Attribute High -> c -> c) -> Attribute High -> m (Endo c) Source #
data AttributeCollector c Source #
(IsAttribute (a Low), Staged a) => Attr (a High -> c -> c) |
data ByteCodeAttributeCollector c Source #
(IsAttribute (a Low), ByteCodeStaged a) => BCAttr (a High -> c -> c) |
re-export
newtype Const a (b :: k) :: forall k. Type -> k -> Type #
The Const
functor.
Instances
Generic1 (Const a :: k -> Type) | |
Bifunctor (Const :: Type -> Type -> Type) | Since: base-4.8.0.0 |
Eq2 (Const :: Type -> Type -> Type) | Since: base-4.9.0.0 |
Ord2 (Const :: Type -> Type -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Classes | |
Read2 (Const :: Type -> Type -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Classes liftReadsPrec2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (Const a b) # liftReadList2 :: (Int -> ReadS a) -> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [Const a b] # liftReadPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec (Const a b) # liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [Const a b] # | |
Show2 (Const :: Type -> Type -> Type) | Since: base-4.9.0.0 |
NFData2 (Const :: Type -> Type -> Type) | Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq | |
Hashable2 (Const :: Type -> Type -> Type) | |
Defined in Data.Hashable.Class | |
Functor (Const m :: Type -> Type) | Since: base-2.1 |
Monoid m => Applicative (Const m :: Type -> Type) | Since: base-2.0.1 |
Foldable (Const m :: Type -> Type) | Since: base-4.7.0.0 |
Defined in Data.Functor.Const fold :: Monoid m0 => Const m m0 -> m0 # foldMap :: Monoid m0 => (a -> m0) -> Const m a -> m0 # foldr :: (a -> b -> b) -> b -> Const m a -> b # foldr' :: (a -> b -> b) -> b -> Const m a -> b # foldl :: (b -> a -> b) -> b -> Const m a -> b # foldl' :: (b -> a -> b) -> b -> Const m a -> b # foldr1 :: (a -> a -> a) -> Const m a -> a # foldl1 :: (a -> a -> a) -> Const m a -> a # elem :: Eq a => a -> Const m a -> Bool # maximum :: Ord a => Const m a -> a # minimum :: Ord a => Const m a -> a # | |
Traversable (Const m :: Type -> Type) | Since: base-4.7.0.0 |
Eq a => Eq1 (Const a :: Type -> Type) | Since: base-4.9.0.0 |
Ord a => Ord1 (Const a :: Type -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Classes | |
Read a => Read1 (Const a :: Type -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Classes | |
Show a => Show1 (Const a :: Type -> Type) | Since: base-4.9.0.0 |
NFData a => NFData1 (Const a :: Type -> Type) | Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq | |
Hashable a => Hashable1 (Const a :: Type -> Type) | |
Defined in Data.Hashable.Class | |
Bounded a => Bounded (Const a b) | Since: base-4.9.0.0 |
Enum a => Enum (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const succ :: Const a b -> Const a b # pred :: Const a b -> Const a b # fromEnum :: Const a b -> Int # enumFrom :: Const a b -> [Const a b] # enumFromThen :: Const a b -> Const a b -> [Const a b] # enumFromTo :: Const a b -> Const a b -> [Const a b] # enumFromThenTo :: Const a b -> Const a b -> Const a b -> [Const a b] # | |
Eq a => Eq (Const a b) | Since: base-4.9.0.0 |
Floating a => Floating (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const exp :: Const a b -> Const a b # log :: Const a b -> Const a b # sqrt :: Const a b -> Const a b # (**) :: Const a b -> Const a b -> Const a b # logBase :: Const a b -> Const a b -> Const a b # sin :: Const a b -> Const a b # cos :: Const a b -> Const a b # tan :: Const a b -> Const a b # asin :: Const a b -> Const a b # acos :: Const a b -> Const a b # atan :: Const a b -> Const a b # sinh :: Const a b -> Const a b # cosh :: Const a b -> Const a b # tanh :: Const a b -> Const a b # asinh :: Const a b -> Const a b # acosh :: Const a b -> Const a b # atanh :: Const a b -> Const a b # log1p :: Const a b -> Const a b # expm1 :: Const a b -> Const a b # | |
Fractional a => Fractional (Const a b) | Since: base-4.9.0.0 |
Integral a => Integral (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const | |
Num a => Num (Const a b) | Since: base-4.9.0.0 |
Ord a => Ord (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const | |
Read a => Read (Const a b) | This instance would be equivalent to the derived instances of the
Since: base-4.8.0.0 |
Real a => Real (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const toRational :: Const a b -> Rational # | |
RealFloat a => RealFloat (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const floatRadix :: Const a b -> Integer # floatDigits :: Const a b -> Int # floatRange :: Const a b -> (Int, Int) # decodeFloat :: Const a b -> (Integer, Int) # encodeFloat :: Integer -> Int -> Const a b # exponent :: Const a b -> Int # significand :: Const a b -> Const a b # scaleFloat :: Int -> Const a b -> Const a b # isInfinite :: Const a b -> Bool # isDenormalized :: Const a b -> Bool # isNegativeZero :: Const a b -> Bool # | |
RealFrac a => RealFrac (Const a b) | Since: base-4.9.0.0 |
Show a => Show (Const a b) | This instance would be equivalent to the derived instances of the
Since: base-4.8.0.0 |
Ix a => Ix (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const range :: (Const a b, Const a b) -> [Const a b] # index :: (Const a b, Const a b) -> Const a b -> Int # unsafeIndex :: (Const a b, Const a b) -> Const a b -> Int inRange :: (Const a b, Const a b) -> Const a b -> Bool # rangeSize :: (Const a b, Const a b) -> Int # unsafeRangeSize :: (Const a b, Const a b) -> Int | |
IsString a => IsString (Const a b) | Since: base-4.9.0.0 |
Defined in Data.String fromString :: String -> Const a b # | |
Generic (Const a b) | |
Semigroup a => Semigroup (Const a b) | Since: base-4.9.0.0 |
Monoid a => Monoid (Const a b) | Since: base-4.9.0.0 |
Storable a => Storable (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const | |
Bits a => Bits (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const (.&.) :: Const a b -> Const a b -> Const a b # (.|.) :: Const a b -> Const a b -> Const a b # xor :: Const a b -> Const a b -> Const a b # complement :: Const a b -> Const a b # shift :: Const a b -> Int -> Const a b # rotate :: Const a b -> Int -> Const a b # setBit :: Const a b -> Int -> Const a b # clearBit :: Const a b -> Int -> Const a b # complementBit :: Const a b -> Int -> Const a b # testBit :: Const a b -> Int -> Bool # bitSizeMaybe :: Const a b -> Maybe Int # isSigned :: Const a b -> Bool # shiftL :: Const a b -> Int -> Const a b # unsafeShiftL :: Const a b -> Int -> Const a b # shiftR :: Const a b -> Int -> Const a b # unsafeShiftR :: Const a b -> Int -> Const a b # rotateL :: Const a b -> Int -> Const a b # | |
FiniteBits a => FiniteBits (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const finiteBitSize :: Const a b -> Int # countLeadingZeros :: Const a b -> Int # countTrailingZeros :: Const a b -> Int # | |
NFData a => NFData (Const a b) | Since: deepseq-1.4.0.0 |
Defined in Control.DeepSeq | |
Hashable a => Hashable (Const a b) | |
Defined in Data.Hashable.Class | |
type Rep1 (Const a :: k -> Type) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const | |
type Rep (Const a b) | Since: base-4.9.0.0 |
Defined in Data.Functor.Const |