{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}

module Algebra.Bridge.Singular.Syntax
  ( SingularOrder (..),
    SingularCoeff (..),
    IsSingularPolynomial,
    SingularExpr (..),
    RingSpec (..),
    SingularLibrary,
    SingularOption,
    RingCoeffSpec (..),
    toRingSpec,
    PrettySingular (..),
    prettySingularPolynomial,
    funE,
    coeffE,
    polyE,
    binE,
    listE,
    idealE,
    idealE',
    verbE,
    varE,
    SingularCommand (..),
    SingularType (..),
    SingularProgramM (..),
    SingularProgram,
    exprC,
    declOnlyC,
    declC,
    letC,
    idealC',
    idealC,
    ringC,
    polyC,
    libC,
    optionC,
    printC,
    directC,
  )
where

import Algebra.Field.Prime
import Algebra.Internal
import Algebra.Prelude.Core
import Algebra.Ring.Polynomial.Parser
import Control.Monad.Trans.Writer
import Data.List ()
import qualified Data.Semigroup as Semi
import qualified Data.Text as T
import GHC.TypeNats (natVal)
import qualified Prelude as P

type SingularLibrary = Text

class IsMonomialOrder n ord => SingularOrder n ord where
  singularOrder :: q n -> p ord -> Text

instance KnownNat n => SingularOrder n Lex where
  singularOrder :: q n -> p Lex -> Text
singularOrder q n
_ p Lex
_ = Text
"lp"

instance KnownNat n => SingularOrder n Grevlex where
  singularOrder :: q n -> p Grevlex -> Text
singularOrder q n
_ p Grevlex
_ = Text
"dp"

instance
  (SingularOrder n o1, SingularOrder m o2, KnownNat m, KnownNat n, (n + m) ~ k) =>
  SingularOrder k (ProductOrder n m o1 o2)
  where
  singularOrder :: q k -> p (ProductOrder n m o1 o2) -> Text
singularOrder q k
_ p (ProductOrder n m o1 o2)
_ =
    let (SNat n
sn, SNat m
sm) = (SNat n
forall (n :: Nat). KnownNat n => SNat n
sNat :: SNat n, SNat m
forall (n :: Nat). KnownNat n => SNat n
sNat :: SNat m)
     in [Text] -> Text
T.concat
          [ Text
"("
          , SNat n -> Proxy o1 -> Text
forall (n :: Nat) ord (q :: Nat -> *) (p :: * -> *).
SingularOrder n ord =>
q n -> p ord -> Text
singularOrder SNat n
sn (Proxy o1
forall k (t :: k). Proxy t
Proxy :: Proxy o1)
          , Text
"("
          , Natural -> Text
forall a. Show a => a -> Text
tshow (SNat n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal SNat n
sn)
          , Text
"),"
          , SNat m -> Proxy o2 -> Text
forall (n :: Nat) ord (q :: Nat -> *) (p :: * -> *).
SingularOrder n ord =>
q n -> p ord -> Text
singularOrder SNat m
sm (Proxy o2
forall k (t :: k). Proxy t
Proxy :: Proxy o2)
          , Text
"("
          , Natural -> Text
forall a. Show a => a -> Text
tshow (SNat m -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal SNat m
sm)
          , Text
"))"
          ]

class (PrettyCoeff r, CoeffRing r) => SingularCoeff r where
  parseSingularCoeff :: Parser r

  prettySingularCoeff :: Int -> r -> ShowSCoeff
  prettySingularCoeff = Int -> r -> ShowSCoeff
forall r. PrettyCoeff r => Int -> r -> ShowSCoeff
showsCoeff

  coeffType :: proxy r -> RingCoeffSpec

instance SingularCoeff Rational where
  parseSingularCoeff :: Parser Rational
parseSingularCoeff = Parser Rational
forall k. Field k => Parser k
rationalP

  coeffType :: proxy Rational -> RingCoeffSpec
coeffType proxy Rational
_ = Natural -> RingCoeffSpec
Char Natural
0

  prettySingularCoeff :: Int -> Rational -> ShowSCoeff
prettySingularCoeff Int
_ = Rational -> ShowSCoeff
prettyRat

prettyRat :: Rational -> ShowSCoeff
prettyRat :: Rational -> ShowSCoeff
prettyRat Rational
r
  | Rational
r Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 = ShowSCoeff
Vanished
  | Rational
r Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
1 = ShowSCoeff
OneCoeff
  | Rational
r Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== -Rational
1 = Maybe ShowS -> ShowSCoeff
Negative Maybe ShowS
forall a. Maybe a
Nothing
  | Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 =
    Maybe ShowS -> ShowSCoeff
Negative (Maybe ShowS -> ShowSCoeff) -> Maybe ShowS -> ShowSCoeff
forall a b. (a -> b) -> a -> b
$
      ShowS -> Maybe ShowS
forall a. a -> Maybe a
Just (ShowS -> Maybe ShowS) -> ShowS -> Maybe ShowS
forall a b. (a -> b) -> a -> b
$
        Bool -> ShowS -> ShowS
