lorentz-0.13.4: EDSL for the Michelson Language
Safe HaskellNone
LanguageHaskell2010

Lorentz.FixedArith

Synopsis

Lorentz instructions

div :: forall r n m s. ArithOpHs Div n m r => (n ': (m ': s)) :-> (r ': s) Source #

Operation that represents division of two values with a given result

castNFixedToFixed :: (NFixed p ': s) :-> (Fixed p ': s) Source #

castFixedToNFixed :: (Fixed p ': s) :-> (Maybe (NFixed p) ': s) Source #

Lorentz casts

class LorentzRounding a b where Source #

Class that enables support of rounding operations for Lorentz non-integer values Note: Round is implemented using "banker's rounding" strategy, rounding half-way values towards nearest even value

Methods

round_ :: (a ': s) :-> (b ': s) Source #

ceil_ :: (a ': s) :-> (b ': s) Source #

floor_ :: (a ': s) :-> (b ': s) Source #

Instances

Instances details
(KnownNat a, KnownNat b) => LorentzRounding (Fixed (BinBase a)) (Fixed (BinBase b)) Source # 
Instance details

Defined in Lorentz.FixedArith

Methods

round_ :: forall (s :: [Type]). (Fixed (BinBase a) ': s) :-> (Fixed (BinBase b) ': s) Source #

ceil_ :: forall (s :: [Type]). (Fixed (BinBase a) ': s) :-> (Fixed (BinBase b) ': s) Source #

floor_ :: forall (s :: [Type]). (Fixed (BinBase a) ': s) :-> (Fixed (BinBase b) ': s) Source #

(KnownNat a, KnownNat b) => LorentzRounding (Fixed (DecBase a)) (Fixed (DecBase b)) Source # 
Instance details

Defined in Lorentz.FixedArith

Methods

round_ :: forall (s :: [Type]). (Fixed (DecBase a) ': s) :-> (Fixed (DecBase b) ': s) Source #

ceil_ :: forall (s :: [Type]). (Fixed (DecBase a) ': s) :-> (Fixed (DecBase b) ': s) Source #

floor_ :: forall (s :: [Type]). (Fixed (DecBase a) ': s) :-> (Fixed (DecBase b) ': s) Source #

(KnownNat a, KnownNat b) => LorentzRounding (NFixed (BinBase a)) (NFixed (BinBase b)) Source # 
Instance details

Defined in Lorentz.FixedArith

Methods

round_ :: forall (s :: [Type]). (NFixed (BinBase a) ': s) :-> (NFixed (BinBase b) ': s) Source #

ceil_ :: forall (s :: [Type]). (NFixed (BinBase a) ': s) :-> (NFixed (BinBase b) ': s) Source #

floor_ :: forall (s :: [Type]). (NFixed (BinBase a) ': s) :-> (NFixed (BinBase b) ': s) Source #

LorentzRounding (Fixed (DecBase a)) (Fixed (DecBase b)) => LorentzRounding (NFixed (DecBase a)) (NFixed (DecBase b)) Source # 
Instance details

Defined in Lorentz.FixedArith

Methods

round_ :: forall (s :: [Type]). (NFixed (DecBase a) ': s) :-> (NFixed (DecBase b) ': s) Source #

ceil_ :: forall (s :: [Type]). (NFixed (DecBase a) ': s) :-> (NFixed (DecBase b) ': s) Source #

floor_ :: forall (s :: [Type]). (NFixed (DecBase a) ': s) :-> (NFixed (DecBase b) ': s) Source #

class LorentzFixedCast a where Source #

Class that allows casting Fixed values to Integer in vice versa

Methods

fromFixed :: (a ': s) :-> (Integer ': s) Source #

toFixed :: (Integer ': s) :-> (a ': s) Source #

Instances

Instances details
KnownNat a => LorentzFixedCast (Fixed (BinBase a)) Source # 
Instance details

Defined in Lorentz.FixedArith

Methods

fromFixed :: forall (s :: [Type]). (Fixed (BinBase a) ': s) :-> (Integer ': s) Source #

toFixed :: forall (s :: [Type]). (Integer ': s) :-> (Fixed (BinBase a) ': s) Source #

KnownNat a => LorentzFixedCast (Fixed (DecBase a)) Source # 
Instance details

Defined in Lorentz.FixedArith

Methods

fromFixed :: forall (s :: [Type]). (Fixed (DecBase a) ': s) :-> (Integer ': s) Source #

toFixed :: forall (s :: [Type]). (Integer ': s) :-> (Fixed (DecBase a) ': s) Source #

LorentzFixedCast (Fixed a) => LorentzFixedCast (NFixed a) Source # 
Instance details

Defined in Lorentz.FixedArith

Methods

fromFixed :: forall (s :: [Type]). (NFixed a ': s) :-> (Integer ': s) Source #

toFixed :: forall (s :: [Type]). (Integer ': s) :-> (NFixed a ': s) Source #

Orphan instances

(r ~ Maybe (Integer, NFixed (BinBase a)), KnownNat a) => ArithOpHs EDiv (Fixed (BinBase a)) Natural r Source # 
Instance details

Methods

evalArithOpHs :: forall (s :: [Type]). (Fixed (BinBase a) ': (Natural ': s)) :-> (r ': s) Source #

(r ~ Maybe (Integer, NFixed (BinBase a)), KnownNat a) => ArithOpHs EDiv (Fixed (BinBase a)) Integer r Source # 
Instance details

Methods

evalArithOpHs :: forall (s :: [Type]). (Fixed (BinBase a) ': (Integer ': s)) :-> (r ': s) Source #

(r ~ Maybe (Integer, NFixed (DecBase a)), KnownNat a) => ArithOpHs EDiv (Fixed (DecBase a)) Natural r Source # 
Instance details

Methods

evalArithOpHs :: forall (s :: [Type]). (Fixed (DecBase a) ': (Natural ': s)) :-> (r ': s) Source #

(r ~ Maybe (Integer, NFixed (DecBase a)), KnownNat a) => ArithOpHs EDiv (Fixed (DecBase a)) Integer r Source # 
Instance details

Methods

evalArithOpHs :: forall (s :: [Type]). (Fixed (DecBase a) ': (Integer ': s)) :-> (r ': s) Source #

(r ~ Maybe (Natural, NFixed (BinBase a)), KnownNat a) => ArithOpHs EDiv (NFixed (BinBase a)) Natural r Source # 
Instance details

Methods

evalArithOpHs :: forall (s :: [Type]). (NFixed (BinBase a) ': (Natural ': s)) :-> (r ': s) Source #

(r ~ Maybe (Integer, NFixed (BinBase a)), KnownNat a) => ArithOpHs EDiv (NFixed (BinBase a)) Integer r Source # 
Instance details

Methods

evalArithOpHs :: forall (s :: [Type]). (NFixed (BinBase a) ': (Integer ': s)) :-> (r ': s) Source #

(r ~ Maybe (Natural, NFixed (DecBase a)), KnownNat a) => ArithOpHs EDiv (NFixed (DecBase a)) Natural r Source # 
Instance details

Methods

evalArithOpHs :: forall (s :: [Type]). (NFixed (DecBase a) ': (Natural ': s)) :-> (r ': s) Source #

(r ~ Maybe (Integer, NFixed (DecBase a)), KnownNat a) => ArithOpHs EDiv (NFixed (DecBase a)) Integer r Source # 
Instance details

Methods

evalArithOpHs :: forall (s :: [Type]). (NFixed (DecBase a) ': (Integer ': s)) :-> (r ': s) Source #