fortran-src-0.15.1: Parsers and analyses for Fortran standards 66, 77, 90, 95 and 2003 (partial).
Safe HaskellSafe-Inferred
LanguageHaskell2010

Language.Fortran.Repr.Value.Scalar.Common

Description

Common definitions for Fortran scalar representations.

Synopsis

Documentation

data SomeFKinded k ft where Source #

Convenience wrapper which multiple Fortran tag-kinded intrinsic types fit.

A type ft takes some type fk of kind k, and we are permitted to move the type between the term and type levels using the included singleton instances.

For example, integers are kinded with type level FTInts. So we can define an integer with an existential ("unknown") kind with the type SomeFKinded FTInt FInt. By pattern matching on it, we recover the hidden kind tag (as well as obtaining the value).

Note that many type classes usually derived generically (e.g. Binary) instances should be manually derived on this wrapper type. TODO give a better explanation why?

Constructors

SomeFKinded :: forall {k} ft (fk :: k). (SingKind k, SingI fk, Data (ft fk)) => ft fk -> SomeFKinded k ft 

Instances

Instances details
(forall (fk :: k2). Show (ft fk)) => Out (SomeFKinded k1 ft) Source #

Derive Out instances via Show.

Instance details

Defined in Language.Fortran.Repr.Value.Scalar.Common

Methods

docPrec :: Int -> SomeFKinded k1 ft -> Doc #

doc :: SomeFKinded k1 ft -> Doc #

docList :: [SomeFKinded k1 ft] -> Doc #

(SingKind k, forall (fk :: k). SingI fk, forall (fk :: k). Data (ft fk), Typeable ft, Typeable k) => Data (SomeFKinded k ft) Source # 
Instance details

Defined in Language.Fortran.Repr.Value.Scalar.Common

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> SomeFKinded k ft -> c (SomeFKinded k ft) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (SomeFKinded k ft) #

toConstr :: SomeFKinded k ft -> Constr #

dataTypeOf :: SomeFKinded k ft -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (SomeFKinded k ft)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (SomeFKinded k ft)) #

gmapT :: (forall b. Data b => b -> b) -> SomeFKinded k ft -> SomeFKinded k ft #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> SomeFKinded k ft -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> SomeFKinded k ft -> r #

gmapQ :: (forall d. Data d => d -> u) -> SomeFKinded k ft -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> SomeFKinded k ft -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> SomeFKinded k ft -> m (SomeFKinded k ft) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> SomeFKinded k ft -> m (SomeFKinded k ft) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> SomeFKinded k ft -> m (SomeFKinded k ft) #

(forall (fk :: k1). Show (ft fk)) => Show (SomeFKinded k2 ft) Source #

GHC can derive stock Show instances given some QuantifiedConstraints guarantees (wow!).

Instance details

Defined in Language.Fortran.Repr.Value.Scalar.Common

Methods

showsPrec :: Int -> SomeFKinded k2 ft -> ShowS #

show :: SomeFKinded k2 ft -> String #

showList :: [SomeFKinded k2 ft] -> ShowS #

(Binary (Demote k), SingKind k, forall (fk :: k). SingI fk => Binary (ft fk), forall (fk :: k). Data (ft fk)) => Binary (SomeFKinded k ft) Source #

For any Fortran type ft kinded with k, we may derive a Binary instance by leveraging the kind tag's instance Binary (Demote k) and the kinded value's instance Binary (ft k). (We also have to ferry some singletons instances through.)

WARNING: This instance is only sound for types where each kind tag value is used once at most (meaning if you know the fkind, you know the constructor).

Note that the Get instance works by parsing a kind tag, promoting it to a singleton, then gleaning type information and using that to parse the inner kinded value. Dependent types! TODO if we pack a Data context into SomeFKinded, get can't recover it!!

Instance details

Defined in Language.Fortran.Repr.Value.Scalar.Common

Methods

put :: SomeFKinded k ft -> Put #

get :: Get (SomeFKinded k ft) #

putList :: [SomeFKinded k ft] -> Put #

someFKindedKind :: SomeFKinded k ft -> Demote k Source #

Recover some TYPE(x)'s kind (the x).

class FKinded a where Source #

A kinded Fortran value.

Associated Types

type FKindedT a Source #

The Haskell type used to record this Fortran type's kind.

type FKindedC a b :: Constraint Source #

For every Fortran kind of this Fortran type a, the underlying representation b has the given constraints.

Methods

fKind :: a -> FKindedT a Source #

Obtain the kind of a Fortran value.

Instances

Instances details
FKinded FComplex Source # 
Instance details

Defined in Language.Fortran.Repr.Value.Scalar.Complex

Associated Types

type FKindedT FComplex Source #

type FKindedC FComplex b Source #

FKinded FInt Source # 
Instance details

Defined in Language.Fortran.Repr.Value.Scalar.Int.Machine

Associated Types

type FKindedT FInt Source #

type FKindedC FInt b Source #

FKinded FReal Source # 
Instance details

Defined in Language.Fortran.Repr.Value.Scalar.Real

Associated Types

type FKindedT FReal Source #

type FKindedC FReal b Source #