showParen Bool
True (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          Integer -> ShowS
forall a. Show a => a -> ShowS
shows (Integer -> Integer
forall a. Num a => a -> a
abs (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall t. Fraction t -> t
numerator Rational
r) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'/' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows (Integer -> Integer
forall a. Num a => a -> a
abs (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall t. Fraction t -> t
denominator Rational
r)
  | Bool
otherwise =
    ShowS -> ShowSCoeff
Positive (ShowS -> ShowSCoeff) -> ShowS -> ShowSCoeff
forall a b. (a -> b) -> a -> b
$
      Integer -> ShowS
forall a. Show a => a -> ShowS
shows (Integer -> Integer
forall a. Num a => a -> a
abs (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall t. Fraction t -> t
numerator Rational
r) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'/' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Show a => a -> ShowS
shows (Integer -> Integer
forall a. Num a => a -> a
abs (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall t. Fraction t -> t
denominator Rational
r)

instance SingularCoeff Integer where
  parseSingularCoeff :: Parser Integer
parseSingularCoeff = Parser Integer
integerP

  coeffType :: proxy Integer -> RingCoeffSpec
coeffType proxy Integer
_ = RingCoeffSpec
IntegerCoeff

instance KnownNat p => SingularCoeff (F p) where
  parseSingularCoeff :: Parser (F p)
parseSingularCoeff = Parser (F p)
forall k. Field k => Parser k
rationalP

  coeffType :: proxy (F p) -> RingCoeffSpec
coeffType = Natural -> RingCoeffSpec
Char (Natural -> RingCoeffSpec)
-> (proxy (F p) -> Natural) -> proxy (F p) -> RingCoeffSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy (F p) -> Natural
forall r (proxy :: * -> *). Characteristic r => proxy r -> Natural
char

-- | Polynomial type which can be encoded to/decoded from singular polynomials.
type IsSingularPolynomial poly =
  (IsOrderedPolynomial poly, SingularCoeff (Coefficient poly), SingularOrder (Arity poly) (MOrder poly))

data SingularExpr poly where
  SingVar :: Text -> SingularExpr poly
  SingFunction :: Text -> [SingularExpr poly] -> SingularExpr poly
  SingInfix :: SingularExpr poly -> Text -> SingularExpr poly -> SingularExpr poly
  SingList :: [SingularExpr poly] -> SingularExpr poly
  SingIdeal :: [SingularExpr poly] -> SingularExpr poly
  SingPolynomial :: poly -> SingularExpr poly
  SingCoeff :: Coefficient poly -> SingularExpr poly
  SingVerbatim :: Text -> SingularExpr poly
  SingRing :: RingSpec -> SingularExpr poly

data RingCoeffSpec
  = RealCoeff
  | ComplexCoeff
  | IntegerCoeff
  | Char Natural
  deriving (ReadPrec [RingCoeffSpec]
ReadPrec RingCoeffSpec
Int -> ReadS RingCoeffSpec
ReadS [RingCoeffSpec]
(Int -> ReadS RingCoeffSpec)
-> ReadS [RingCoeffSpec]
-> ReadPrec RingCoeffSpec
-> ReadPrec [RingCoeffSpec]
-> Read RingCoeffSpec
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RingCoeffSpec]
$creadListPrec :: ReadPrec [RingCoeffSpec]
readPrec :: ReadPrec RingCoeffSpec
$creadPrec :: ReadPrec RingCoeffSpec
readList :: ReadS [RingCoeffSpec]
$creadList :: ReadS [RingCoeffSpec]
readsPrec :: Int -> ReadS RingCoeffSpec
$creadsPrec :: Int -> ReadS RingCoeffSpec
Read, Int -> RingCoeffSpec -> ShowS
[RingCoeffSpec] -> ShowS
RingCoeffSpec -> String
(Int -> RingCoeffSpec -> ShowS)
-> (RingCoeffSpec -> String)
-> ([RingCoeffSpec] -> ShowS)
-> Show RingCoeffSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RingCoeffSpec] -> ShowS
$cshowList :: [RingCoeffSpec] -> ShowS
show :: RingCoeffSpec -> String
$cshow :: RingCoeffSpec -> String
showsPrec :: Int -> RingCoeffSpec -> ShowS
$cshowsPrec :: Int -> RingCoeffSpec -> ShowS
Show, RingCoeffSpec -> RingCoeffSpec -> Bool
(RingCoeffSpec -> RingCoeffSpec -> Bool)
-> (RingCoeffSpec -> RingCoeffSpec -> Bool) -> Eq RingCoeffSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RingCoeffSpec -> RingCoeffSpec -> Bool
$c/= :: RingCoeffSpec -> RingCoeffSpec -> Bool
== :: RingCoeffSpec -> RingCoeffSpec -> Bool
$c== :: RingCoeffSpec -> RingCoeffSpec -> Bool
Eq, Eq RingCoeffSpec
Eq RingCoeffSpec
-> (RingCoeffSpec -> RingCoeffSpec -> Ordering)
-> (RingCoeffSpec -> RingCoeffSpec -> Bool)
-> (RingCoeffSpec -> RingCoeffSpec -> Bool)
-> (RingCoeffSpec -> RingCoeffSpec -> Bool)
-> (RingCoeffSpec -> RingCoeffSpec -> Bool)
-> (RingCoeffSpec -> RingCoeffSpec -> RingCoeffSpec)
-> (RingCoeffSpec -> RingCoeffSpec -> RingCoeffSpec)
-> Ord RingCoeffSpec
RingCoeffSpec -> RingCoeffSpec -> Bool
RingCoeffSpec -> RingCoeffSpec -> Ordering
RingCoeffSpec -> RingCoeffSpec -> RingCoeffSpec
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RingCoeffSpec -> RingCoeffSpec -> RingCoeffSpec
$cmin :: RingCoeffSpec -> RingCoeffSpec -> RingCoeffSpec
max :: RingCoeffSpec -> RingCoeffSpec -> RingCoeffSpec
$cmax :: RingCoeffSpec -> RingCoeffSpec -> RingCoeffSpec
>= :: RingCoeffSpec -> RingCoeffSpec -> Bool
$c>= :: RingCoeffSpec -> RingCoeffSpec -> Bool
> :: RingCoeffSpec -> RingCoeffSpec -> Bool
$c> :: RingCoeffSpec -> RingCoeffSpec -> Bool
<= :: RingCoeffSpec -> RingCoeffSpec -> Bool
$c<= :: RingCoeffSpec -> RingCoeffSpec -> Bool
< :: RingCoeffSpec -> RingCoeffSpec -> Bool
$c< :: RingCoeffSpec -> RingCoeffSpec -> Bool
compare :: RingCoeffSpec -> RingCoeffSpec -> Ordering
$ccompare :: RingCoeffSpec -> RingCoeffSpec -> Ordering
$cp1Ord :: Eq RingCoeffSpec
Ord)

data RingSpec where
  RingSpec ::
    SingularOrder n ord =>
    RingCoeffSpec ->
    SNat n ->
    proxy ord ->
    RingSpec

coeffProxy :: proxy poly -> Proxy (Coefficient poly)
coeffProxy :: proxy poly -> Proxy (Coefficient poly)
coeffProxy proxy poly
_ = Proxy (Coefficient poly)
forall k (t :: k). Proxy t
Proxy

morderProxy :: proxy poly -> Proxy (MOrder poly)
morderProxy :: proxy poly -> Proxy (MOrder poly)
morderProxy proxy poly
_ = Proxy (MOrder poly)
forall k (t :: k). Proxy t
Proxy

toRingSpec :: IsSingularPolynomial poly => proxy poly -> RingSpec
toRingSpec :: proxy poly -> RingSpec
toRingSpec proxy poly
pxy =
  RingCoeffSpec
-> SNat (Arity poly) -> Proxy (MOrder poly) -> RingSpec
forall (n :: Nat) ord (proxy :: * -> *).
SingularOrder n ord =>
RingCoeffSpec -> SNat n -> proxy ord -> RingSpec
RingSpec (Proxy (Coefficient poly) -> RingCoeffSpec
forall r (proxy :: * -> *).
SingularCoeff r =>
proxy r -> RingCoeffSpec
coeffType (Proxy (Coefficient poly) -> RingCoeffSpec)
-> Proxy (Coefficient poly) -> RingCoeffSpec
forall a b. (a -> b) -> a -> b
$ proxy poly -> Proxy (Coefficient poly)
forall (proxy :: * -> *) poly.
proxy poly -> Proxy (Coefficient poly)
coeffProxy proxy poly
pxy) (proxy poly -> SNat (Arity poly)
forall poly (proxy :: * -> *).
IsPolynomial poly =>
proxy poly -> SNat (Arity poly)
sArity proxy poly
pxy) (proxy poly -> Proxy (MOrder poly)
forall (proxy :: * -> *) poly. proxy poly -> Proxy (MOrder poly)
morderProxy proxy poly
pxy)

class PrettySingular a where
  prettySingular :: a -> Text

prettySingularPolynomial ::
  (IsSingularPolynomial poly) =>
  poly ->
  Text
prettySingularPolynomial :: poly -> Text
prettySingularPolynomial =
  let vs :: Sized f n String
vs = SNat n -> (Ordinal n -> String) -> Sized f n String
forall (f :: * -> *) (n :: Nat) a.
(CFreeMonoid f, Dom f a) =>
SNat n -> (Ordinal n -> a) -> Sized f n a
generate SNat n
forall (n :: Nat). KnownNat n => SNat n
sNat ((Ordinal n -> String) -> Sized f n String)
-> (Ordinal n -> String) -> Sized f n String
forall a b. (a -> b) -> a -> b
$ \Ordinal n
i -> String
"x(" String -> ShowS
forall w. Monoid w => w -> w -> w
++ Natural -> String
forall a. Show a => a -> String
show (Ordinal n -> Natural
forall (n :: Nat). Ordinal n -> Natural
ordToNatural Ordinal n
i) String -> ShowS
forall w. Monoid w => w -> w -> w
++ String
")"
   in String -> Text
T.pack (String -> Text) -> (poly -> String) -> poly -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool
-> (Int -> Coefficient poly -> ShowSCoeff)
-> Sized (Arity poly) String
-> Int
-> poly
-> String
forall poly.
IsOrderedPolynomial poly =>
Bool
-> (Int -> Coefficient poly -> ShowSCoeff)
-> Sized (Arity poly) String
-> Int
-> poly
-> String
showPolynomialWith' Bool
True Int -> Coefficient poly -> ShowSCoeff
forall r. SingularCoeff r => Int -> r -> ShowSCoeff
prettySingularCoeff Sized (Arity poly) String
forall (f :: * -> *) (n :: Nat).
(Dom f String, CFreeMonoid f, KnownNat n) =>
Sized f n String
vs Int
5

instance
  IsSingularPolynomial poly =>
  PrettySingular (SingularExpr poly)
  where
  prettySingular :: SingularExpr poly -> Text
prettySingular (SingFunction Text
fun [SingularExpr poly]
args) =
    [Text] -> Text
T.concat
      [ Text
fun
      , Text
"("
      , Text -> [Text] -> Text
T.intercalate Text
" , " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (SingularExpr poly -> Text) -> [SingularExpr poly] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SingularExpr poly -> Text
forall a. PrettySingular a => a -> Text
prettySingular [SingularExpr poly]
args
      , Text
")"
      ]
  prettySingular (SingPolynomial poly
f) = poly -> Text
forall poly. IsSingularPolynomial poly => poly -> Text
prettySingularPolynomial poly
f
  prettySingular (SingCoeff Coefficient poly
c) = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowSCoeff -> ShowS
showsCoeffAsTerm (Int -> Coefficient poly -> ShowSCoeff
forall r. SingularCoeff r => Int -> r -> ShowSCoeff
prettySingularCoeff Int
5 Coefficient poly
c) String
""
  prettySingular (SingVerbatim Text
src) = Text
src
  prettySingular (SingIdeal [SingularExpr poly]
args) =
    [Text] -> Text
T.concat [Text
"ideal(", Text -> [Text] -> Text
T.intercalate Text
" , " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (SingularExpr poly -> Text) -> [SingularExpr poly] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SingularExpr poly -> Text
forall a. PrettySingular a => a -> Text
prettySingular [SingularExpr poly]
args, Text
")"]
  prettySingular (SingList [SingularExpr poly]
args) =
    [Text] -> Text
T.concat [Text
"list(", Text -> [Text] -> Text
T.intercalate Text
" , " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (SingularExpr poly -> Text) -> [SingularExpr poly] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SingularExpr poly -> Text
forall a. PrettySingular a => a -> Text
prettySingular [SingularExpr poly]
args, Text
")"]
  prettySingular (SingInfix SingularExpr poly
l Text
t SingularExpr poly
r) =
    [Text] -> Text
T.concat [Text
"((", SingularExpr poly -> Text
forall a. PrettySingular a => a -> Text
prettySingular SingularExpr poly
l, Text
") ", Text
t, Text
" (", SingularExpr poly -> Text
forall a. PrettySingular a => a -> Text
prettySingular SingularExpr poly
r, Text
"))"]
  prettySingular (SingRing RingSpec
r) = RingSpec -> Text
forall a. PrettySingular a => a -> Text
prettySingular RingSpec
r
  prettySingular (SingVar Text
v) = Text
v

instance PrettySingular RingCoeffSpec where
  prettySingular :: RingCoeffSpec -> Text
prettySingular RingCoeffSpec
RealCoeff = Text
"real"
  prettySingular RingCoeffSpec
ComplexCoeff = Text
"complex"
  prettySingular RingCoeffSpec
IntegerCoeff = Text
"integer"
  prettySingular (Char Natural
p) = Natural -> Text
forall a. Show a => a -> Text
tshow Natural
p

instance PrettySingular RingSpec where
  prettySingular :: RingSpec -> Text
prettySingular (RingSpec RingCoeffSpec
coe SNat n
vs proxy ord
ord) =
    SNat n -> (KnownNat n => Text) -> Text
forall (n :: Nat) r. SNat n -> (KnownNat n => r) -> r
withKnownNat SNat n
vs ((KnownNat n => Text) -> Text) -> (KnownNat n => Text) -> Text
forall a b. (a -> b) -> a -> b
$
      [Text] -> Text
T.concat
        [ Text
"("
        , RingCoeffSpec -> Text
forall a. PrettySingular a => a -> Text
prettySingular RingCoeffSpec
coe
        , Text
"),(x(0.."
        , Natural -> Text
forall a. Show a => a -> Text
tshow (SNat n -> Natural
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Natural
natVal SNat n
vs Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
P.- Natural
1)
        , Text
")),"
        , SNat n -> proxy ord -> Text
forall (n :: Nat) ord (q :: Nat -> *) (p :: * -> *).
SingularOrder n ord =>
q n -> p ord -> Text
singularOrder SNat n
vs proxy ord
ord
        ]

instance Num (Coefficient poly) => Num (SingularExpr poly) where
  fromInteger :: Integer -> SingularExpr poly
fromInteger = Coefficient poly -> SingularExpr poly
forall poly. Coefficient poly -> SingularExpr poly
SingCoeff (Coefficient poly -> SingularExpr poly)
-> (Integer -> Coefficient poly) -> Integer -> SingularExpr poly
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coefficient poly
forall a. Num a => Integer -> a
P.fromInteger
  + :: SingularExpr poly -> SingularExpr poly -> SingularExpr poly
(+) = Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
forall poly.
Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
binE Text
"+"
  * :: SingularExpr poly -> SingularExpr poly -> SingularExpr poly
(*) = Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
forall poly.
Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
binE Text
"*"
  (-) = Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
forall poly.
Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
binE Text
"-"
  abs :: SingularExpr poly -> SingularExpr poly
abs SingularExpr poly
x = Text -> [SingularExpr poly] -> SingularExpr poly
forall poly. Text -> [SingularExpr poly] -> SingularExpr poly
funE Text
"absValue" [SingularExpr poly
x]
  signum :: SingularExpr poly -> SingularExpr poly
signum = String -> SingularExpr poly -> SingularExpr poly
forall a. HasCallStack => String -> a
error String
"No signum!"

instance Multiplicative (SingularExpr poly) where
  * :: SingularExpr poly -> SingularExpr poly -> SingularExpr poly
(*) = Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
forall poly.
Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
binE Text
"*"

instance Additive (SingularExpr poly) where
  + :: SingularExpr poly -> SingularExpr poly -> SingularExpr poly
(+) = Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
forall poly.
Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
binE Text
"+"

instance Unital (Coefficient poly) => Unital (SingularExpr poly) where
  one :: SingularExpr poly
one = Coefficient poly -> SingularExpr poly
forall poly. Coefficient poly -> SingularExpr poly
coeffE Coefficient poly
forall r. Unital r => r
one

funE :: Text -> [SingularExpr poly] -> SingularExpr poly
funE :: Text -> [SingularExpr poly] -> SingularExpr poly
funE = Text -> [SingularExpr poly] -> SingularExpr poly
forall poly. Text -> [SingularExpr poly] -> SingularExpr poly
SingFunction

polyE :: poly -> SingularExpr poly
polyE :: poly -> SingularExpr poly
polyE = poly -> SingularExpr poly
forall poly. poly -> SingularExpr poly
SingPolynomial

coeffE :: Coefficient poly -> SingularExpr poly
coeffE :: Coefficient poly -> SingularExpr poly
coeffE = Coefficient poly -> SingularExpr poly
forall poly. Coefficient poly -> SingularExpr poly
SingCoeff

listE :: [SingularExpr poly] -> SingularExpr poly
listE :: [SingularExpr poly] -> SingularExpr poly
listE = [SingularExpr poly] -> SingularExpr poly
forall poly. [SingularExpr poly] -> SingularExpr poly
SingList

idealE' :: Ideal poly -> SingularExpr poly
idealE' :: Ideal poly -> SingularExpr poly
idealE' = [SingularExpr poly] -> SingularExpr poly
forall poly. [SingularExpr poly] -> SingularExpr poly
SingIdeal ([SingularExpr poly] -> SingularExpr poly)
-> (Ideal poly -> [SingularExpr poly])
-> Ideal poly
-> SingularExpr poly
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (poly -> SingularExpr poly) -> [poly] -> [SingularExpr poly]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map poly -> SingularExpr poly
forall poly. poly -> SingularExpr poly
SingPolynomial ([poly] -> [SingularExpr poly])
-> (Ideal poly -> [poly]) -> Ideal poly -> [SingularExpr poly]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ideal poly -> [poly]
forall r. Ideal r -> [r]
generators

idealE :: [SingularExpr poly] -> SingularExpr poly
idealE :: [SingularExpr poly] -> SingularExpr poly
idealE = [SingularExpr poly] -> SingularExpr poly
forall poly. [SingularExpr poly] -> SingularExpr poly
SingIdeal

binE :: Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
binE :: Text -> SingularExpr poly -> SingularExpr poly -> SingularExpr poly
binE Text
op SingularExpr poly
l = SingularExpr poly -> Text -> SingularExpr poly -> SingularExpr poly
forall poly.
SingularExpr poly -> Text -> SingularExpr poly -> SingularExpr poly
SingInfix SingularExpr poly
l Text
op

verbE :: Text -> SingularExpr poly
verbE :: Text -> SingularExpr poly
verbE = Text -> SingularExpr poly
forall poly. Text -> SingularExpr poly
SingVerbatim

varE :: Text -> SingularExpr poly
varE :: Text -> SingularExpr poly
varE = Text -> SingularExpr poly
forall poly. Text -> SingularExpr poly
SingVar

data SingularType
  = IdealT
  | IntT
  | RingT
  | PolyT
  | OtherT Text
  deriving (ReadPrec [SingularType]
ReadPrec SingularType
Int -> ReadS SingularType
ReadS [SingularType]
(Int -> ReadS SingularType)
-> ReadS [SingularType]
-> ReadPrec SingularType
-> ReadPrec [SingularType]
-> Read SingularType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SingularType]
$creadListPrec :: ReadPrec [SingularType]
readPrec :: ReadPrec SingularType
$creadPrec :: ReadPrec SingularType
readList :: ReadS [SingularType]
$creadList :: ReadS [SingularType]
readsPrec :: Int -> ReadS SingularType
$creadsPrec :: Int -> ReadS SingularType
Read, Int -> SingularType -> ShowS
[SingularType] -> ShowS
SingularType -> String
(Int -> SingularType -> ShowS)
-> (SingularType -> String)
-> ([SingularType] -> ShowS)
-> Show SingularType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SingularType] -> ShowS
$cshowList :: [SingularType] -> ShowS
show :: SingularType -> String
$cshow :: SingularType -> String
showsPrec :: Int -> SingularType -> ShowS
$cshowsPrec :: Int -> SingularType -> ShowS
Show, SingularType -> SingularType -> Bool
(SingularType -> SingularType -> Bool)
-> (SingularType -> SingularType -> Bool) -> Eq SingularType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SingularType -> SingularType -> Bool
$c/= :: SingularType -> SingularType -> Bool
== :: SingularType -> SingularType -> Bool
$c== :: SingularType -> SingularType -> Bool
Eq, Eq SingularType
Eq SingularType
-> (SingularType -> SingularType -> Ordering)
-> (SingularType -> SingularType -> Bool)
-> (SingularType -> SingularType -> Bool)
-> (SingularType -> SingularType -> Bool)
-> (SingularType -> SingularType -> Bool)
-> (SingularType -> SingularType -> SingularType)
-> (SingularType -> SingularType -> SingularType)
-> Ord SingularType
SingularType -> SingularType -> Bool
SingularType -> SingularType -> Ordering
SingularType -> SingularType -> SingularType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SingularType -> SingularType -> SingularType
$cmin :: SingularType -> SingularType -> SingularType
max :: SingularType -> SingularType -> SingularType
$cmax :: SingularType -> SingularType -> SingularType
>= :: SingularType -> SingularType -> Bool
$c>= :: SingularType -> SingularType -> Bool
> :: SingularType -> SingularType -> Bool
$c> :: SingularType -> SingularType -> Bool
<= :: SingularType -> SingularType -> Bool
$c<= :: SingularType -> SingularType -> Bool
< :: SingularType -> SingularType -> Bool
$c< :: SingularType -> SingularType -> Bool
compare :: SingularType -> SingularType -> Ordering
$ccompare :: SingularType -> SingularType -> Ordering
$cp1Ord :: Eq SingularType
Ord)

data SingularCommand where
  SingExpr ::
    IsSingularPolynomial poly =>
    SingularExpr poly ->
    SingularCommand
  SingDeclOnly :: SingularType -> Text -> SingularCommand
  SingDeclAssign ::
    IsSingularPolynomial poly =>
    SingularType ->
    Text ->
    SingularExpr poly ->
    SingularCommand
  SingAssign ::
    IsSingularPolynomial poly =>
    Text ->
    SingularExpr poly ->
    SingularCommand
  SingLibrary :: Text -> SingularCommand
  SingVerbD :: Text -> SingularCommand
  Directive :: Text -> SingularCommand

newtype SingularProgramM a = SingularProgramM (Writer [SingularCommand] a)
  deriving (a -> SingularProgramM b -> SingularProgramM a
(a -> b) -> SingularProgramM a -> SingularProgramM b
(forall a b. (a -> b) -> SingularProgramM a -> SingularProgramM b)
-> (forall a b. a -> SingularProgramM b -> SingularProgramM a)
-> Functor SingularProgramM
forall a b. a -> SingularProgramM b -> SingularProgramM a
forall a b. (a -> b) -> SingularProgramM a -> SingularProgramM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SingularProgramM b -> SingularProgramM a
$c<$ :: forall a b. a -> SingularProgramM b -> SingularProgramM a
fmap :: (a -> b) -> SingularProgramM a -> SingularProgramM b
$cfmap :: forall a b. (a -> b) -> SingularProgramM a -> SingularProgramM b
Functor, Functor SingularProgramM
a -> SingularProgramM a
Functor SingularProgramM
-> (forall a. a -> SingularProgramM a)
-> (forall a b.
    SingularProgramM (a -> b)
    -> SingularProgramM a -> SingularProgramM b)
-> (forall a b c.
    (a -> b -> c)
    -> SingularProgramM a -> SingularProgramM b -> SingularProgramM c)
-> (forall a b.
    SingularProgramM a -> SingularProgramM b -> SingularProgramM b)
-> (forall a b.
    SingularProgramM a -> SingularProgramM b -> SingularProgramM a)
-> Applicative SingularProgramM
SingularProgramM a -> SingularProgramM b -> SingularProgramM b
SingularProgramM a -> SingularProgramM b -> SingularProgramM a
SingularProgramM (a -> b)
-> SingularProgramM a -> SingularProgramM b
(a -> b -> c)
-> SingularProgramM a -> SingularProgramM b -> SingularProgramM c
forall a. a -> SingularProgramM a
forall a b.
SingularProgramM a -> SingularProgramM b -> SingularProgramM a
forall a b.
SingularProgramM a -> SingularProgramM b -> SingularProgramM b
forall a b.
SingularProgramM (a -> b)
-> SingularProgramM a -> SingularProgramM b
forall a b c.
(a -> b -> c)
-> SingularProgramM a -> SingularProgramM b -> SingularProgramM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SingularProgramM a -> SingularProgramM b -> SingularProgramM a
$c<* :: forall a b.
SingularProgramM a -> SingularProgramM b -> SingularProgramM a
*> :: SingularProgramM a -> SingularProgramM b -> SingularProgramM b
$c*> :: forall a b.
SingularProgramM a -> SingularProgramM b -> SingularProgramM b
liftA2 :: (a -> b -> c)
-> SingularProgramM a -> SingularProgramM b -> SingularProgramM c
$cliftA2 :: forall a b c.
(a -> b -> c)
-> SingularProgramM a -> SingularProgramM b -> SingularProgramM c
<*> :: SingularProgramM (a -> b)
-> SingularProgramM a -> SingularProgramM b
$c<*> :: forall a b.
SingularProgramM (a -> b)
-> SingularProgramM a -> SingularProgramM b
pure :: a -> SingularProgramM a
$cpure :: forall a. a -> SingularProgramM a
$cp1Applicative :: Functor SingularProgramM
Applicative, Applicative SingularProgramM
a -> SingularProgramM a
Applicative SingularProgramM
-> (forall a b.
    SingularProgramM a
    -> (a -> SingularProgramM b) -> SingularProgramM b)
-> (forall a b.
    SingularProgramM a -> SingularProgramM b -> SingularProgramM b)
-> (forall a. a -> SingularProgramM a)
-> Monad SingularProgramM
SingularProgramM a
-> (a -> SingularProgramM b) -> SingularProgramM b
SingularProgramM a -> SingularProgramM b -> SingularProgramM b
forall a. a -> SingularProgramM a
forall a b.
SingularProgramM a -> SingularProgramM b -> SingularProgramM b
forall a b.
SingularProgramM a
-> (a -> SingularProgramM b) -> SingularProgramM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SingularProgramM a
$creturn :: forall a. a -> SingularProgramM a
>> :: SingularProgramM a -> SingularProgramM b -> SingularProgramM b
$c>> :: forall a b.
SingularProgramM a -> SingularProgramM b -> SingularProgramM b
>>= :: SingularProgramM a
-> (a -> SingularProgramM b) -> SingularProgramM b
$c>>= :: forall a b.
SingularProgramM a
-> (a -> SingularProgramM b) -> SingularProgramM b
$cp1Monad :: Applicative SingularProgramM
Monad)

type SingularProgram = SingularProgramM ()

instance Semi.Semigroup (SingularProgramM a) where
  (SingularProgramM Writer [SingularCommand] a
l) <> :: SingularProgramM a -> SingularProgramM a -> SingularProgramM a
<> (SingularProgramM Writer [SingularCommand] a
r) = Writer [SingularCommand] a -> SingularProgramM a
forall a. Writer [SingularCommand] a -> SingularProgramM a
SingularProgramM (Writer [SingularCommand] a -> SingularProgramM a)
-> Writer [SingularCommand] a -> SingularProgramM a
forall a b. (a -> b) -> a -> b
$ Writer [SingularCommand] a
l Writer [SingularCommand] a
-> Writer [SingularCommand] a -> Writer [SingularCommand] a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Writer [SingularCommand] a
r

instance a ~ () => Monoid (SingularProgramM a) where
  mempty :: SingularProgramM a
mempty = Writer [SingularCommand] () -> SingularProgramM ()
forall a. Writer [SingularCommand] a -> SingularProgramM a
SingularProgramM (Writer [SingularCommand] () -> SingularProgramM ())
-> Writer [SingularCommand] () -> SingularProgramM ()
forall a b. (a -> b) -> a -> b
$ () -> Writer [SingularCommand] ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  mappend :: SingularProgramM a -> SingularProgramM a -> SingularProgramM a
mappend (SingularProgramM Writer [SingularCommand] a
l) (SingularProgramM Writer [SingularCommand] a
r) = Writer [SingularCommand] a -> SingularProgramM a
forall a. Writer [SingularCommand] a -> SingularProgramM a
SingularProgramM (Writer [SingularCommand] a -> SingularProgramM a)
-> Writer [SingularCommand] a -> SingularProgramM a
forall a b. (a -> b) -> a -> b
$ Writer [SingularCommand] a
l Writer [SingularCommand] a
-> Writer [SingularCommand] a -> Writer [SingularCommand] a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Writer [SingularCommand] a
r

instance PrettySingular SingularType where
  prettySingular :: SingularType -> Text
prettySingular SingularType
IdealT = Text
"ideal"
  prettySingular SingularType
IntT = Text
"int"
  prettySingular SingularType
RingT = Text
"ring"
  prettySingular SingularType
PolyT = Text
"poly"
  prettySingular (OtherT Text
t) = Text
t

instance PrettySingular SingularCommand where
  prettySingular :: SingularCommand -> Text
prettySingular = (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";") (Text -> Text)
-> (SingularCommand -> Text) -> SingularCommand -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingularCommand -> Text
go
    where
      go :: SingularCommand -> Text
go (SingLibrary Text
lib) = [Text] -> Text
T.concat [Text
"LIB", Text
" \"", Text
lib, Text
"\""]
      go (SingVerbD Text
t) = Text
t
      go (Directive Text
t) = Text
t
      go (SingExpr SingularExpr poly
expr) = SingularExpr poly -> Text
forall a. PrettySingular a => a -> Text
prettySingular SingularExpr poly
expr
      go (SingDeclOnly SingularType
typ Text
val) =
        [Text] -> Text
T.unwords [SingularType -> Text
forall a. PrettySingular a => a -> Text
prettySingular SingularType
typ, Text
val]
      go (SingDeclAssign SingularType
typ Text
val SingularExpr poly
expr) =
        [Text] -> Text
T.unwords [SingularType -> Text
forall a. PrettySingular a => a -> Text
prettySingular SingularType
typ, Text
val, Text
"=", SingularExpr poly -> Text
forall a. PrettySingular a => a -> Text
prettySingular SingularExpr poly
expr]
      go (SingAssign Text
val SingularExpr poly
expr) =
        [Text] -> Text
T.unwords [Text
val, Text
"=", SingularExpr poly -> Text
forall a. PrettySingular a => a -> Text
prettySingular SingularExpr poly
expr]

instance a ~ () => PrettySingular (SingularProgramM a) where
  prettySingular :: SingularProgramM a -> Text
prettySingular (SingularProgramM Writer [SingularCommand] a
act) =
    [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (SingularCommand -> Text) -> [SingularCommand] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SingularCommand -> Text
forall a. PrettySingular a => a -> Text
prettySingular ([SingularCommand] -> [Text]) -> [SingularCommand] -> [Text]
forall a b. (a -> b) -> a -> b
$ Writer [SingularCommand] a -> [SingularCommand]
forall w a. Writer w a -> w
execWriter Writer [SingularCommand] a
act

exprC :: (IsSingularPolynomial poly) => SingularExpr poly -> SingularProgram
exprC :: SingularExpr poly -> SingularProgramM ()
exprC = Writer [SingularCommand] () -> SingularProgramM ()
forall a. Writer [SingularCommand] a -> SingularProgramM a
SingularProgramM (Writer [SingularCommand] () -> SingularProgramM ())
-> (SingularExpr poly -> Writer [SingularCommand] ())
-> SingularExpr poly
-> SingularProgramM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SingularCommand] -> Writer [SingularCommand] ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ([SingularCommand] -> Writer [SingularCommand] ())
-> (SingularExpr poly -> [SingularCommand])
-> SingularExpr poly
-> Writer [SingularCommand] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingularCommand -> [SingularCommand]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SingularCommand -> [SingularCommand])
-> (SingularExpr poly -> SingularCommand)
-> SingularExpr poly
-> [SingularCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingularExpr poly -> SingularCommand
forall poly.
IsSingularPolynomial poly =>
SingularExpr poly -> SingularCommand
SingExpr

declOnlyC :: SingularType -> Text -> SingularProgram
declOnlyC :: SingularType -> Text -> SingularProgramM ()
declOnlyC SingularType
type_ Text
val = Writer [SingularCommand] () -> SingularProgramM ()
forall a. Writer [SingularCommand] a -> SingularProgramM a
SingularProgramM (Writer [SingularCommand] () -> SingularProgramM ())
-> Writer [SingularCommand] () -> SingularProgramM ()
forall a b. (a -> b) -> a -> b
$ [SingularCommand] -> Writer [SingularCommand] ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [SingularType -> Text -> SingularCommand
SingDeclOnly SingularType
type_ Text
val]

declC ::
  (IsSingularPolynomial poly) =>
  SingularType ->
  Text ->
  SingularExpr poly ->
  SingularProgramM (SingularExpr poly)
declC :: SingularType
-> Text
-> SingularExpr poly
-> SingularProgramM (SingularExpr poly)
declC SingularType
type_ Text
val SingularExpr poly
expr = do
  Writer [SingularCommand] () -> SingularProgramM ()
forall a. Writer [SingularCommand] a -> SingularProgramM a
SingularProgramM (Writer [SingularCommand] () -> SingularProgramM ())
-> Writer [SingularCommand] () -> SingularProgramM ()
forall a b. (a -> b) -> a -> b
$ [SingularCommand] -> Writer [SingularCommand] ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [SingularType -> Text -> SingularExpr poly -> SingularCommand
forall poly.
IsSingularPolynomial poly =>
SingularType -> Text -> SingularExpr poly -> SingularCommand
SingDeclAssign SingularType
type_ Text
val SingularExpr poly
expr]
  SingularExpr poly -> SingularProgramM (SingularExpr poly)
forall (m :: * -> *) a. Monad m => a -> m a
return (SingularExpr poly -> SingularProgramM (SingularExpr poly))
-> SingularExpr poly -> SingularProgramM (SingularExpr poly)
forall a b. (a -> b) -> a -> b
$ Text -> SingularExpr poly
forall poly. Text -> SingularExpr poly
varE Text
val

letC ::
  (IsSingularPolynomial poly) =>
  Text ->
  SingularExpr poly ->
  SingularProgram
letC :: Text -> SingularExpr poly -> SingularProgramM ()
letC Text
val SingularExpr poly
expr = Writer [SingularCommand] () -> SingularProgramM ()
forall a. Writer [SingularCommand] a -> SingularProgramM a
SingularProgramM (Writer [SingularCommand] () -> SingularProgramM ())
-> Writer [SingularCommand] () -> SingularProgramM ()
forall a b. (a -> b) -> a -> b
$ [SingularCommand] -> Writer [SingularCommand] ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [Text -> SingularExpr poly -> SingularCommand
forall poly.
IsSingularPolynomial poly =>
Text -> SingularExpr poly -> SingularCommand
SingAssign Text
val SingularExpr poly
expr]

idealC' ::
  (IsSingularPolynomial poly) =>
  Text ->
  Ideal poly ->
  SingularProgramM (SingularExpr poly)
idealC' :: Text -> Ideal poly -> SingularProgramM (SingularExpr poly)
idealC' Text
val = SingularType
-> Text
-> SingularExpr poly
-> SingularProgramM (SingularExpr poly)
forall poly.
IsSingularPolynomial poly =>
SingularType
-> Text
-> SingularExpr poly
-> SingularProgramM (SingularExpr poly)
declC SingularType
IdealT Text
val (SingularExpr poly -> SingularProgramM (SingularExpr poly))
-> (Ideal poly -> SingularExpr poly)
-> Ideal poly
-> SingularProgramM (SingularExpr poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ideal poly -> SingularExpr poly
forall poly. Ideal poly -> SingularExpr poly
idealE'

idealC :: (IsSingularPolynomial poly) => Text -> [SingularExpr poly] -> SingularProgramM (SingularExpr poly)
idealC :: Text -> [SingularExpr poly] -> SingularProgramM (SingularExpr poly)
idealC Text
val = SingularType
-> Text
-> SingularExpr poly
-> SingularProgramM (SingularExpr poly)
forall poly.
IsSingularPolynomial poly =>
SingularType
-> Text
-> SingularExpr poly
-> SingularProgramM (SingularExpr poly)
declC SingularType
IdealT Text
val (SingularExpr poly -> SingularProgramM (SingularExpr poly))
-> ([SingularExpr poly] -> SingularExpr poly)
-> [SingularExpr poly]
-> SingularProgramM (SingularExpr poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SingularExpr poly] -> SingularExpr poly
forall poly. [SingularExpr poly] -> SingularExpr poly
idealE

ringC ::
  IsSingularPolynomial poly =>
  Text ->
  proxy poly ->
  SingularProgramM (SingularExpr poly)
ringC :: Text -> proxy poly -> SingularProgramM (SingularExpr poly)
ringC Text
val proxy poly
r = SingularType
-> Text
-> SingularExpr poly
-> SingularProgramM (SingularExpr poly)
forall poly.
IsSingularPolynomial poly =>
SingularType
-> Text
-> SingularExpr poly
-> SingularProgramM (SingularExpr poly)
declC SingularType
RingT Text
val (RingSpec -> SingularExpr poly
forall poly. RingSpec -> SingularExpr poly
SingRing (RingSpec -> SingularExpr poly) -> RingSpec -> SingularExpr poly
forall a b. (a -> b) -> a -> b
$ proxy poly -> RingSpec
forall poly (proxy :: * -> *).
IsSingularPolynomial poly =>
proxy poly -> RingSpec
toRingSpec proxy poly
r)

polyC :: (IsSingularPolynomial poly) => Text -> poly -> SingularProgramM (SingularExpr poly)
polyC :: Text -> poly -> SingularProgramM (SingularExpr poly)
polyC Text
val = SingularType
-> Text
-> SingularExpr poly
-> SingularProgramM (SingularExpr poly)
forall poly.
IsSingularPolynomial poly =>
SingularType
-> Text
-> SingularExpr poly
-> SingularProgramM (SingularExpr poly)
declC SingularType
PolyT Text
val (SingularExpr poly -> SingularProgramM (SingularExpr poly))
-> (poly -> SingularExpr poly)
-> poly
-> SingularProgramM (SingularExpr poly)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. poly -> SingularExpr poly
forall poly. poly -> SingularExpr poly
polyE

libC :: Text -> SingularProgram
libC :: Text -> SingularProgramM ()
libC Text
lib = Writer [SingularCommand] () -> SingularProgramM ()
forall a. Writer [SingularCommand] a -> SingularProgramM a
SingularProgramM (Writer [SingularCommand] () -> SingularProgramM ())
-> Writer [SingularCommand] () -> SingularProgramM ()
forall a b. (a -> b) -> a -> b
$ [SingularCommand] -> Writer [SingularCommand] ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [Text -> SingularCommand
SingLibrary Text
lib]

directC :: Text -> SingularProgram
directC :: Text -> SingularProgramM ()
directC = Writer [SingularCommand] () -> SingularProgramM ()
forall a. Writer [SingularCommand] a -> SingularProgramM a
SingularProgramM (Writer [SingularCommand] () -> SingularProgramM ())
-> (Text -> Writer [SingularCommand] ())
-> Text
-> SingularProgramM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SingularCommand] -> Writer [SingularCommand] ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell ([SingularCommand] -> Writer [SingularCommand] ())
-> (Text -> [SingularCommand])
-> Text
-> Writer [SingularCommand] ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingularCommand -> [SingularCommand]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SingularCommand -> [SingularCommand])
-> (Text -> SingularCommand) -> Text -> [SingularCommand]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SingularCommand
Directive

