summaryrefslogtreecommitdiff
path: root/Algebra/Field/Galois/Internal.hs
blob: 43893000c4b5b0830143daae8ea0e50616e7b893 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
{-# LANGUAGE DataKinds, EmptyDataDecls, FlexibleInstances              #-}
{-# LANGUAGE MultiParamTypeClasses, NoImplicitPrelude                  #-}
{-# LANGUAGE NoMonomorphismRestriction, PolyKinds, ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell, UndecidableInstances                     #-}
module Algebra.Field.Galois.Internal
       (ConwayPolynomial(..),
        Conway,
        buildInstance,
        parseLine) where
import           Algebra.Field.Finite
import           Algebra.Prelude.Core               hiding (lex, lift)
import           Algebra.Ring.Polynomial.Univariate (Unipol)
import           Data.Char                          (isDigit)
import           Data.Char                          (digitToInt)
import qualified Data.Map                           as M
import           Data.Reflection
import qualified GHC.TypeLits                       as TL
import           Language.Haskell.TH
import           Language.Haskell.TH.Syntax         (lift)
import           Numeric                            (readInt)
import           Prelude                            (lex)

-- | Type-class to provide the dictionary for Conway polynomials
class ConwayPolynomial (p :: TL.Nat) (n :: TL.Nat) where
  conwayPolynomial :: proxy p -> proxy n -> Unipol (F p)

-- | Empty tag to reify Conway polynomial to type-level
data Conway p n

-- instance  {-# OVERLAPPABLE #-} (KnownNat p, KnownNat n) => ConwayPolynomial p n where
--   conwayPolynomial _ _ = undefined

instance (ConwayPolynomial p n) => Reifies (Conway p n) (Unipol (F p)) where
  reflect _ = conwayPolynomial (Proxy :: Proxy p) (Proxy :: Proxy n)

parseLine :: String -> [(Integer, Integer, [Integer])]
parseLine ('[':xs) =
  [(p,n,poly) | (f, ',':rest) <- lex xs
              , (p, "") <- readInt 10 isDigit digitToInt f
              , (n, ',':ys) <- readInt 10 isDigit digitToInt rest
              , (poly, _)    <- readList ys
              ]
parseLine _ = []

plusOp :: ExpQ -> ExpQ -> ExpQ
plusOp e f = infixApp e [| (+) |] f

toPoly :: [Integer] -> ExpQ
toPoly as =
  foldl1 plusOp $
  zipWith (\i c -> [| injectCoeff (modNat $(litE $ integerL c)) * var 0 ^ $(lift i) |])
  [0 :: Integer ..] as

buildInstance :: (Integer, Integer, [Integer]) -> DecsQ
buildInstance (p,n,cs) =
  let tp = litT $ numTyLit p
      tn = litT $ numTyLit n
  in [d| instance {-# OVERLAPPING #-} ConwayPolynomial $tp $tn where
           conwayPolynomial _ _ = $(toPoly cs)
           {-# INLINE conwayPolynomial #-}
       |]