{- CAO Compiler
Copyright (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see . -}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-
Module : $Header$
Description : CAO Polynomials
Copyright : (C) 2014 Cryptography and Information Security Group, HASLab - INESC TEC and Universidade do Minho
License : GPL
Maintainer : Paulo Silva
Stability : experimental
Portability : non-portable ()
CAO Polynomials
-}
module Language.CAO.Common.Polynomial where
import Data.Foldable (Foldable)
import Data.List (intersperse, intercalate)
import Data.Maybe (catMaybes)
import Data.Traversable (Traversable)
import Language.CAO.Common.Outputable
import Language.CAO.Common.Representation
import Language.CAO.Common.Utils
import Language.CAO.Index
newtype Pol id = Pol { monomials :: [Mon id] }
deriving (Show, Read, Functor, Foldable, Traversable, Eq, Ord)
instance PP id => PP (Pol id) where
ppr = hsep . intersperse (char '+') . map ppr . monomials
instance PP id => StringRepresentation (Pol id) where
toString = intercalate "_" . map toString . monomials
-------------------------
-- Building polynomials
-------------------------
infixl 6 .+.
infixl 7 .*.
infixl 8 .^.
mon :: Mon id -> Pol id
mon (Mon (CoefP p) EZero) = p
mon m = Pol [m]
intC :: Integer -> MCoef id
intC i = CoefI (IInt i)
polC :: Pol id -> MCoef id
polC = CoefP
(.+.) :: Mon id -> Pol id -> Pol id
m .+. (Pol ms) = Pol (ms ++ [m])
(.*.) :: MCoef id -> MBase id -> Mon id
c .*. b = Mon c b
(.^.) :: id -> Integer -> MBase id
_ .^. 0 = EZero
n .^. i = MExpI n i
data Mon id = Mon !(MCoef id) !(MBase id)
deriving (Show, Read, Functor, Foldable, Traversable, Eq, Ord)
instance PP id => PP (Mon id) where
ppr = pprMon
pprMon :: PP id => Mon id -> CDoc
pprMon (Mon c EZero)
= ppr c
pprMon (Mon (CoefI (IInt 1)) b)
= ppr b
pprMon (Mon c b)
= ppr c <> char '*' <> ppr b
instance PP id => StringRepresentation (Mon id) where
toString = monStrRepresentation
monStrRepresentation :: PP id => Mon id -> String
monStrRepresentation m =
case m of
Mon (CoefI (IInt 1)) (MExpI i 1) -> showPpr i
Mon (CoefI (IInt c)) EZero -> intString c
Mon (CoefI c) EZero -> showPpr c
Mon (CoefI (IInt 1)) (MExpI i e) -> showPpr i ++ "_" ++ intString e
Mon (CoefI (IInt c)) (MExpI i 1) -> intString c ++ "_" ++ showPpr i
Mon (CoefI c) (MExpI i 1) -> showPpr c ++ "_" ++ showPpr i
Mon (CoefI (IInt c)) (MExpI i e) -> intString c ++ "_" ++ showPpr i ++ "_" ++ intString e
Mon (CoefI c) (MExpI i e) -> showPpr c ++ "_" ++ showPpr i ++ "_" ++ intString e
Mon (CoefP p) EZero -> "_" ++ toString p ++ "_"
Mon (CoefP p) (MExpI i 1) -> "_" ++ toString p ++ "_" ++ showPpr i
Mon (CoefP p) (MExpI i e) -> "_" ++ toString p ++ "_" ++ showPpr i ++ "_" ++ intString e
data MCoef id
= CoefI !(IExpr id)
| CoefP !(Pol id)
deriving (Show, Read, Functor, Foldable, Traversable, Eq)
instance Ord id => Ord (MCoef id) where
CoefI (IInt i) <= CoefI (IInt i') = i <= i'
CoefI _ <= CoefI _ = error "<>: non literal"
CoefP p <= CoefP p' = p <= p'
CoefI _ <= CoefP _ = True
_ <= _ = False
instance PP id => PP (MCoef id) where
ppr = pprMCoef
pprMCoef :: PP id => MCoef id -> CDoc
pprMCoef (CoefI i)
= ppr i
pprMCoef (CoefP pol)
= parens (ppr pol)
data MBase id
= EZero
| MExpI id Integer -- XXX: Symbolic exponent??
deriving (Show, Read, Functor, Foldable, Traversable, Eq, Ord)
instance PP id => PP (MBase id) where
ppr = pprMBase
pprMBase :: PP id => MBase id -> CDoc
pprMBase EZero = empty
pprMBase (MExpI n 1) = ppr n
pprMBase (MExpI n e) = ppr n <> text "**" <> integer e
-- * Auxiliary functions
-- XXX: Consider moving this to another module
degree :: Pol id -> Integer
degree (Pol []) = 0
degree (Pol ms) = maximum $ map polExp ms
where
polExp (Mon _ EZero) = 0
polExp (Mon _ (MExpI _ e)) = e
neg :: Mon id -> Mon id
neg (Mon (CoefI (IInt i)) e) = Mon (CoefI (IInt (-i))) e
neg (Mon (CoefI i) e) = Mon (CoefI (ISym i)) e
neg (Mon (CoefP (Pol p)) e) = Mon (CoefP $ Pol $ map neg p) e
coeficiente :: Mon id -> Pol id
coeficiente (Mon (CoefI c) _) = Pol [Mon (CoefI c) EZero]
coeficiente (Mon (CoefP p) _) = p
getMonVar :: Mon id -> Maybe id
getMonVar (Mon _ EZero) = Nothing
getMonVar (Mon _ (MExpI n _)) = Just n
getMonExp :: Mon id -> Integer
getMonExp (Mon _ EZero) = 0
getMonExp (Mon _ (MExpI _ e)) = e
polyToMono :: Maybe id -> Pol id -> Integer -> Maybe (Mon id)
polyToMono _ (Pol [Mon (CoefI (IInt 0)) EZero]) _ = Nothing
polyToMono (Just i) (Pol [Mon (CoefI c) EZero]) e =
Just $ Mon (CoefI c) (MExpI i e)
polyToMono (Just i) p e =
Just $ Mon (CoefP p) (MExpI i e)
polyToMono _ _ _ = error "::\
\ unexpected input"
normMonos :: [Maybe (Mon id)] -> [Mon id]
normMonos = ifM null (const [Mon (CoefI (IInt 0)) EZero]) reverse . catMaybes
isValid :: Eq id => [Mon id] -> Bool
isValid (m:ms) = checkPol_ (getMonVar m) (m:ms)
isValid _ = False
checkPol_ :: Eq id => Maybe id -> [Mon id] -> Bool
checkPol_ ind [m]
= (getMonVar m == Nothing && getMonExp m == 0) || getMonVar m == ind
checkPol_ ind (m1:m0:ms)
= (getMonExp m1 > getMonExp m0)
&& (getMonVar m1 == ind)
&& checkMon_ m1
&& checkPol_ ind (m0:ms)
checkPol_ _ _ = error ":: \
\ unexpected empty list of monomials"
checkMon_ :: Eq id => Mon id -> Bool
checkMon_ (Mon (CoefI _) _) = True
checkMon_ (Mon (CoefP p) _) = isValid (monomials p)