optionC :: SingularOption -> SingularProgram
optionC :: Text -> SingularProgramM ()
optionC Text
t = Writer [SingularCommand] () -> SingularProgramM ()
forall a. Writer [SingularCommand] a -> SingularProgramM a
SingularProgramM (Writer [SingularCommand] () -> SingularProgramM ())
-> Writer [SingularCommand] () -> SingularProgramM ()
forall a b. (a -> b) -> a -> b
$ [SingularCommand] -> Writer [SingularCommand] ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [Text -> SingularCommand
SingVerbD (Text
"option(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")]

printC :: (IsSingularPolynomial poly) => SingularExpr poly -> SingularProgram
printC :: SingularExpr poly -> SingularProgramM ()
printC SingularExpr poly
x = SingularExpr poly -> SingularProgramM ()
forall poly.
IsSingularPolynomial poly =>
SingularExpr poly -> SingularProgramM ()
exprC (SingularExpr poly -> SingularProgramM ())
-> SingularExpr poly -> SingularProgramM ()
forall a b. (a -> b) -> a -> b
$ Text -> [SingularExpr poly] -> SingularExpr poly
forall poly. Text -> [SingularExpr poly] -> SingularExpr poly
funE Text
"print" [SingularExpr poly
x]

type SingularOption = Text