camfort-1.2.0: CamFort - Cambridge Fortran infrastructure
Safe HaskellSafe-Inferred
LanguageHaskell2010

Camfort.Specification.Units.InferenceBackendFlint

Synopsis

Documentation

newtype FMPZ Source #

Units of measure extension to Fortran: Flint backend components

Some notes on the Flint library to aid comprehension of the original C and this interface:

  • They use a typedef TYPE TYPE_t[1] convention to do call-by-reference without an explicit pointer. It appears to be an unmentioned convention borrowed from related library & depedency GMP, explained in a GMP doc page: https://gmplib.org/manual/Parameter-Conventions . Any time one of these is a function parameter, it is correct to use 'Ptr a' in Haskell.
  • Flint extensively uses two typedefs ulong and slong, which are "long integers" in unsigned and signed representations respectively. However, the story is more complicated in cross-platform contexts, because 64-bit Linux's longs are 64 bits (8 bytes), while 64-bit Windows kept them at 32 bits (4 bytes). That type is CLong in Haskell, and it doesn't match up with Flint's slong, so we roll our own newtypes instead. (See the definition for further explanation.)
typedef slong fmpz

GHC's generalized newtype deriving handles deriving all the instances we require for us.

Constructors

FMPZ 

Fields

Instances

Instances details
Storable FMPZ Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

sizeOf :: FMPZ -> Int #

alignment :: FMPZ -> Int #

peekElemOff :: Ptr FMPZ -> Int -> IO FMPZ #

pokeElemOff :: Ptr FMPZ -> Int -> FMPZ -> IO () #

peekByteOff :: Ptr b -> Int -> IO FMPZ #

pokeByteOff :: Ptr b -> Int -> FMPZ -> IO () #

peek :: Ptr FMPZ -> IO FMPZ #

poke :: Ptr FMPZ -> FMPZ -> IO () #

Enum FMPZ Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

succ :: FMPZ -> FMPZ #

pred :: FMPZ -> FMPZ #

toEnum :: Int -> FMPZ #

fromEnum :: FMPZ -> Int #

enumFrom :: FMPZ -> [FMPZ] #

enumFromThen :: FMPZ -> FMPZ -> [FMPZ] #

enumFromTo :: FMPZ -> FMPZ -> [FMPZ] #

enumFromThenTo :: FMPZ -> FMPZ -> FMPZ -> [FMPZ] #

Num FMPZ Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

(+) :: FMPZ -> FMPZ -> FMPZ #

(-) :: FMPZ -> FMPZ -> FMPZ #

(*) :: FMPZ -> FMPZ -> FMPZ #

negate :: FMPZ -> FMPZ #

abs :: FMPZ -> FMPZ #

signum :: FMPZ -> FMPZ #

fromInteger :: Integer -> FMPZ #

Integral FMPZ Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

quot :: FMPZ -> FMPZ -> FMPZ #

rem :: FMPZ -> FMPZ -> FMPZ #

div :: FMPZ -> FMPZ -> FMPZ #

mod :: FMPZ -> FMPZ -> FMPZ #

quotRem :: FMPZ -> FMPZ -> (FMPZ, FMPZ) #

divMod :: FMPZ -> FMPZ -> (FMPZ, FMPZ) #

toInteger :: FMPZ -> Integer #

Real FMPZ Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

toRational :: FMPZ -> Rational #

Eq FMPZ Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

(==) :: FMPZ -> FMPZ -> Bool #

(/=) :: FMPZ -> FMPZ -> Bool #

Ord FMPZ Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

compare :: FMPZ -> FMPZ -> Ordering #

(<) :: FMPZ -> FMPZ -> Bool #

(<=) :: FMPZ -> FMPZ -> Bool #

(>) :: FMPZ -> FMPZ -> Bool #

(>=) :: FMPZ -> FMPZ -> Bool #

max :: FMPZ -> FMPZ -> FMPZ #

min :: FMPZ -> FMPZ -> FMPZ #

newtype SLong Source #

Flint's long signed integer type slong (= GMP's mp_limb_signed_t).

As described in their Portability doc page https://flintlib.org/doc/portability.html , this replaces long (long signed integer). Importantly, it is *always* 64-bits, regardless of platform. long on Windows is usually 32-bits (whether on a 32-bit or 64-bit install), and you're meant to use long long instead.

We tie the typedef to Haskell's Int64, since that should be the appropriate size for any regular platform. Better would be to do some CPP or hsc2hs magic to check the size of an slong and use the appropriate Haskell signed integer type.

GHC's generalized newtype deriving handles deriving all the instances we require for us.

Constructors

SLong 

Fields

Instances

Instances details
Storable SLong Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

sizeOf :: SLong -> Int #

alignment :: SLong -> Int #

peekElemOff :: Ptr SLong -> Int -> IO SLong #

pokeElemOff :: Ptr SLong -> Int -> SLong -> IO () #

peekByteOff :: Ptr b -> Int -> IO SLong #

pokeByteOff :: Ptr b -> Int -> SLong -> IO () #

peek :: Ptr SLong -> IO SLong #

poke :: Ptr SLong -> SLong -> IO () #

Enum SLong Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Num SLong Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Integral SLong Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Real SLong Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

toRational :: SLong -> Rational #

Eq SLong Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

(==) :: SLong -> SLong -> Bool #

(/=) :: SLong -> SLong -> Bool #

Ord SLong Source # 
Instance details

Defined in Camfort.Specification.Units.InferenceBackendFlint

Methods

compare :: SLong -> SLong -> Ordering #

(<) :: SLong -> SLong -> Bool #

(<=) :: SLong -> SLong -> Bool #

(>) :: SLong -> SLong -> Bool #

(>=) :: SLong -> SLong -> Bool #

max :: SLong -> SLong -> SLong #

min :: SLong -> SLong -> SLong #

withWindow :: Ptr FMPZMat -> SLong -> SLong -> SLong -> SLong -> (Ptr FMPZMat -> IO b) -> IO b Source #

pokeM :: Ptr FMPZMat -> SLong -> SLong -> SLong -> IO () Source #