{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
module Predicate.Data.Numeric (
type (+)
, type (-)
, type (*)
, type (/)
, Negate
, Abs
, Signum
, FromInteger
, FromInteger'
, FromIntegral
, FromIntegral'
, Truncate
, Truncate'
, Ceiling
, Ceiling'
, Floor
, Floor'
, Even
, Odd
, Div
, Mod
, DivMod
, QuotRem
, Quot
, Rem
, LogBase
, type (^)
, type (**)
, DivI
, RoundUp
, type (%)
, type (-%)
, ToRational
, FromRational
, FromRational'
, ReadBase
, ReadBase'
, ShowBase
, ShowBaseN
, UnShowBaseN
, ToBits
) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Predicate.Data.Ordering (type (==))
import GHC.TypeLits (Nat,KnownNat)
import Data.List (elemIndex)
import Data.Function (fix)
import Data.Typeable (Typeable, Proxy(Proxy))
import Data.Kind (Type)
import qualified Numeric
import Data.Char (toLower)
import Data.Ratio ((%))
import GHC.Real (Ratio((:%)))
import qualified Safe (fromJustNote, atNote)
data FromInteger' t p deriving Int -> FromInteger' t p -> ShowS
[FromInteger' t p] -> ShowS
FromInteger' t p -> String
(Int -> FromInteger' t p -> ShowS)
-> (FromInteger' t p -> String)
-> ([FromInteger' t p] -> ShowS)
-> Show (FromInteger' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> FromInteger' t p -> ShowS
forall k (t :: k) k (p :: k). [FromInteger' t p] -> ShowS
forall k (t :: k) k (p :: k). FromInteger' t p -> String
showList :: [FromInteger' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [FromInteger' t p] -> ShowS
show :: FromInteger' t p -> String
$cshow :: forall k (t :: k) k (p :: k). FromInteger' t p -> String
showsPrec :: Int -> FromInteger' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> FromInteger' t p -> ShowS
Show
instance ( Num (PP t a)
, Integral (PP p a)
, P p a
, Show (PP t a)
) => P (FromInteger' t p) a where
type PP (FromInteger' t p) a = PP t a
eval :: proxy (FromInteger' t p)
-> POpts -> a -> m (TT (PP (FromInteger' t p) a))
eval proxy (FromInteger' t p)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"FromInteger"
TT (PP p a)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
TT (PP t a) -> m (TT (PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t a) -> m (TT (PP t a))) -> TT (PP t a) -> m (TT (PP t a))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (PP t a)) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p a)
pp [] of
Left TT (PP t a)
e -> TT (PP t a)
e
Right PP p a
p ->
let b :: PP t a
b = Integer -> PP t a
forall a. Num a => Integer -> a
fromInteger (PP p a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral PP p a
p)
in POpts -> Val (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t a -> Val (PP t a)
forall a. a -> Val a
Val PP t a
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP t a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP t a
b) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]
data FromInteger (t :: Type) deriving Int -> FromInteger t -> ShowS
[FromInteger t] -> ShowS
FromInteger t -> String
(Int -> FromInteger t -> ShowS)
-> (FromInteger t -> String)
-> ([FromInteger t] -> ShowS)
-> Show (FromInteger t)
forall t. Int -> FromInteger t -> ShowS
forall t. [FromInteger t] -> ShowS
forall t. FromInteger t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromInteger t] -> ShowS
$cshowList :: forall t. [FromInteger t] -> ShowS
show :: FromInteger t -> String
$cshow :: forall t. FromInteger t -> String
showsPrec :: Int -> FromInteger t -> ShowS
$cshowsPrec :: forall t. Int -> FromInteger t -> ShowS
Show
type FromIntegerT (t :: Type) = FromInteger' (Hole t) Id
instance P (FromIntegerT t) x => P (FromInteger t) x where
type PP (FromInteger t) x = PP (FromIntegerT t) x
eval :: proxy (FromInteger t)
-> POpts -> x -> m (TT (PP (FromInteger t) x))
eval proxy (FromInteger t)
_ = Proxy (FromIntegerT t)
-> POpts -> x -> m (TT (PP (FromIntegerT t) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FromIntegerT t)
forall k (t :: k). Proxy t
Proxy @(FromIntegerT t))
data FromIntegral' t p deriving Int -> FromIntegral' t p -> ShowS
[FromIntegral' t p] -> ShowS
FromIntegral' t p -> String
(Int -> FromIntegral' t p -> ShowS)
-> (FromIntegral' t p -> String)
-> ([FromIntegral' t p] -> ShowS)
-> Show (FromIntegral' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> FromIntegral' t p -> ShowS
forall k (t :: k) k (p :: k). [FromIntegral' t p] -> ShowS
forall k (t :: k) k (p :: k). FromIntegral' t p -> String
showList :: [FromIntegral' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [FromIntegral' t p] -> ShowS
show :: FromIntegral' t p -> String
$cshow :: forall k (t :: k) k (p :: k). FromIntegral' t p -> String
showsPrec :: Int -> FromIntegral' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> FromIntegral' t p -> ShowS
Show
instance ( Num (PP t a)
, Integral (PP p a)
, P p a
, Show (PP t a)
, Show (PP p a)
) => P (FromIntegral' t p) a where
type PP (FromIntegral' t p) a = PP t a
eval :: proxy (FromIntegral' t p)
-> POpts -> a -> m (TT (PP (FromIntegral' t p) a))
eval proxy (FromIntegral' t p)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"FromIntegral"
TT (PP p a)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
TT (PP t a) -> m (TT (PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t a) -> m (TT (PP t a))) -> TT (PP t a) -> m (TT (PP t a))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (PP t a)) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p a)
pp [] of
Left TT (PP t a)
e -> TT (PP t a)
e
Right PP p a
p ->
let b :: PP t a
b = PP p a -> PP t a
forall a b. (Integral a, Num b) => a -> b
fromIntegral PP p a
p
in POpts -> Val (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t a -> Val (PP t a)
forall a. a -> Val a
Val PP t a
b) (POpts -> String -> PP t a -> PP p a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t a
b PP p a
p) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]
data FromIntegral (t :: Type) deriving Int -> FromIntegral t -> ShowS
[FromIntegral t] -> ShowS
FromIntegral t -> String
(Int -> FromIntegral t -> ShowS)
-> (FromIntegral t -> String)
-> ([FromIntegral t] -> ShowS)
-> Show (FromIntegral t)
forall t. Int -> FromIntegral t -> ShowS
forall t. [FromIntegral t] -> ShowS
forall t. FromIntegral t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromIntegral t] -> ShowS
$cshowList :: forall t. [FromIntegral t] -> ShowS
show :: FromIntegral t -> String
$cshow :: forall t. FromIntegral t -> String
showsPrec :: Int -> FromIntegral t -> ShowS
$cshowsPrec :: forall t. Int -> FromIntegral t -> ShowS
Show
type FromIntegralT (t :: Type) = FromIntegral' (Hole t) Id
instance P (FromIntegralT t) x => P (FromIntegral t) x where
type PP (FromIntegral t) x = PP (FromIntegralT t) x
eval :: proxy (FromIntegral t)
-> POpts -> x -> m (TT (PP (FromIntegral t) x))
eval proxy (FromIntegral t)
_ = Proxy (FromIntegralT t)
-> POpts -> x -> m (TT (PP (FromIntegralT t) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FromIntegralT t)
forall k (t :: k). Proxy t
Proxy @(FromIntegralT t))
data ToRational p deriving Int -> ToRational p -> ShowS
[ToRational p] -> ShowS
ToRational p -> String
(Int -> ToRational p -> ShowS)
-> (ToRational p -> String)
-> ([ToRational p] -> ShowS)
-> Show (ToRational p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ToRational p -> ShowS
forall k (p :: k). [ToRational p] -> ShowS
forall k (p :: k). ToRational p -> String
showList :: [ToRational p] -> ShowS
$cshowList :: forall k (p :: k). [ToRational p] -> ShowS
show :: ToRational p -> String
$cshow :: forall k (p :: k). ToRational p -> String
showsPrec :: Int -> ToRational p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ToRational p -> ShowS
Show
instance ( a ~ PP p x
, Show a
, Real a
, P p x
)
=> P (ToRational p) x where
type PP (ToRational p) x = Rational
eval :: proxy (ToRational p) -> POpts -> x -> m (TT (PP (ToRational p) x))
eval proxy (ToRational p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"ToRational"
TT a
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
TT Rational -> m (TT Rational)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Rational -> m (TT Rational)) -> TT Rational -> m (TT Rational)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT a -> [Tree PE] -> Either (TT Rational) a
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT a
pp [] of
Left TT Rational
e -> TT Rational
e
Right a
a ->
let r :: Rational
r = a -> Rational
forall a. Real a => a -> Rational
toRational a
a
in POpts -> Val Rational -> String -> [Tree PE] -> TT Rational
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Rational -> Val Rational
forall a. a -> Val a
Val Rational
r) (POpts -> String -> Rational -> a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Rational
r a
a) [TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp]
data FromRational' t p deriving Int -> FromRational' t p -> ShowS
[FromRational' t p] -> ShowS
FromRational' t p -> String
(Int -> FromRational' t p -> ShowS)
-> (FromRational' t p -> String)
-> ([FromRational' t p] -> ShowS)
-> Show (FromRational' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> FromRational' t p -> ShowS
forall k (t :: k) k (p :: k). [FromRational' t p] -> ShowS
forall k (t :: k) k (p :: k). FromRational' t p -> String
showList :: [FromRational' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [FromRational' t p] -> ShowS
show :: FromRational' t p -> String
$cshow :: forall k (t :: k) k (p :: k). FromRational' t p -> String
showsPrec :: Int -> FromRational' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> FromRational' t p -> ShowS
Show
instance ( P p a
, PP p a ~ Rational
, Show (PP t a)
, Fractional (PP t a)
) => P (FromRational' t p) a where
type PP (FromRational' t p) a = PP t a
eval :: proxy (FromRational' t p)
-> POpts -> a -> m (TT (PP (FromRational' t p) a))
eval proxy (FromRational' t p)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"FromRational"
TT Rational
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
TT (PP t a) -> m (TT (PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t a) -> m (TT (PP t a))) -> TT (PP t a) -> m (TT (PP t a))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT Rational
-> [Tree PE]
-> Either (TT (PP t a)) Rational
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Rational
pp [] of
Left TT (PP t a)
e -> TT (PP t a)
e
Right Rational
p ->
let b :: PP t a
b = Rational -> PP t a
forall a. Fractional a => Rational -> a
fromRational @(PP t a) Rational
p
in POpts -> Val (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t a -> Val (PP t a)
forall a. a -> Val a
Val PP t a
b) (POpts -> String -> PP t a -> Rational -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t a
b Rational
p) [TT Rational -> Tree PE
forall a. TT a -> Tree PE
hh TT Rational
pp]
data FromRational (t :: Type) deriving Int -> FromRational t -> ShowS
[FromRational t] -> ShowS
FromRational t -> String
(Int -> FromRational t -> ShowS)
-> (FromRational t -> String)
-> ([FromRational t] -> ShowS)
-> Show (FromRational t)
forall t. Int -> FromRational t -> ShowS
forall t. [FromRational t] -> ShowS
forall t. FromRational t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromRational t] -> ShowS
$cshowList :: forall t. [FromRational t] -> ShowS
show :: FromRational t -> String
$cshow :: forall t. FromRational t -> String
showsPrec :: Int -> FromRational t -> ShowS
$cshowsPrec :: forall t. Int -> FromRational t -> ShowS
Show
type FromRationalT (t :: Type) = FromRational' (Hole t) Id
instance P (FromRationalT t) x => P (FromRational t) x where
type PP (FromRational t) x = PP (FromRationalT t) x
eval :: proxy (FromRational t)
-> POpts -> x -> m (TT (PP (FromRational t) x))
eval proxy (FromRational t)
_ = Proxy (FromRationalT t)
-> POpts -> x -> m (TT (PP (FromRationalT t) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FromRationalT t)
forall k (t :: k). Proxy t
Proxy @(FromRationalT t))
data Truncate' t p deriving Int -> Truncate' t p -> ShowS
[Truncate' t p] -> ShowS
Truncate' t p -> String
(Int -> Truncate' t p -> ShowS)
-> (Truncate' t p -> String)
-> ([Truncate' t p] -> ShowS)
-> Show (Truncate' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> Truncate' t p -> ShowS
forall k (t :: k) k (p :: k). [Truncate' t p] -> ShowS
forall k (t :: k) k (p :: k). Truncate' t p -> String
showList :: [Truncate' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [Truncate' t p] -> ShowS
show :: Truncate' t p -> String
$cshow :: forall k (t :: k) k (p :: k). Truncate' t p -> String
showsPrec :: Int -> Truncate' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> Truncate' t p -> ShowS
Show
instance ( P p x
, RealFrac (PP p x)
, Integral (PP t x)
, Show (PP t x)
, Show (PP p x)
) => P (Truncate' t p) x where
type PP (Truncate' t p) x = PP t x
eval :: proxy (Truncate' t p)
-> POpts -> x -> m (TT (PP (Truncate' t p) x))
eval proxy (Truncate' t p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Truncate"
TT (PP p x)
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
TT (PP t x) -> m (TT (PP t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t x) -> m (TT (PP t x))) -> TT (PP t x) -> m (TT (PP t x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (PP t x)) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
Left TT (PP t x)
e -> TT (PP t x)
e
Right PP p x
p ->
let b :: PP t x
b = PP p x -> PP t x
forall a b. (RealFrac a, Integral b) => a -> b
truncate PP p x
p
in POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t x -> Val (PP t x)
forall a. a -> Val a
Val PP t x
b) (POpts -> String -> PP t x -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t x
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data Truncate (t :: Type) deriving Int -> Truncate t -> ShowS
[Truncate t] -> ShowS
Truncate t -> String
(Int -> Truncate t -> ShowS)
-> (Truncate t -> String)
-> ([Truncate t] -> ShowS)
-> Show (Truncate t)
forall t. Int -> Truncate t -> ShowS
forall t. [Truncate t] -> ShowS
forall t. Truncate t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Truncate t] -> ShowS
$cshowList :: forall t. [Truncate t] -> ShowS
show :: Truncate t -> String
$cshow :: forall t. Truncate t -> String
showsPrec :: Int -> Truncate t -> ShowS
$cshowsPrec :: forall t. Int -> Truncate t -> ShowS
Show
type TruncateT (t :: Type) = Truncate' (Hole t) Id
instance P (TruncateT t) x => P (Truncate t) x where
type PP (Truncate t) x = PP (TruncateT t) x
eval :: proxy (Truncate t) -> POpts -> x -> m (TT (PP (Truncate t) x))
eval proxy (Truncate t)
_ = Proxy (TruncateT t) -> POpts -> x -> m (TT (PP (TruncateT t) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (TruncateT t)
forall k (t :: k). Proxy t
Proxy @(TruncateT t))
data Ceiling' t p deriving Int -> Ceiling' t p -> ShowS
[Ceiling' t p] -> ShowS
Ceiling' t p -> String
(Int -> Ceiling' t p -> ShowS)
-> (Ceiling' t p -> String)
-> ([Ceiling' t p] -> ShowS)
-> Show (Ceiling' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> Ceiling' t p -> ShowS
forall k (t :: k) k (p :: k). [Ceiling' t p] -> ShowS
forall k (t :: k) k (p :: k). Ceiling' t p -> String
showList :: [Ceiling' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [Ceiling' t p] -> ShowS
show :: Ceiling' t p -> String
$cshow :: forall k (t :: k) k (p :: k). Ceiling' t p -> String
showsPrec :: Int -> Ceiling' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> Ceiling' t p -> ShowS
Show
instance ( P p x
, RealFrac (PP p x)
, Integral (PP t x)
, Show (PP t x)
, Show (PP p x)
) => P (Ceiling' t p) x where
type PP (Ceiling' t p) x = PP t x
eval :: proxy (Ceiling' t p) -> POpts -> x -> m (TT (PP (Ceiling' t p) x))
eval proxy (Ceiling' t p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Ceiling"
TT (PP p x)
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
TT (PP t x) -> m (TT (PP t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t x) -> m (TT (PP t x))) -> TT (PP t x) -> m (TT (PP t x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (PP t x)) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
Left TT (PP t x)
e -> TT (PP t x)
e
Right PP p x
p ->
let b :: PP t x
b = PP p x -> PP t x
forall a b. (RealFrac a, Integral b) => a -> b
ceiling PP p x
p
in POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t x -> Val (PP t x)
forall a. a -> Val a
Val PP t x
b) (POpts -> String -> PP t x -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t x
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data Ceiling (t :: Type) deriving Int -> Ceiling t -> ShowS
[Ceiling t] -> ShowS
Ceiling t -> String
(Int -> Ceiling t -> ShowS)
-> (Ceiling t -> String)
-> ([Ceiling t] -> ShowS)
-> Show (Ceiling t)
forall t. Int -> Ceiling t -> ShowS
forall t. [Ceiling t] -> ShowS
forall t. Ceiling t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ceiling t] -> ShowS
$cshowList :: forall t. [Ceiling t] -> ShowS
show :: Ceiling t -> String
$cshow :: forall t. Ceiling t -> String
showsPrec :: Int -> Ceiling t -> ShowS
$cshowsPrec :: forall t. Int -> Ceiling t -> ShowS
Show
type CeilingT (t :: Type) = Ceiling' (Hole t) Id
instance P (CeilingT t) x => P (Ceiling t) x where
type PP (Ceiling t) x = PP (CeilingT t) x
eval :: proxy (Ceiling t) -> POpts -> x -> m (TT (PP (Ceiling t) x))
eval proxy (Ceiling t)
_ = Proxy (CeilingT t) -> POpts -> x -> m (TT (PP (CeilingT t) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (CeilingT t)
forall k (t :: k). Proxy t
Proxy @(CeilingT t))
data Floor' t p deriving Int -> Floor' t p -> ShowS
[Floor' t p] -> ShowS
Floor' t p -> String
(Int -> Floor' t p -> ShowS)
-> (Floor' t p -> String)
-> ([Floor' t p] -> ShowS)
-> Show (Floor' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> Floor' t p -> ShowS
forall k (t :: k) k (p :: k). [Floor' t p] -> ShowS
forall k (t :: k) k (p :: k). Floor' t p -> String
showList :: [Floor' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [Floor' t p] -> ShowS
show :: Floor' t p -> String
$cshow :: forall k (t :: k) k (p :: k). Floor' t p -> String
showsPrec :: Int -> Floor' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> Floor' t p -> ShowS
Show
instance ( P p x
, RealFrac (PP p x)
, Integral (PP t x)
, Show (PP t x)
, Show (PP p x)
) => P (Floor' t p) x where
type PP (Floor' t p) x = PP t x
eval :: proxy (Floor' t p) -> POpts -> x -> m (TT (PP (Floor' t p) x))
eval proxy (Floor' t p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Floor"
TT (PP p x)
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
TT (PP t x) -> m (TT (PP t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t x) -> m (TT (PP t x))) -> TT (PP t x) -> m (TT (PP t x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (PP t x)) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
Left TT (PP t x)
e -> TT (PP t x)
e
Right PP p x
p ->
let b :: PP t x
b = PP p x -> PP t x
forall a b. (RealFrac a, Integral b) => a -> b
floor PP p x
p
in POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t x -> Val (PP t x)
forall a. a -> Val a
Val PP t x
b) (POpts -> String -> PP t x -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t x
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data Floor (t :: Type) deriving Int -> Floor t -> ShowS
[Floor t] -> ShowS
Floor t -> String
(Int -> Floor t -> ShowS)
-> (Floor t -> String) -> ([Floor t] -> ShowS) -> Show (Floor t)
forall t. Int -> Floor t -> ShowS
forall t. [Floor t] -> ShowS
forall t. Floor t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Floor t] -> ShowS
$cshowList :: forall t. [Floor t] -> ShowS
show :: Floor t -> String
$cshow :: forall t. Floor t -> String
showsPrec :: Int -> Floor t -> ShowS
$cshowsPrec :: forall t. Int -> Floor t -> ShowS
Show
type FloorT (t :: Type) = Floor' (Hole t) Id
instance P (FloorT t) x => P (Floor t) x where
type PP (Floor t) x = PP (FloorT t) x
eval :: proxy (Floor t) -> POpts -> x -> m (TT (PP (Floor t) x))
eval proxy (Floor t)
_ = Proxy (FloorT t) -> POpts -> x -> m (TT (PP (FloorT t) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FloorT t)
forall k (t :: k). Proxy t
Proxy @(FloorT t))
data BinOp = BMult | BSub | BAdd
deriving stock (ReadPrec [BinOp]
ReadPrec BinOp
Int -> ReadS BinOp
ReadS [BinOp]
(Int -> ReadS BinOp)
-> ReadS [BinOp]
-> ReadPrec BinOp
-> ReadPrec [BinOp]
-> Read BinOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinOp]
$creadListPrec :: ReadPrec [BinOp]
readPrec :: ReadPrec BinOp
$creadPrec :: ReadPrec BinOp
readList :: ReadS [BinOp]
$creadList :: ReadS [BinOp]
readsPrec :: Int -> ReadS BinOp
$creadsPrec :: Int -> ReadS BinOp
Read, Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
(Int -> BinOp -> ShowS)
-> (BinOp -> String) -> ([BinOp] -> ShowS) -> Show BinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinOp] -> ShowS
$cshowList :: [BinOp] -> ShowS
show :: BinOp -> String
$cshow :: BinOp -> String
showsPrec :: Int -> BinOp -> ShowS
$cshowsPrec :: Int -> BinOp -> ShowS
Show, BinOp -> BinOp -> Bool
(BinOp -> BinOp -> Bool) -> (BinOp -> BinOp -> Bool) -> Eq BinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinOp -> BinOp -> Bool
$c/= :: BinOp -> BinOp -> Bool
== :: BinOp -> BinOp -> Bool
$c== :: BinOp -> BinOp -> Bool
Eq)
data p + q deriving Int -> (p + q) -> ShowS
[p + q] -> ShowS
(p + q) -> String
(Int -> (p + q) -> ShowS)
-> ((p + q) -> String) -> ([p + q] -> ShowS) -> Show (p + q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p + q) -> ShowS
forall k (p :: k) k (q :: k). [p + q] -> ShowS
forall k (p :: k) k (q :: k). (p + q) -> String
showList :: [p + q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p + q] -> ShowS
show :: (p + q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p + q) -> String
showsPrec :: Int -> (p + q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p + q) -> ShowS
Show
infixl 6 +
type AddT p q = Bin 'BAdd p q
instance P (AddT p q) x => P (p + q) x where
type PP (p + q) x = PP (AddT p q) x
eval :: proxy (p + q) -> POpts -> x -> m (TT (PP (p + q) x))
eval proxy (p + q)
_ = Proxy (AddT p q) -> POpts -> x -> m (TT (PP (AddT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (AddT p q)
forall k (t :: k). Proxy t
Proxy @(AddT p q))
data p - q deriving Int -> (p - q) -> ShowS
[p - q] -> ShowS
(p - q) -> String
(Int -> (p - q) -> ShowS)
-> ((p - q) -> String) -> ([p - q] -> ShowS) -> Show (p - q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p - q) -> ShowS
forall k (p :: k) k (q :: k). [p - q] -> ShowS
forall k (p :: k) k (q :: k). (p - q) -> String
showList :: [p - q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p - q] -> ShowS
show :: (p - q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p - q) -> String
showsPrec :: Int -> (p - q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p - q) -> ShowS
Show
infixl 6 -
type SubT p q = Bin 'BSub p q
instance P (SubT p q) x => P (p - q) x where
type PP (p - q) x = PP (SubT p q) x
eval :: proxy (p - q) -> POpts -> x -> m (TT (PP (p - q) x))
eval proxy (p - q)
_ = Proxy (SubT p q) -> POpts -> x -> m (TT (PP (SubT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (SubT p q)
forall k (t :: k). Proxy t
Proxy @(SubT p q))
data p * q deriving Int -> (p * q) -> ShowS
[p * q] -> ShowS
(p * q) -> String
(Int -> (p * q) -> ShowS)
-> ((p * q) -> String) -> ([p * q] -> ShowS) -> Show (p * q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p * q) -> ShowS
forall k (p :: k) k (q :: k). [p * q] -> ShowS
forall k (p :: k) k (q :: k). (p * q) -> String
showList :: [p * q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p * q] -> ShowS
show :: (p * q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p * q) -> String
showsPrec :: Int -> (p * q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p * q) -> ShowS
Show
infixl 7 *
type MultT p q = Bin 'BMult p q
instance P (MultT p q) x => P (p * q) x where
type PP (p * q) x = PP (MultT p q) x
eval :: proxy (p * q) -> POpts -> x -> m (TT (PP (p * q) x))
eval proxy (p * q)
_ = Proxy (MultT p q) -> POpts -> x -> m (TT (PP (MultT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (MultT p q)
forall k (t :: k). Proxy t
Proxy @(MultT p q))
data p ^ q deriving Int -> (p ^ q) -> ShowS
[p ^ q] -> ShowS
(p ^ q) -> String
(Int -> (p ^ q) -> ShowS)
-> ((p ^ q) -> String) -> ([p ^ q] -> ShowS) -> Show (p ^ q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p ^ q) -> ShowS
forall k (p :: k) k (q :: k). [p ^ q] -> ShowS
forall k (p :: k) k (q :: k). (p ^ q) -> String
showList :: [p ^ q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p ^ q] -> ShowS
show :: (p ^ q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p ^ q) -> String
showsPrec :: Int -> (p ^ q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p ^ q) -> ShowS
Show
infixr 8 ^
instance ( P p a
, P q a
, Show (PP p a)
, Show (PP q a)
, Num (PP p a)
, Integral (PP q a)
) => P (p ^ q) a where
type PP (p ^ q) a = PP p a
eval :: proxy (p ^ q) -> POpts -> a -> m (TT (PP (p ^ q) a))
eval proxy (p ^ q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"Pow"
Either (TT (PP p a)) (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
TT (PP p a) -> m (TT (PP p a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a) -> m (TT (PP p a))) -> TT (PP p a) -> m (TT (PP p a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP p a)) (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
Left TT (PP p a)
e -> TT (PP p a)
e
Right (PP p a
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) ->
let hhs :: [Tree PE]
hhs = [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
in if PP q a
q PP q a -> PP q a -> Bool
forall a. Ord a => a -> a -> Bool
< PP q a
0 then POpts -> Val (PP p a) -> String -> [Tree PE] -> TT (PP p a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP p a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" negative exponent")) String
"" [Tree PE]
hhs
else let d :: PP p a
d = PP p a
p PP p a -> PP q a -> PP p a
forall a b. (Num a, Integral b) => a -> b -> a
^ PP q a
q
in POpts -> Val (PP p a) -> String -> [Tree PE] -> TT (PP p a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP p a -> Val (PP p a)
forall a. a -> Val a
Val PP p a
d) (POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ^ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
d) [Tree PE]
hhs
data p ** q deriving Int -> (p ** q) -> ShowS
[p ** q] -> ShowS
(p ** q) -> String
(Int -> (p ** q) -> ShowS)
-> ((p ** q) -> String) -> ([p ** q] -> ShowS) -> Show (p ** q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p ** q) -> ShowS
forall k (p :: k) k (q :: k). [p ** q] -> ShowS
forall k (p :: k) k (q :: k). (p ** q) -> String
showList :: [p ** q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p ** q] -> ShowS
show :: (p ** q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p ** q) -> String
showsPrec :: Int -> (p ** q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p ** q) -> ShowS
Show
infixr 8 **
instance ( PP p a ~ PP q a
, P p a
, P q a
, Show (PP p a)
, Floating (PP p a)
, Ord (PP q a)
) => P (p ** q) a where
type PP (p ** q) a = PP p a
eval :: proxy (p ** q) -> POpts -> a -> m (TT (PP (p ** q) a))
eval proxy (p ** q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"Exp"
Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
Left TT (PP q a)
e -> TT (PP q a)
e
Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
in if PP q a
q PP q a -> PP q a -> Bool
forall a. Ord a => a -> a -> Bool
< PP q a
0 then POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" negative exponent")) String
"" [Tree PE]
hhs
else if PP q a
p PP q a -> PP q a -> Bool
forall a. Eq a => a -> a -> Bool
== PP q a
0 Bool -> Bool -> Bool
&& PP q a
q PP q a -> PP q a -> Bool
forall a. Eq a => a -> a -> Bool
== PP q a
0 then POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero/zero")) String
"" [Tree PE]
hhs
else let d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Floating a => a -> a -> a
** PP q a
q
in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ** " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs
data LogBase p q deriving Int -> LogBase p q -> ShowS
[LogBase p q] -> ShowS
LogBase p q -> String
(Int -> LogBase p q -> ShowS)
-> (LogBase p q -> String)
-> ([LogBase p q] -> ShowS)
-> Show (LogBase p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> LogBase p q -> ShowS
forall k (p :: k) k (q :: k). [LogBase p q] -> ShowS
forall k (p :: k) k (q :: k). LogBase p q -> String
showList :: [LogBase p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [LogBase p q] -> ShowS
show :: LogBase p q -> String
$cshow :: forall k (p :: k) k (q :: k). LogBase p q -> String
showsPrec :: Int -> LogBase p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> LogBase p q -> ShowS
Show
instance ( PP p a ~ PP q a
, P p a
, P q a
, Show (PP q a)
, Floating (PP q a)
, Ord (PP p a)
) => P (LogBase p q) a where
type PP (LogBase p q) a = PP p a
eval :: proxy (LogBase p q) -> POpts -> a -> m (TT (PP (LogBase p q) a))
eval proxy (LogBase p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"LogBase"
Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
Left TT (PP q a)
e -> TT (PP q a)
e
Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
in if PP q a
p PP q a -> PP q a -> Bool
forall a. Ord a => a -> a -> Bool
<= PP q a
0 then POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" non-positive base")) String
"" [Tree PE]
hhs
else let d :: PP q a
d = PP q a -> PP q a -> PP q a
forall a. Floating a => a -> a -> a
logBase PP q a
p PP q a
q
in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs
class GetBinOp (k :: BinOp) where
getBinOp :: (Num a, a ~ b) => (String, a -> b -> a)
instance GetBinOp 'BMult where
getBinOp :: (String, a -> b -> a)
getBinOp = (String
"*",a -> b -> a
forall a. Num a => a -> a -> a
(*))
instance GetBinOp 'BSub where
getBinOp :: (String, a -> b -> a)
getBinOp = (String
"-",(-))
instance GetBinOp 'BAdd where
getBinOp :: (String, a -> b -> a)
getBinOp = (String
"+",a -> b -> a
forall a. Num a => a -> a -> a
(+))
data Bin (op :: BinOp) p q deriving Int -> Bin op p q -> ShowS
[Bin op p q] -> ShowS
Bin op p q -> String
(Int -> Bin op p q -> ShowS)
-> (Bin op p q -> String)
-> ([Bin op p q] -> ShowS)
-> Show (Bin op p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (op :: BinOp) k (p :: k) k (q :: k).
Int -> Bin op p q -> ShowS
forall (op :: BinOp) k (p :: k) k (q :: k). [Bin op p q] -> ShowS
forall (op :: BinOp) k (p :: k) k (q :: k). Bin op p q -> String
showList :: [Bin op p q] -> ShowS
$cshowList :: forall (op :: BinOp) k (p :: k) k (q :: k). [Bin op p q] -> ShowS
show :: Bin op p q -> String
$cshow :: forall (op :: BinOp) k (p :: k) k (q :: k). Bin op p q -> String
showsPrec :: Int -> Bin op p q -> ShowS
$cshowsPrec :: forall (op :: BinOp) k (p :: k) k (q :: k).
Int -> Bin op p q -> ShowS
Show
instance ( GetBinOp op
, PP p a ~ PP q a
, P p a
, P q a
, Show (PP p a)
, Num (PP p a)
) => P (Bin op p q) a where
type PP (Bin op p q) a = PP p a
eval :: proxy (Bin op p q) -> POpts -> a -> m (TT (PP (Bin op p q) a))
eval proxy (Bin op p q)
_ POpts
opts a
a = do
let (String
s,PP q a -> PP q a -> PP q a
f) = forall a b. (GetBinOp op, Num a, a ~ b) => (String, a -> b -> a)
forall (k :: BinOp) a b.
(GetBinOp k, Num a, a ~ b) =>
(String, a -> b -> a)
getBinOp @op
Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
s (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
Left TT (PP q a)
e -> TT (PP q a)
e
Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
let d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
`f` PP q a
q
in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
data p / q deriving Int -> (p / q) -> ShowS
[p / q] -> ShowS
(p / q) -> String
(Int -> (p / q) -> ShowS)
-> ((p / q) -> String) -> ([p / q] -> ShowS) -> Show (p / q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p / q) -> ShowS
forall k (p :: k) k (q :: k). [p / q] -> ShowS
forall k (p :: k) k (q :: k). (p / q) -> String
showList :: [p / q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p / q] -> ShowS
show :: (p / q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p / q) -> String
showsPrec :: Int -> (p / q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p / q) -> ShowS
Show
infixl 7 /
instance ( PP p a ~ PP q a
, Eq (PP q a)
, P p a
, P q a
, Show (PP p a)
, Fractional (PP p a)
) => P (p / q) a where
type PP (p / q) a = PP p a
eval :: proxy (p / q) -> POpts -> a -> m (TT (PP (p / q) a))
eval proxy (p / q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"(/)"
Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
Left TT (PP q a)
e -> TT (PP q a)
e
Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq)
| PP q a
q PP q a -> PP q a -> Bool
forall a. Eq a => a -> a -> Bool
== PP q a
0 -> let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator"
in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail String
msg1) String
"" [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
| Bool
otherwise ->
let d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Fractional a => a -> a -> a
/ PP q a
q
in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" / " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
data DivI t p q deriving Int -> DivI t p q -> ShowS
[DivI t p q] -> ShowS
DivI t p q -> String
(Int -> DivI t p q -> ShowS)
-> (DivI t p q -> String)
-> ([DivI t p q] -> ShowS)
-> Show (DivI t p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k) k (q :: k). Int -> DivI t p q -> ShowS
forall k (t :: k) k (p :: k) k (q :: k). [DivI t p q] -> ShowS
forall k (t :: k) k (p :: k) k (q :: k). DivI t p q -> String
showList :: [DivI t p q] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k) k (q :: k). [DivI t p q] -> ShowS
show :: DivI t p q -> String
$cshow :: forall k (t :: k) k (p :: k) k (q :: k). DivI t p q -> String
showsPrec :: Int -> DivI t p q -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k) k (q :: k). Int -> DivI t p q -> ShowS
Show
type DivIT t p q = (p >> FromIntegral t) / (q >> FromIntegral t)
instance P (DivIT t p q) x => P (DivI t p q) x where
type PP (DivI t p q) x = PP (DivIT t p q) x
eval :: proxy (DivI t p q) -> POpts -> x -> m (TT (PP (DivI t p q) x))
eval proxy (DivI t p q)
_ = Proxy (DivIT t p q) -> POpts -> x -> m (TT (PP (DivIT t p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (DivIT t p q)
forall k (t :: k). Proxy t
Proxy @(DivIT t p q))
data p % q deriving Int -> (p % q) -> ShowS
[p % q] -> ShowS
(p % q) -> String
(Int -> (p % q) -> ShowS)
-> ((p % q) -> String) -> ([p % q] -> ShowS) -> Show (p % q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p % q) -> ShowS
forall k (p :: k) k (q :: k). [p % q] -> ShowS
forall k (p :: k) k (q :: k). (p % q) -> String
showList :: [p % q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p % q] -> ShowS
show :: (p % q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p % q) -> String
showsPrec :: Int -> (p % q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p % q) -> ShowS
Show
infixl 8 %
instance ( Integral (PP p x)
, Integral (PP q x)
, Eq (PP q x)
, P p x
, P q x
, Show (PP p x)
, Show (PP q x)
) => P (p % q) x where
type PP (p % q) x = Rational
eval :: proxy (p % q) -> POpts -> x -> m (TT (PP (p % q) x))
eval proxy (p % q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"(%)"
Either (TT Rational) (PP p x, PP q x, TT (PP p x), TT (PP q x))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
(TT Rational) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
TT Rational -> m (TT Rational)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Rational -> m (TT Rational)) -> TT Rational -> m (TT Rational)
forall a b. (a -> b) -> a -> b
$ case Either (TT Rational) (PP p x, PP q x, TT (PP p x), TT (PP q x))
lr of
Left TT Rational
e -> TT Rational
e
Right (PP p x
p,PP q x
q,TT (PP p x)
pp,TT (PP q x)
qq)
| PP q x
q PP q x -> PP q x -> Bool
forall a. Eq a => a -> a -> Bool
== PP q x
0 -> let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator"
in POpts -> Val Rational -> String -> [Tree PE] -> TT Rational
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val Rational
forall a. String -> Val a
Fail String
msg1) String
"" [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp, TT (PP q x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q x)
qq]
| Bool
otherwise ->
let z :: (Integer, Integer)
z@(Integer
p1,Integer
q1) = (PP p x -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral PP p x
p, PP q x -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral PP q x
q)
d :: Rational
d@(Integer
dn :% Integer
dd) = (Integer -> Integer -> Rational) -> (Integer, Integer) -> Rational
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
(%) (Integer, Integer)
z
zz :: String
zz = if Integer
dn Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
p1 Bool -> Bool -> Bool
&& Integer
dd Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
q1 then String
""
else POpts -> String -> ShowS
litVerbose POpts
opts String
" | " (PP p x -> String
forall a. Show a => a -> String
show PP p x
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" % " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PP q x -> String
forall a. Show a => a -> String
show PP q x
q)
in POpts -> Val Rational -> String -> [Tree PE] -> TT Rational
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Rational -> Val Rational
forall a. a -> Val a
Val Rational
d) (POpts -> Rational -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Rational
d String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
zz) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp, TT (PP q x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q x)
qq]
data p -% q deriving Int -> (p -% q) -> ShowS
[p -% q] -> ShowS
(p -% q) -> String
(Int -> (p -% q) -> ShowS)
-> ((p -% q) -> String) -> ([p -% q] -> ShowS) -> Show (p -% q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p -% q) -> ShowS
forall k (p :: k) k (q :: k). [p -% q] -> ShowS
forall k (p :: k) k (q :: k). (p -% q) -> String
showList :: [p -% q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p -% q] -> ShowS
show :: (p -% q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p -% q) -> String
showsPrec :: Int -> (p -% q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p -% q) -> ShowS
Show
infixl 8 -%
type NegateRatioT p q = Negate (p % q)
instance P (NegateRatioT p q) x => P (p -% q) x where
type PP (p -% q) x = PP (NegateRatioT p q) x
eval :: proxy (p -% q) -> POpts -> x -> m (TT (PP (p -% q) x))
eval proxy (p -% q)
_ = Proxy (NegateRatioT p q)
-> POpts -> x -> m (TT (PP (NegateRatioT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (NegateRatioT p q)
forall k (t :: k). Proxy t
Proxy @(NegateRatioT p q))
data Negate p deriving Int -> Negate p -> ShowS
[Negate p] -> ShowS
Negate p -> String
(Int -> Negate p -> ShowS)
-> (Negate p -> String) -> ([Negate p] -> ShowS) -> Show (Negate p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Negate p -> ShowS
forall k (p :: k). [Negate p] -> ShowS
forall k (p :: k). Negate p -> String
showList :: [Negate p] -> ShowS
$cshowList :: forall k (p :: k). [Negate p] -> ShowS
show :: Negate p -> String
$cshow :: forall k (p :: k). Negate p -> String
showsPrec :: Int -> Negate p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Negate p -> ShowS
Show
instance ( Num (PP p x)
, P p x
, Show (PP p x)
) => P (Negate p) x where
type PP (Negate p) x = PP p x
eval :: proxy (Negate p) -> POpts -> x -> m (TT (PP (Negate p) x))
eval proxy (Negate p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Negate"
TT (PP p x)
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
TT (PP p x) -> m (TT (PP p x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p x) -> m (TT (PP p x))) -> TT (PP p x) -> m (TT (PP p x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (PP p x)) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
Left TT (PP p x)
e -> TT (PP p x)
e
Right PP p x
p ->
let d :: PP p x
d = PP p x -> PP p x
forall a. Num a => a -> a
negate PP p x
p
in POpts -> Val (PP p x) -> String -> [Tree PE] -> TT (PP p x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP p x -> Val (PP p x)
forall a. a -> Val a
Val PP p x
d) (POpts -> String -> PP p x -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP p x
d PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data Abs p deriving Int -> Abs p -> ShowS
[Abs p] -> ShowS
Abs p -> String
(Int -> Abs p -> ShowS)
-> (Abs p -> String) -> ([Abs p] -> ShowS) -> Show (Abs p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Abs p -> ShowS
forall k (p :: k). [Abs p] -> ShowS
forall k (p :: k). Abs p -> String
showList :: [Abs p] -> ShowS
$cshowList :: forall k (p :: k). [Abs p] -> ShowS
show :: Abs p -> String
$cshow :: forall k (p :: k). Abs p -> String
showsPrec :: Int -> Abs p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Abs p -> ShowS
Show
instance ( Num (PP p x)
, P p x
, Show (PP p x)
) => P (Abs p) x where
type PP (Abs p) x = PP p x
eval :: proxy (Abs p) -> POpts -> x -> m (TT (PP (Abs p) x))
eval proxy (Abs p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Abs"
TT (PP p x)
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
TT (PP p x) -> m (TT (PP p x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p x) -> m (TT (PP p x))) -> TT (PP p x) -> m (TT (PP p x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (PP p x)) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
Left TT (PP p x)
e -> TT (PP p x)
e
Right PP p x
p ->
let d :: PP p x
d = PP p x -> PP p x
forall a. Num a => a -> a
abs PP p x
p
in POpts -> Val (PP p x) -> String -> [Tree PE] -> TT (PP p x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP p x -> Val (PP p x)
forall a. a -> Val a
Val PP p x
d) (POpts -> String -> PP p x -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP p x
d PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data Div p q deriving Int -> Div p q -> ShowS
[Div p q] -> ShowS
Div p q -> String
(Int -> Div p q -> ShowS)
-> (Div p q -> String) -> ([Div p q] -> ShowS) -> Show (Div p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Div p q -> ShowS
forall k (p :: k) k (q :: k). [Div p q] -> ShowS
forall k (p :: k) k (q :: k). Div p q -> String
showList :: [Div p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Div p q] -> ShowS
show :: Div p q -> String
$cshow :: forall k (p :: k) k (q :: k). Div p q -> String
showsPrec :: Int -> Div p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Div p q -> ShowS
Show
instance ( PP p a ~ PP q a
, P p a
, P q a
, Show (PP p a)
, Integral (PP p a)
) => P (Div p q) a where
type PP (Div p q) a = PP p a
eval :: proxy (Div p q) -> POpts -> a -> m (TT (PP (Div p q) a))
eval proxy (Div p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"Div"
Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
Left TT (PP q a)
e -> TT (PP q a)
e
Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
in case PP q a
q of
PP q a
0 -> POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator")) String
"" [Tree PE]
hhs
PP q a
_ -> let d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Integral a => a -> a -> a
`div` PP q a
q
in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" `div` " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs
data Mod p q deriving Int -> Mod p q -> ShowS
[Mod p q] -> ShowS
Mod p q -> String
(Int -> Mod p q -> ShowS)
-> (Mod p q -> String) -> ([Mod p q] -> ShowS) -> Show (Mod p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Mod p q -> ShowS
forall k (p :: k) k (q :: k). [Mod p q] -> ShowS
forall k (p :: k) k (q :: k). Mod p q -> String
showList :: [Mod p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Mod p q] -> ShowS
show :: Mod p q -> String
$cshow :: forall k (p :: k) k (q :: k). Mod p q -> String
showsPrec :: Int -> Mod p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Mod p q -> ShowS
Show
instance ( PP p a ~ PP q a
, P p a
, P q a
, Show (PP p a)
, Integral (PP p a)
) => P (Mod p q) a where
type PP (Mod p q) a = PP p a
eval :: proxy (Mod p q) -> POpts -> a -> m (TT (PP (Mod p q) a))
eval proxy (Mod p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"Mod"
Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
Left TT (PP q a)
e -> TT (PP q a)
e
Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
in case PP q a
q of
PP q a
0 -> POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator")) String
"" [Tree PE]
hhs
PP q a
_ -> let d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Integral a => a -> a -> a
`mod` PP q a
q
in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" `mod` " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs
data DivMod p q deriving Int -> DivMod p q -> ShowS
[DivMod p q] -> ShowS
DivMod p q -> String
(Int -> DivMod p q -> ShowS)
-> (DivMod p q -> String)
-> ([DivMod p q] -> ShowS)
-> Show (DivMod p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> DivMod p q -> ShowS
forall k (p :: k) k (q :: k). [DivMod p q] -> ShowS
forall k (p :: k) k (q :: k). DivMod p q -> String
showList :: [DivMod p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [DivMod p q] -> ShowS
show :: DivMod p q -> String
$cshow :: forall k (p :: k) k (q :: k). DivMod p q -> String
showsPrec :: Int -> DivMod p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> DivMod p q -> ShowS
Show
instance ( PP p a ~ PP q a
, P p a
, P q a
, Show (PP p a)
, Integral (PP p a)
) => P (DivMod p q) a where
type PP (DivMod p q) a = (PP p a, PP p a)
eval :: proxy (DivMod p q) -> POpts -> a -> m (TT (PP (DivMod p q) a))
eval proxy (DivMod p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"DivMod"
Either
(TT (PP q a, PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP q a, PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
TT (PP q a, PP q a) -> m (TT (PP q a, PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a, PP q a) -> m (TT (PP q a, PP q a)))
-> TT (PP q a, PP q a) -> m (TT (PP q a, PP q a))
forall a b. (a -> b) -> a -> b
$ case Either
(TT (PP q a, PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
Left TT (PP q a, PP q a)
e -> TT (PP q a, PP q a)
e
Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
in case PP q a
q of
PP q a
0 -> POpts
-> Val (PP q a, PP q a)
-> String
-> [Tree PE]
-> TT (PP q a, PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a, PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator")) String
"" [Tree PE]
hhs
PP q a
_ -> let d :: (PP q a, PP q a)
d = PP q a
p PP q a -> PP q a -> (PP q a, PP q a)
forall a. Integral a => a -> a -> (a, a)
`divMod` PP q a
q
in POpts
-> Val (PP q a, PP q a)
-> String
-> [Tree PE]
-> TT (PP q a, PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP q a, PP q a) -> Val (PP q a, PP q a)
forall a. a -> Val a
Val (PP q a, PP q a)
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" `divMod` " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> (PP q a, PP q a) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (PP q a, PP q a)
d) [Tree PE]
hhs
data QuotRem p q deriving Int -> QuotRem p q -> ShowS
[QuotRem p q] -> ShowS
QuotRem p q -> String
(Int -> QuotRem p q -> ShowS)
-> (QuotRem p q -> String)
-> ([QuotRem p q] -> ShowS)
-> Show (QuotRem p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> QuotRem p q -> ShowS
forall k (p :: k) k (q :: k). [QuotRem p q] -> ShowS
forall k (p :: k) k (q :: k). QuotRem p q -> String
showList :: [QuotRem p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [QuotRem p q] -> ShowS
show :: QuotRem p q -> String
$cshow :: forall k (p :: k) k (q :: k). QuotRem p q -> String
showsPrec :: Int -> QuotRem p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> QuotRem p q -> ShowS
Show
instance ( PP p a ~ PP q a
, P p a
, P q a
, Show (PP p a)
, Integral (PP p a)
) => P (QuotRem p q) a where
type PP (QuotRem p q) a = (PP p a, PP p a)
eval :: proxy (QuotRem p q) -> POpts -> a -> m (TT (PP (QuotRem p q) a))
eval proxy (QuotRem p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"QuotRem"
Either
(TT (PP q a, PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP q a, PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
TT (PP q a, PP q a) -> m (TT (PP q a, PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a, PP q a) -> m (TT (PP q a, PP q a)))
-> TT (PP q a, PP q a) -> m (TT (PP q a, PP q a))
forall a b. (a -> b) -> a -> b
$ case Either
(TT (PP q a, PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
Left TT (PP q a, PP q a)
e -> TT (PP q a, PP q a)
e
Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
in case PP q a
q of
PP q a
0 -> POpts
-> Val (PP q a, PP q a)
-> String
-> [Tree PE]
-> TT (PP q a, PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a, PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator")) String
"" [Tree PE]
hhs
PP q a
_ -> let d :: (PP q a, PP q a)
d = PP q a
p PP q a -> PP q a -> (PP q a, PP q a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` PP q a
q
in POpts
-> Val (PP q a, PP q a)
-> String
-> [Tree PE]
-> TT (PP q a, PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP q a, PP q a) -> Val (PP q a, PP q a)
forall a. a -> Val a
Val (PP q a, PP q a)
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" `quotRem` " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> (PP q a, PP q a) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (PP q a, PP q a)
d) [Tree PE]
hhs
data Quot p q deriving Int -> Quot p q -> ShowS
[Quot p q] -> ShowS
Quot p q -> String
(Int -> Quot p q -> ShowS)
-> (Quot p q -> String) -> ([Quot p q] -> ShowS) -> Show (Quot p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Quot p q -> ShowS
forall k (p :: k) k (q :: k). [Quot p q] -> ShowS
forall k (p :: k) k (q :: k). Quot p q -> String
showList :: [Quot p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Quot p q] -> ShowS
show :: Quot p q -> String
$cshow :: forall k (p :: k) k (q :: k). Quot p q -> String
showsPrec :: Int -> Quot p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Quot p q -> ShowS
Show
type QuotT p q = QuotRem p q >> Fst
instance P (QuotT p q) x => P (Quot p q) x where
type PP (Quot p q) x = PP (QuotT p q) x
eval :: proxy (Quot p q) -> POpts -> x -> m (TT (PP (Quot p q) x))
eval proxy (Quot p q)
_ = Proxy (QuotT p q) -> POpts -> x -> m (TT (PP (QuotT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (QuotT p q)
forall k (t :: k). Proxy t
Proxy @(QuotT p q))
data Rem p q deriving Int -> Rem p q -> ShowS
[Rem p q] -> ShowS
Rem p q -> String
(Int -> Rem p q -> ShowS)
-> (Rem p q -> String) -> ([Rem p q] -> ShowS) -> Show (Rem p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Rem p q -> ShowS
forall k (p :: k) k (q :: k). [Rem p q] -> ShowS
forall k (p :: k) k (q :: k). Rem p q -> String
showList :: [Rem p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Rem p q] -> ShowS
show :: Rem p q -> String
$cshow :: forall k (p :: k) k (q :: k). Rem p q -> String
showsPrec :: Int -> Rem p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Rem p q -> ShowS
Show
type RemT p q = QuotRem p q >> Snd
instance P (RemT p q) x => P (Rem p q) x where
type PP (Rem p q) x = PP (RemT p q) x
eval :: proxy (Rem p q) -> POpts -> x -> m (TT (PP (Rem p q) x))
eval proxy (Rem p q)
_ = Proxy (RemT p q) -> POpts -> x -> m (TT (PP (RemT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (RemT p q)
forall k (t :: k). Proxy t
Proxy @(RemT p q))
data Even deriving Int -> Even -> ShowS
[Even] -> ShowS
Even -> String
(Int -> Even -> ShowS)
-> (Even -> String) -> ([Even] -> ShowS) -> Show Even
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Even] -> ShowS
$cshowList :: [Even] -> ShowS
show :: Even -> String
$cshow :: Even -> String
showsPrec :: Int -> Even -> ShowS
$cshowsPrec :: Int -> Even -> ShowS
Show
type EvenT = Mod Id 2 == 0
instance P EvenT x => P Even x where
type PP Even x = Bool
eval :: proxy Even -> POpts -> x -> m (TT (PP Even x))
eval proxy Even
_ = Proxy EvenT -> POpts -> x -> m (TT (PP EvenT x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy EvenT
forall k (t :: k). Proxy t
Proxy @EvenT)
data Odd deriving Int -> Odd -> ShowS
[Odd] -> ShowS
Odd -> String
(Int -> Odd -> ShowS)
-> (Odd -> String) -> ([Odd] -> ShowS) -> Show Odd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Odd] -> ShowS
$cshowList :: [Odd] -> ShowS
show :: Odd -> String
$cshow :: Odd -> String
showsPrec :: Int -> Odd -> ShowS
$cshowsPrec :: Int -> Odd -> ShowS
Show
type OddT = Mod Id 2 == 1
instance P OddT x => P Odd x where
type PP Odd x = Bool
eval :: proxy Odd -> POpts -> x -> m (TT (PP Odd x))
eval proxy Odd
_ = Proxy OddT -> POpts -> x -> m (TT (PP OddT x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy OddT
forall k (t :: k). Proxy t
Proxy @OddT)
data Signum p deriving Int -> Signum p -> ShowS
[Signum p] -> ShowS
Signum p -> String
(Int -> Signum p -> ShowS)
-> (Signum p -> String) -> ([Signum p] -> ShowS) -> Show (Signum p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Signum p -> ShowS
forall k (p :: k). [Signum p] -> ShowS
forall k (p :: k). Signum p -> String
showList :: [Signum p] -> ShowS
$cshowList :: forall k (p :: k). [Signum p] -> ShowS
show :: Signum p -> String
$cshow :: forall k (p :: k). Signum p -> String
showsPrec :: Int -> Signum p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Signum p -> ShowS
Show
instance ( Num (PP p x)
, P p x
, Show (PP p x)
) => P (Signum p) x where
type PP (Signum p) x = PP p x
eval :: proxy (Signum p) -> POpts -> x -> m (TT (PP (Signum p) x))
eval proxy (Signum p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Signum"
TT (PP p x)
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
TT (PP p x) -> m (TT (PP p x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p x) -> m (TT (PP p x))) -> TT (PP p x) -> m (TT (PP p x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (PP p x)) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
Left TT (PP p x)
e -> TT (PP p x)
e
Right PP p x
p ->
let d :: PP p x
d = PP p x -> PP p x
forall a. Num a => a -> a
signum PP p x
p
in POpts -> Val (PP p x) -> String -> [Tree PE] -> TT (PP p x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP p x -> Val (PP p x)
forall a. a -> Val a
Val PP p x
d) (POpts -> String -> PP p x -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP p x
d PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data ReadBase' t (n :: Nat) p deriving Int -> ReadBase' t n p -> ShowS
[ReadBase' t n p] -> ShowS
ReadBase' t n p -> String
(Int -> ReadBase' t n p -> ShowS)
-> (ReadBase' t n p -> String)
-> ([ReadBase' t n p] -> ShowS)
-> Show (ReadBase' t n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) (n :: Nat) k (p :: k).
Int -> ReadBase' t n p -> ShowS
forall k (t :: k) (n :: Nat) k (p :: k). [ReadBase' t n p] -> ShowS
forall k (t :: k) (n :: Nat) k (p :: k). ReadBase' t n p -> String
showList :: [ReadBase' t n p] -> ShowS
$cshowList :: forall k (t :: k) (n :: Nat) k (p :: k). [ReadBase' t n p] -> ShowS
show :: ReadBase' t n p -> String
$cshow :: forall k (t :: k) (n :: Nat) k (p :: k). ReadBase' t n p -> String
showsPrec :: Int -> ReadBase' t n p -> ShowS
$cshowsPrec :: forall k (t :: k) (n :: Nat) k (p :: k).
Int -> ReadBase' t n p -> ShowS
Show
instance ( Typeable (PP t x)
, BetweenT "ReadBase'" 2 36 n
, Show (PP t x)
, Num (PP t x)
, KnownNat n
, PP p x ~ String
, P p x
) => P (ReadBase' t n p) x where
type PP (ReadBase' t n p) x = PP t x
eval :: proxy (ReadBase' t n p)
-> POpts -> x -> m (TT (PP (ReadBase' t n p) x))
eval proxy (ReadBase' t n p)
_ POpts
opts x
x = do
let n :: Int
n = forall a. (KnownNat n, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n
xs :: String
xs = Int -> String
getValidBase Int
n
msg0 :: String
msg0 = String
"ReadBase(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"," String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
t :: String
t = Typeable (PP t x) => String
forall t. Typeable t => String
showT @(PP t x)
TT String
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
TT (PP t x) -> m (TT (PP t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t x) -> m (TT (PP t x))) -> TT (PP t x) -> m (TT (PP t x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (PP t x)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
Left TT (PP t x)
e -> TT (PP t x)
e
Right String
p ->
let (PP t x -> PP t x
ff,String
p1) = case String
p of
Char
'-':String
q -> (PP t x -> PP t x
forall a. Num a => a -> a
negate,String
q)
String
_ -> (PP t x -> PP t x
forall a. a -> a
id,String
p)
in case PP t x -> (Char -> Bool) -> (Char -> Int) -> ReadS (PP t x)
forall a. Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
Numeric.readInt (Int -> PP t x
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
((Char -> String -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` String
xs) (Char -> Bool) -> (Char -> Char) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower)
(String -> Maybe Int -> Int
forall a. Partial => String -> Maybe a -> a
Safe.fromJustNote String
"ReadBase" (Maybe Int -> Int) -> (Char -> Maybe Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` String
xs) (Char -> Maybe Int) -> (Char -> Char) -> Char -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
toLower)
String
p1 of
[(PP t x
b,String
"")] -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t x -> Val (PP t x)
forall a. a -> Val a
Val (PP t x -> PP t x
ff PP t x
b)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP t x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (PP t x -> PP t x
ff PP t x
b) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " String
p) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
[(PP t x, String)]
o -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP t x)
forall a. String -> Val a
Fail (String
"invalid base " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" as=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" err=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [(PP t x, String)] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [(PP t x, String)]
o) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
data ReadBase (t :: Type) (n :: Nat) deriving Int -> ReadBase t n -> ShowS
[ReadBase t n] -> ShowS
ReadBase t n -> String
(Int -> ReadBase t n -> ShowS)
-> (ReadBase t n -> String)
-> ([ReadBase t n] -> ShowS)
-> Show (ReadBase t n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t (n :: Nat). Int -> ReadBase t n -> ShowS
forall t (n :: Nat). [ReadBase t n] -> ShowS
forall t (n :: Nat). ReadBase t n -> String
showList :: [ReadBase t n] -> ShowS
$cshowList :: forall t (n :: Nat). [ReadBase t n] -> ShowS
show :: ReadBase t n -> String
$cshow :: forall t (n :: Nat). ReadBase t n -> String
showsPrec :: Int -> ReadBase t n -> ShowS
$cshowsPrec :: forall t (n :: Nat). Int -> ReadBase t n -> ShowS
Show
type ReadBaseT (t :: Type) (n :: Nat) = ReadBase' (Hole t) n Id
instance P (ReadBaseT t n) x => P (ReadBase t n) x where
type PP (ReadBase t n) x = PP (ReadBaseT t n) x
eval :: proxy (ReadBase t n) -> POpts -> x -> m (TT (PP (ReadBase t n) x))
eval proxy (ReadBase t n)
_ = Proxy (ReadBaseT t n)
-> POpts -> x -> m (TT (PP (ReadBaseT t n) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (ReadBaseT t n)
forall k (t :: k). Proxy t
Proxy @(ReadBaseT t n))
getValidBase :: Int -> String
getValidBase :: Int -> String
getValidBase Int
n =
let xs :: String
xs = [Char
'0'..Char
'9'] String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
'a'..Char
'z']
len :: Int
len = String -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
xs
in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
then ShowS
forall x. Partial => String -> x
errorInProgram ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"getValidBase: oops invalid base valid is 2 thru " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" found " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
else Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
n String
xs
data ShowBase (n :: Nat) deriving Int -> ShowBase n -> ShowS
[ShowBase n] -> ShowS
ShowBase n -> String
(Int -> ShowBase n -> ShowS)
-> (ShowBase n -> String)
-> ([ShowBase n] -> ShowS)
-> Show (ShowBase n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat). Int -> ShowBase n -> ShowS
forall (n :: Nat). [ShowBase n] -> ShowS
forall (n :: Nat). ShowBase n -> String
showList :: [ShowBase n] -> ShowS
$cshowList :: forall (n :: Nat). [ShowBase n] -> ShowS
show :: ShowBase n -> String
$cshow :: forall (n :: Nat). ShowBase n -> String
showsPrec :: Int -> ShowBase n -> ShowS
$cshowsPrec :: forall (n :: Nat). Int -> ShowBase n -> ShowS
Show
instance ( BetweenT "ShowBase" 2 36 n
, KnownNat n
, Integral x
) => P (ShowBase n) x where
type PP (ShowBase n) x = String
eval :: proxy (ShowBase n) -> POpts -> x -> m (TT (PP (ShowBase n) x))
eval proxy (ShowBase n)
_ POpts
opts x
x =
let n :: Int
n = forall a. (KnownNat n, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n
xs :: String
xs = Int -> String
getValidBase Int
n
msg0 :: String
msg0 = String
"ShowBase(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
p :: Integer
p :: Integer
p = x -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral x
x
(ShowS
ff,Integer
a') = if Integer
p Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then ((Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:), Integer -> Integer
forall a. Num a => a -> a
abs Integer
p) else (ShowS
forall a. a -> a
id,Integer
p)
b :: String
b = Integer -> (Int -> Char) -> Integer -> ShowS
forall a. (Integral a, Show a) => a -> (Int -> Char) -> a -> ShowS
Numeric.showIntAtBase (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) (String -> String -> Int -> Char
forall a. Partial => String -> [a] -> Int -> a
Safe.atNote String
"ShowBase out of range" String
xs) Integer
a' String
""
in TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT String -> m (TT String)) -> TT String -> m (TT String)
forall a b. (a -> b) -> a -> b
$ POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. a -> Val a
Val (ShowS
ff String
b)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts (ShowS
ff String
b) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> Integer -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " Integer
p) []
data ShowBaseN n p deriving Int -> ShowBaseN n p -> ShowS
[ShowBaseN n p] -> ShowS
ShowBaseN n p -> String
(Int -> ShowBaseN n p -> ShowS)
-> (ShowBaseN n p -> String)
-> ([ShowBaseN n p] -> ShowS)
-> Show (ShowBaseN n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k). Int -> ShowBaseN n p -> ShowS
forall k (n :: k) k (p :: k). [ShowBaseN n p] -> ShowS
forall k (n :: k) k (p :: k). ShowBaseN n p -> String
showList :: [ShowBaseN n p] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k). [ShowBaseN n p] -> ShowS
show :: ShowBaseN n p -> String
$cshow :: forall k (n :: k) k (p :: k). ShowBaseN n p -> String
showsPrec :: Int -> ShowBaseN n p -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k). Int -> ShowBaseN n p -> ShowS
Show
instance ( PP p x ~ a
, P p x
, PP n x ~ b
, P n x
, Integral a
, Integral b
) => P (ShowBaseN n p) x where
type PP (ShowBaseN n p) x = [Int]
eval :: proxy (ShowBaseN n p)
-> POpts -> x -> m (TT (PP (ShowBaseN n p) x))
eval proxy (ShowBaseN n p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"ShowBaseN"
Either (TT [Int]) (b, a, TT b, TT a)
lr <- Inline
-> String
-> Proxy n
-> Proxy p
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT [Int]) (PP n x, PP p x, TT (PP n x), TT (PP p x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy n
forall k (t :: k). Proxy t
Proxy @n) (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x []
TT [Int] -> m (TT [Int])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [Int] -> m (TT [Int])) -> TT [Int] -> m (TT [Int])
forall a b. (a -> b) -> a -> b
$ case Either (TT [Int]) (b, a, TT b, TT a)
lr of
Left TT [Int]
e -> TT [Int]
e
Right (b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n,a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
p,TT b
nn,TT a
pp) ->
let hhs :: [Tree PE]
hhs = [TT b -> Tree PE
forall a. TT a -> Tree PE
hh TT b
nn, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp]
in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then POpts -> Val [Int] -> String -> [Tree PE] -> TT [Int]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [Int]
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" base must be greater than 1")) String
"" [Tree PE]
hhs
else let xs :: [Int]
xs = ((Int -> [Int] -> [Int]) -> Int -> [Int] -> [Int])
-> Int -> [Int] -> [Int]
forall a. (a -> a) -> a
fix (\Int -> [Int] -> [Int]
f Int
s -> if Int
sInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
1 then [Int] -> [Int]
forall a. a -> a
id else let (Int
a,Int
b) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
s Int
n in Int -> [Int] -> [Int]
f Int
a ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
bInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)) (Int -> Int
forall a. Num a => a -> a
abs Int
p) []
in POpts -> Val [Int] -> String -> [Tree PE] -> TT [Int]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([Int] -> Val [Int]
forall a. a -> Val a
Val [Int]
xs) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> Int -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> Int -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " Int
p) [Tree PE]
hhs
data ToBits p deriving Int -> ToBits p -> ShowS
[ToBits p] -> ShowS
ToBits p -> String
(Int -> ToBits p -> ShowS)
-> (ToBits p -> String) -> ([ToBits p] -> ShowS) -> Show (ToBits p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ToBits p -> ShowS
forall k (p :: k). [ToBits p] -> ShowS
forall k (p :: k). ToBits p -> String
showList :: [ToBits p] -> ShowS
$cshowList :: forall k (p :: k). [ToBits p] -> ShowS
show :: ToBits p -> String
$cshow :: forall k (p :: k). ToBits p -> String
showsPrec :: Int -> ToBits p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ToBits p -> ShowS
Show
type ToBitsT p = ShowBaseN 2 p
instance P (ToBitsT p) x => P (ToBits p) x where
type PP (ToBits p) x = PP (ToBitsT p) x
eval :: proxy (ToBits p) -> POpts -> x -> m (TT (PP (ToBits p) x))
eval proxy (ToBits p)
_ = Proxy (ToBitsT p) -> POpts -> x -> m (TT (PP (ToBitsT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (ToBitsT p)
forall k (t :: k). Proxy t
Proxy @(ToBitsT p))
data UnShowBaseN n deriving Int -> UnShowBaseN n -> ShowS
[UnShowBaseN n] -> ShowS
UnShowBaseN n -> String
(Int -> UnShowBaseN n -> ShowS)
-> (UnShowBaseN n -> String)
-> ([UnShowBaseN n] -> ShowS)
-> Show (UnShowBaseN n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k). Int -> UnShowBaseN n -> ShowS
forall k (n :: k). [UnShowBaseN n] -> ShowS
forall k (n :: k). UnShowBaseN n -> String
showList :: [UnShowBaseN n] -> ShowS
$cshowList :: forall k (n :: k). [UnShowBaseN n] -> ShowS
show :: UnShowBaseN n -> String
$cshow :: forall k (n :: k). UnShowBaseN n -> String
showsPrec :: Int -> UnShowBaseN n -> ShowS
$cshowsPrec :: forall k (n :: k). Int -> UnShowBaseN n -> ShowS
Show
instance ( x ~ [a]
, PP n x ~ b
, P n x
, Integral a
, Integral b
) => P (UnShowBaseN n) x where
type PP (UnShowBaseN n) x = Integer
eval :: proxy (UnShowBaseN n)
-> POpts -> x -> m (TT (PP (UnShowBaseN n) x))
eval proxy (UnShowBaseN n)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"UnShowBaseN"
TT b
nn <- Proxy n -> POpts -> x -> m (TT (PP n x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy n
forall k (t :: k). Proxy t
Proxy @n) POpts
opts x
x
TT Integer -> m (TT Integer)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Integer -> m (TT Integer)) -> TT Integer -> m (TT Integer)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT b -> [Tree PE] -> Either (TT Integer) b
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT b
nn [] of
Left TT Integer
e -> TT Integer
e
Right (b -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Integer
n) ->
let xs :: [Integer]
xs = (a -> Integer) -> [a] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral x
[a]
x
hhs :: [Tree PE]
hhs = [TT b -> Tree PE
forall a. TT a -> Tree PE
hh TT b
nn]
in if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2 then POpts -> Val Integer -> String -> [Tree PE] -> TT Integer
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val Integer
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" base must be greater than 1")) String
"" [Tree PE]
hhs
else let b :: Integer
b = (Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd ((Integer, Integer) -> Integer) -> (Integer, Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> (Integer, Integer) -> (Integer, Integer))
-> (Integer, Integer) -> [Integer] -> (Integer, Integer)
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Integer
a (Integer
m,Integer
tot) -> (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
n, Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
tot)) (Integer
1,Integer
0) [Integer]
xs
in POpts -> Val Integer -> String -> [Tree PE] -> TT Integer
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Integer -> Val Integer
forall a. a -> Val a
Val Integer
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> Integer -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " Integer
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [Integer] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [Integer]
xs) [Tree PE]
hhs
data RoundUp n p deriving Int -> RoundUp n p -> ShowS
[RoundUp n p] -> ShowS
RoundUp n p -> String
(Int -> RoundUp n p -> ShowS)
-> (RoundUp n p -> String)
-> ([RoundUp n p] -> ShowS)
-> Show (RoundUp n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k). Int -> RoundUp n p -> ShowS
forall k (n :: k) k (p :: k). [RoundUp n p] -> ShowS
forall k (n :: k) k (p :: k). RoundUp n p -> String
showList :: [RoundUp n p] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k). [RoundUp n p] -> ShowS
show :: RoundUp n p -> String
$cshow :: forall k (n :: k) k (p :: k). RoundUp n p -> String
showsPrec :: Int -> RoundUp n p -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k). Int -> RoundUp n p -> ShowS
Show
instance ( Integral (PP n x)
, Show (PP n x)
, PP n x ~ PP p x
, P n x
, P p x
) => P (RoundUp n p) x where
type PP (RoundUp n p) x = PP n x
eval :: proxy (RoundUp n p) -> POpts -> x -> m (TT (PP (RoundUp n p) x))
eval proxy (RoundUp n p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"RoundUp"
Either (TT (PP p x)) (PP p x, PP p x, TT (PP p x), TT (PP p x))
lr <- Inline
-> String
-> Proxy n
-> Proxy p
-> POpts
-> x
-> [Tree PE]
-> m (Either
(TT (PP p x)) (PP n x, PP p x, TT (PP n x), TT (PP p x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy n
forall k (t :: k). Proxy t
Proxy @n) (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x []
TT (PP p x) -> m (TT (PP p x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p x) -> m (TT (PP p x))) -> TT (PP p x) -> m (TT (PP p x))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP p x)) (PP p x, PP p x, TT (PP p x), TT (PP p x))
lr of
Left TT (PP p x)
e -> TT (PP p x)
e
Right (PP p x
n,PP p x
p,TT (PP p x)
nn,TT (PP p x)
pp) ->
let hhs :: [Tree PE]
hhs = [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
nn, TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
d :: PP p x
d = (PP p x
nPP p x -> PP p x -> PP p x
forall a. Num a => a -> a -> a
-PP p x
p) PP p x -> PP p x -> PP p x
forall a. Integral a => a -> a -> a
`mod` PP p x
n
in if PP p x
n PP p x -> PP p x -> Bool
forall a. Eq a => a -> a -> Bool
== PP p x
0 then POpts -> Val (PP p x) -> String -> [Tree PE] -> TT (PP p x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP p x)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" 'n' cannot be zero")) String
"" [Tree PE]
hhs
else POpts -> Val (PP p x) -> String -> [Tree PE] -> TT (PP p x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP p x -> Val (PP p x)
forall a. a -> Val a
Val PP p x
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PP p x -> String
forall a. Show a => a -> String
show PP p x
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PP p x -> String
forall a. Show a => a -> String
show PP p x
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PP p x -> String
forall a. Show a => a -> String
show PP p x
d) [Tree PE]
hhs