Safe Haskell | None |
---|---|
Language | Haskell2010 |
Type families from Morley.Michelson.Typed.Arith lifted to Haskell types.
Synopsis
- class ArithOpHs (aop :: Type) (n :: Type) (m :: Type) (r :: Type) where
- evalArithOpHs :: (n ': (m ': s)) :-> (r ': s)
- class DefArithOp aop where
- defEvalOpHs :: (ArithOp aop n m, r ~ ArithRes aop n m) => Instr (n ': (m ': s)) (r ': s)
- class UnaryArithOpHs (aop :: Type) (n :: Type) where
- type UnaryArithResHs aop n :: Type
- evalUnaryArithOpHs :: (n ': s) :-> (UnaryArithResHs aop n ': s)
- class DefUnaryArithOp aop where
- defUnaryArithOpHs :: (UnaryArithOp aop n, r ~ UnaryArithRes aop n) => Instr (n ': s) (r ': s)
- class ToIntegerArithOpHs (n :: Type) where
- evalToIntOpHs :: (n ': s) :-> (Integer ': s)
Documentation
class ArithOpHs (aop :: Type) (n :: Type) (m :: Type) (r :: Type) where Source #
Lifted ArithOp
.
Nothing
evalArithOpHs :: (n ': (m ': s)) :-> (r ': s) Source #
default evalArithOpHs :: (DefArithOp aop, ArithOp aop (ToT n) (ToT m), ToT r ~ ArithRes aop (ToT n) (ToT m)) => (n ': (m ': s)) :-> (r ': s) Source #
Instances
class DefArithOp aop where Source #
Helper typeclass that provides default definition of evalArithOpHs
.
defEvalOpHs :: (ArithOp aop n m, r ~ ArithRes aop n m) => Instr (n ': (m ': s)) (r ': s) Source #
Instances
DefArithOp Add Source # | |
Defined in Lorentz.Arith defEvalOpHs :: forall (n :: T) (m :: T) (r :: T) (s :: [T]). (ArithOp Add n m, r ~ ArithRes Add n m) => Instr (n ': (m ': s)) (r ': s) Source # | |
DefArithOp And Source # | |
Defined in Lorentz.Arith defEvalOpHs :: forall (n :: T) (m :: T) (r :: T) (s :: [T]). (ArithOp And n m, r ~ ArithRes And n m) => Instr (n ': (m ': s)) (r ': s) Source # | |
DefArithOp EDiv Source # | |
Defined in Lorentz.Arith defEvalOpHs :: forall (n :: T) (m :: T) (r :: T) (s :: [T]). (ArithOp EDiv n m, r ~ ArithRes EDiv n m) => Instr (n ': (m ': s)) (r ': s) Source # | |
DefArithOp Lsl Source # | |
Defined in Lorentz.Arith defEvalOpHs :: forall (n :: T) (m :: T) (r :: T) (s :: [T]). (ArithOp Lsl n m, r ~ ArithRes Lsl n m) => Instr (n ': (m ': s)) (r ': s) Source # | |
DefArithOp Lsr Source # | |
Defined in Lorentz.Arith defEvalOpHs :: forall (n :: T) (m :: T) (r :: T) (s :: [T]). (ArithOp Lsr n m, r ~ ArithRes Lsr n m) => Instr (n ': (m ': s)) (r ': s) Source # | |
DefArithOp Mul Source # | |
Defined in Lorentz.Arith defEvalOpHs :: forall (n :: T) (m :: T) (r :: T) (s :: [T]). (ArithOp Mul n m, r ~ ArithRes Mul n m) => Instr (n ': (m ': s)) (r ': s) Source # | |
DefArithOp Or Source # | |
Defined in Lorentz.Arith defEvalOpHs :: forall (n :: T) (m :: T) (r :: T) (s :: [T]). (ArithOp Or n m, r ~ ArithRes Or n m) => Instr (n ': (m ': s)) (r ': s) Source # | |
DefArithOp Sub Source # | |
Defined in Lorentz.Arith defEvalOpHs :: forall (n :: T) (m :: T) (r :: T) (s :: [T]). (ArithOp Sub n m, r ~ ArithRes Sub n m) => Instr (n ': (m ': s)) (r ': s) Source # | |
DefArithOp Xor Source # | |
Defined in Lorentz.Arith defEvalOpHs :: forall (n :: T) (m :: T) (r :: T) (s :: [T]). (ArithOp Xor n m, r ~ ArithRes Xor n m) => Instr (n ': (m ': s)) (r ': s) Source # |
class UnaryArithOpHs (aop :: Type) (n :: Type) where Source #
Lifted UnaryArithOp
.
Nothing
type UnaryArithResHs aop n :: Type Source #
evalUnaryArithOpHs :: (n ': s) :-> (UnaryArithResHs aop n ': s) Source #
default evalUnaryArithOpHs :: (DefUnaryArithOp aop, UnaryArithOp aop (ToT n), ToT (UnaryArithResHs aop n) ~ UnaryArithRes aop (ToT n)) => (n ': s) :-> (UnaryArithResHs aop n ': s) Source #
Instances
class DefUnaryArithOp aop where Source #
Helper typeclass that provides default definition of evalUnaryArithOpHs
.
defUnaryArithOpHs :: (UnaryArithOp aop n, r ~ UnaryArithRes aop n) => Instr (n ': s) (r ': s) Source #
Instances
DefUnaryArithOp Abs Source # | |
Defined in Lorentz.Arith defUnaryArithOpHs :: forall (n :: T) (r :: T) (s :: [T]). (UnaryArithOp Abs n, r ~ UnaryArithRes Abs n) => Instr (n ': s) (r ': s) Source # | |
DefUnaryArithOp Eq' Source # | |
Defined in Lorentz.Arith defUnaryArithOpHs :: forall (n :: T) (r :: T) (s :: [T]). (UnaryArithOp Eq' n, r ~ UnaryArithRes Eq' n) => Instr (n ': s) (r ': s) Source # | |
DefUnaryArithOp Ge Source # | |
Defined in Lorentz.Arith defUnaryArithOpHs :: forall (n :: T) (r :: T) (s :: [T]). (UnaryArithOp Ge n, r ~ UnaryArithRes Ge n) => Instr (n ': s) (r ': s) Source # | |
DefUnaryArithOp Gt Source # | |
Defined in Lorentz.Arith defUnaryArithOpHs :: forall (n :: T) (r :: T) (s :: [T]). (UnaryArithOp Gt n, r ~ UnaryArithRes Gt n) => Instr (n ': s) (r ': s) Source # | |
DefUnaryArithOp Le Source # | |
Defined in Lorentz.Arith defUnaryArithOpHs :: forall (n :: T) (r :: T) (s :: [T]). (UnaryArithOp Le n, r ~ UnaryArithRes Le n) => Instr (n ': s) (r ': s) Source # | |
DefUnaryArithOp Lt Source # | |
Defined in Lorentz.Arith defUnaryArithOpHs :: forall (n :: T) (r :: T) (s :: [T]). (UnaryArithOp Lt n, r ~ UnaryArithRes Lt n) => Instr (n ': s) (r ': s) Source # | |
DefUnaryArithOp Neg Source # | |
Defined in Lorentz.Arith defUnaryArithOpHs :: forall (n :: T) (r :: T) (s :: [T]). (UnaryArithOp Neg n, r ~ UnaryArithRes Neg n) => Instr (n ': s) (r ': s) Source # | |
DefUnaryArithOp Neq Source # | |
Defined in Lorentz.Arith defUnaryArithOpHs :: forall (n :: T) (r :: T) (s :: [T]). (UnaryArithOp Neq n, r ~ UnaryArithRes Neq n) => Instr (n ': s) (r ': s) Source # | |
DefUnaryArithOp Not Source # | |
Defined in Lorentz.Arith defUnaryArithOpHs :: forall (n :: T) (r :: T) (s :: [T]). (UnaryArithOp Not n, r ~ UnaryArithRes Not n) => Instr (n ': s) (r ': s) Source # |
class ToIntegerArithOpHs (n :: Type) where Source #
Nothing
evalToIntOpHs :: (n ': s) :-> (Integer ': s) Source #
Instances
ToIntegerArithOpHs Natural Source # | |
Defined in Lorentz.Arith | |
ToIntegerArithOpHs Bls12381Fr Source # | |
Defined in Lorentz.Arith evalToIntOpHs :: forall (s :: [Type]). (Bls12381Fr ': s) :-> (Integer ': s) Source # | |
ToIntegerArithOpHs (NFixed a) Source # | |
Defined in Lorentz.Arith |