{-# LANGUAGE ConstraintKinds, FlexibleContexts, MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude, TemplateHaskell                       #-}
module Algebra.Algorithms.FGLM (FGLMEnv(..), lMap, gLex, bLex, proced,
                                monomial, look, (.==), (@==), image, Machine) where
import           Algebra.Ring.Polynomial
import           Control.Lens
import           Control.Monad
import           Control.Monad.Reader
import           Control.Monad.ST
import           Data.Function
import           Data.Maybe
import           Data.STRef
import qualified Data.Vector             as V
import           Prelude                 hiding (Num (..), recip, (^))

data FGLMEnv s r ord n = FGLMEnv { FGLMEnv s r ord n -> OrderedPolynomial r ord n -> Vector r
_lMap     :: OrderedPolynomial r ord n -> V.Vector r
                                 , FGLMEnv s r ord n -> STRef s [OrderedPolynomial r Lex n]
_gLex     :: STRef s [OrderedPolynomial r Lex n]
                                 , FGLMEnv s r ord n -> STRef s [OrderedPolynomial r ord n]
_bLex     :: STRef s [OrderedPolynomial r ord n]
                                 , FGLMEnv s r ord n -> STRef s (Maybe (OrderedPolynomial r Lex n))
_proced   :: STRef s (Maybe (OrderedPolynomial r Lex n))
                                 , FGLMEnv s r ord n -> STRef s (OrderedMonomial Lex n)
_monomial :: STRef s (OrderedMonomial Lex n)
                                 }

makeLenses ''FGLMEnv

type Machine s r ord n = ReaderT (FGLMEnv s r ord n) (ST s)

look :: Getting (STRef s b) (FGLMEnv s r ord n) (STRef s b) -> Machine s r ord n b
look :: Getting (STRef s b) (FGLMEnv s r ord n) (STRef s b)
-> Machine s r ord n b
look = ST s b -> Machine s r ord n b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s b -> Machine s r ord n b)
-> (STRef s b -> ST s b) -> STRef s b -> Machine s r ord n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STRef s b -> ST s b
forall s a. STRef s a -> ST s a
readSTRef (STRef s b -> Machine s r ord n b)
-> (Getting (STRef s b) (FGLMEnv s r ord n) (STRef s b)
    -> ReaderT (FGLMEnv s r ord n) (ST s) (STRef s b))
-> Getting (STRef s b) (FGLMEnv s r ord n) (STRef s b)
-> Machine s r ord n b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Getting (STRef s b) (FGLMEnv s r ord n) (STRef s b)
-> ReaderT (FGLMEnv s r ord n) (ST s) (STRef s b)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view

(.==) :: (MonadTrans t, MonadReader s (t (ST s1))) => Getting (STRef s1 a) s (STRef s1 a) -> a -> t (ST s1) ()
Getting (STRef s1 a) s (STRef s1 a)
v .== :: Getting (STRef s1 a) s (STRef s1 a) -> a -> t (ST s1) ()
.== a
a = do
  STRef s1 a
ref <- Getting (STRef s1 a) s (STRef s1 a) -> t (ST s1) (STRef s1 a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (STRef s1 a) s (STRef s1 a)
v
  ST s1 () -> t (ST s1) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s1 () -> t (ST s1) ()) -> ST s1 () -> t (ST s1) ()
forall a b. (a -> b) -> a -> b
$ STRef s1 a -> a -> ST s1 ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s1 a
ref a
a

(@==) :: (MonadTrans t, MonadReader s (t (ST s1))) => Getting (STRef s1 a) s (STRef s1 a) -> (a -> a) -> t (ST s1) ()
Getting (STRef s1 a) s (STRef s1 a)
v @== :: Getting (STRef s1 a) s (STRef s1 a) -> (a -> a) -> t (ST s1) ()
@== a -> a
f = do
  STRef s1 a
ref <- Getting (STRef s1 a) s (STRef s1 a) -> t (ST s1) (STRef s1 a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (STRef s1 a) s (STRef s1 a)
v
  ST s1 () -> t (ST s1) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ST s1 () -> t (ST s1) ()) -> ST s1 () -> t (ST s1) ()
forall a b. (a -> b) -> a -> b
$ STRef s1 a -> (a -> a) -> ST s1 ()
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef' STRef s1 a
ref a -> a
f

infix 4 .==, @==

image :: (MonadReader (FGLMEnv s r ord n) f) => OrderedPolynomial r ord n -> f (V.Vector r)
image :: OrderedPolynomial r ord n -> f (Vector r)
image OrderedPolynomial r ord n
a = LensLike'
  (Const (Vector r))
  (FGLMEnv s r ord n)
  (OrderedPolynomial r ord n -> Vector r)
-> ((OrderedPolynomial r ord n -> Vector r) -> Vector r)
-> f (Vector r)
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike'
  (Const (Vector r))
  (FGLMEnv s r ord n)
  (OrderedPolynomial r ord n -> Vector r)
forall k s r (ord :: k) (n :: Nat).
Lens' (FGLMEnv s r ord n) (OrderedPolynomial r ord n -> Vector r)
lMap ((OrderedPolynomial r ord n -> Vector r)
-> OrderedPolynomial r ord n -> Vector r
forall a b. (a -> b) -> a -> b
$ OrderedPolynomial r ord n
a)