mirror of
https://github.com/logos-storage/plonky2-verifier.git
synced 2026-01-02 13:53:07 +00:00
73 lines
2.0 KiB
Haskell
73 lines
2.0 KiB
Haskell
|
|
-- | Quadratic extension of the Goldilocks field
|
|
--
|
|
-- The field is defined as @F[X] / (X^2 - 7)@
|
|
--
|
|
-- (@X^2 - 7@ is the smallest such irreducible polynomial over Goldilocks)
|
|
--
|
|
|
|
module GoldilocksExt where
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Data.Bits
|
|
import Data.Ratio
|
|
|
|
import Goldilocks
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
type FExt = GoldilocksExt
|
|
|
|
data GoldilocksExt
|
|
= MkExt !Goldilocks !Goldilocks
|
|
deriving Eq
|
|
|
|
instance Show GoldilocksExt where
|
|
show (MkExt real imag) = "(" ++ show real ++ " + X*" ++ show imag ++ ")"
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
instance Num FExt where
|
|
fromInteger k = MkExt (fromInteger k) 0
|
|
negate (MkExt r i) = MkExt (negate r) (negate i)
|
|
(+) (MkExt r1 i1) (MkExt r2 i2) = MkExt (r1+r2) (i1+i2)
|
|
(-) (MkExt r1 i1) (MkExt r2 i2) = MkExt (r1-r2) (i1-i2)
|
|
(*) (MkExt r1 i1) (MkExt r2 i2) = MkExt (r1*r2 + 7*i1*i2) (r1*i2 + r2*i1)
|
|
signum = const 1
|
|
abs = id
|
|
|
|
instance Fractional FExt where
|
|
fromRational q = fromInteger (numerator q) / fromInteger (denominator q)
|
|
recip = invExt
|
|
(/) = divExt
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
sqrExt :: FExt -> FExt
|
|
sqrExt x = x*x
|
|
|
|
invExt :: FExt -> FExt
|
|
invExt (MkExt a b) = MkExt c d where
|
|
denom = inv (a*a - 7*b*b)
|
|
c = a * denom
|
|
d = negate b * denom
|
|
|
|
divExt :: FExt -> FExt -> FExt
|
|
divExt u v = u * invExt v
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
powExt :: GoldilocksExt -> Integer -> GoldilocksExt
|
|
powExt x e
|
|
| e == 0 = 1
|
|
| e < 0 = powExt (invExt x) (negate e)
|
|
| otherwise = go 1 x e
|
|
where
|
|
go !acc _ 0 = acc
|
|
go !acc !s !expo = case expo .&. 1 of
|
|
0 -> go acc (sqrExt s) (shiftR expo 1)
|
|
_ -> go (acc*s) (sqrExt s) (shiftR expo 1)
|
|
|
|
--------------------------------------------------------------------------------
|