{-# LANGUAGE NoImplicitPrelude #-}
module Synthesizer.Plain.ToneModulation (
Cell,
interpolateCell,
Prototype,
makePrototype,
sampledToneCell,
oscillatorCells,
seekCell,
oscillatorSuffixes,
freqsToPhases,
dropFrac,
dropRem,
propDropFrac,
propDropRem,
oscillatorCoords,
integrateFractional,
limitRelativeShapes,
limitMinRelativeValues,
limitMaxRelativeValues,
limitMaxRelativeValuesNonNeg,
) where
import qualified Synthesizer.Basic.ToneModulation as ToneMod
import qualified Synthesizer.Basic.Phase as Phase
import qualified Synthesizer.Plain.Signal as Sig
import qualified Synthesizer.Plain.Interpolation as Interpolation
import Synthesizer.Interpolation (Margin, )
import Control.Monad (guard, )
import qualified Data.List as List
import qualified Data.List.HT as ListHT
import qualified Data.List.Match as ListMatch
import Data.Array (Array, (!), listArray, )
import Data.Tuple.HT (mapPair, mapSnd, forcePair, )
import Data.Ord.HT (limit, )
import qualified Algebra.RealField as RealField
import qualified Algebra.RealRing as RealRing
import qualified Algebra.Ring as Ring
import qualified Algebra.Additive as Additive
import qualified Number.NonNegative as NonNeg
import qualified Number.NonNegativeChunky as Chunky
import NumericPrelude.Numeric
import NumericPrelude.Base
type Cell y = Sig.T (Sig.T y)
interpolateCell ::
Interpolation.T a y ->
Interpolation.T b y ->
(a, b) ->
Cell y -> y
interpolateCell :: forall a y b. T a y -> T b y -> (a, b) -> Cell y -> y
interpolateCell T a y
ipLeap T b y
ipStep (a
qLeap,b
qStep) =
forall t y. T t y -> t -> T y -> y
Interpolation.func T b y
ipStep b
qStep forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. (a -> b) -> [a] -> [b]
map (forall t y. T t y -> t -> T y -> y
Interpolation.func T a y
ipLeap a
qLeap)
data Prototype t y =
Prototype {
forall t y. Prototype t y -> Margin
protoMarginLeap,
forall t y. Prototype t y -> Margin
protoMarginStep :: Margin,
forall t y. Prototype t y -> Int
protoIpOffset :: Int,
forall t y. Prototype t y -> t
protoPeriod :: t,
forall t y. Prototype t y -> Int
protoPeriodInt :: Int,
forall t y. Prototype t y -> (t, t)
protoShapeLimits :: (t,t),
forall t y. Prototype t y -> Array Int y
protoArray :: Array Int y
}
makePrototype :: (RealField.C t) =>
Margin ->
Margin ->
Int -> t -> Sig.T y -> Prototype t y
makePrototype :: forall t y.
C t =>
Margin -> Margin -> Int -> t -> T y -> Prototype t y
makePrototype Margin
marginLeap Margin
marginStep Int
periodInt t
period T y
tone =
let ipOffset :: Int
ipOffset =
Margin -> Margin -> Int -> Int
ToneMod.interpolationOffset Margin
marginLeap Margin
marginStep Int
periodInt
len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length T y
tone
(Int
lower,Int
upper) =
forall t. C t => Margin -> Margin -> Int -> t -> (t, t)
ToneMod.shapeLimits Margin
marginLeap Margin
marginStep Int
periodInt Int
len
limits :: (t, t)
limits =
if Int
lower forall a. Ord a => a -> a -> Bool
> Int
upper
then forall a. HasCallStack => [Char] -> a
error [Char]
"min>max"
else (forall a b. (C a, C b) => a -> b
fromIntegral Int
lower, forall a b. (C a, C b) => a -> b
fromIntegral Int
upper)
in Prototype {
protoMarginLeap :: Margin
protoMarginLeap = Margin
marginLeap,
protoMarginStep :: Margin
protoMarginStep = Margin
marginStep,
protoIpOffset :: Int
protoIpOffset = Int
ipOffset,
protoPeriod :: t
protoPeriod = t
period,
protoPeriodInt :: Int
protoPeriodInt = Int
periodInt,
protoShapeLimits :: (t, t)
protoShapeLimits = (t, t)
limits,
protoArray :: Array Int y
protoArray = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0, forall a. Enum a => a -> a
pred Int
len) T y
tone
}
sampledToneCell :: (RealField.C t) =>
Prototype t y -> t -> Phase.T t -> ((t,t), Cell y)
sampledToneCell :: forall t y. C t => Prototype t y -> t -> T t -> ((t, t), Cell y)
sampledToneCell Prototype t y
p t
shape T t
phase =
let (Int
n, (t, t)
q) =
forall a. C a => Int -> a -> (a, T a) -> (Int, (a, a))
ToneMod.flattenShapePhase (forall t y. Prototype t y -> Int
protoPeriodInt Prototype t y
p) (forall t y. Prototype t y -> t
protoPeriod Prototype t y
p)
(forall a. Ord a => (a, a) -> a -> a
limit (forall t y. Prototype t y -> (t, t)
protoShapeLimits Prototype t y
p) t
shape, T t
phase)
in ((t, t)
q,
forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (forall t y. Prototype t y -> Array Int y
protoArray Prototype t y
p forall i e. Ix i => Array i e -> i -> e
! ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a) -> a -> [a]
iterate (forall t y. Prototype t y -> Int
protoPeriodInt Prototype t y
p forall a. C a => a -> a -> a
+)) forall a b. (a -> b) -> a -> b
$
forall a. Enum a => a -> [a]
enumFrom (Int
n forall a. C a => a -> a -> a
- forall t y. Prototype t y -> Int
protoIpOffset Prototype t y
p))
oscillatorCells :: (RealField.C t) =>
Margin ->
Margin ->
Int -> t ->
Sig.T y -> (t, Sig.T t) -> (Phase.T t, Sig.T t) -> Sig.T ((t,t), Cell y)
oscillatorCells :: forall t y.
C t =>
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> T ((t, t), Cell y)
oscillatorCells
Margin
marginLeap Margin
marginStep Int
periodInt t
period T y
sampledTone (t, T t)
shapes (T t, T t)
freqs =
forall a b. (a -> b) -> [a] -> [b]
map (forall t y.
C t =>
Int -> t -> ((t, T t), Cell y) -> ((t, t), Cell y)
seekCell Int
periodInt t
period) forall a b. (a -> b) -> a -> b
$
forall t y.
C t =>
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> T ((t, T t), Cell y)
oscillatorSuffixes
Margin
marginLeap Margin
marginStep Int
periodInt t
period T y
sampledTone (t, T t)
shapes (T t, T t)
freqs
seekCell :: (RealField.C t) =>
Int -> t ->
((t, Phase.T t), Cell y) -> ((t,t), Cell y)
seekCell :: forall t y.
C t =>
Int -> t -> ((t, T t), Cell y) -> ((t, t), Cell y)
seekCell Int
periodInt t
period =
(\((t, T t)
coords, Cell y
ptr) ->
let (Int
k,(t, t)
q) = forall a. C a => Int -> a -> (a, T a) -> (Int, (a, a))
ToneMod.flattenShapePhase Int
periodInt t
period (t, T t)
coords
in if Int
kforall a. Ord a => a -> a -> Bool
>Int
0
then forall a. HasCallStack => [Char] -> a
error [Char]
"ToneModulation.oscillatorCells: k>0"
else ((t, t)
q, forall a. Int -> [a] -> [a]
drop (Int
periodIntforall a. C a => a -> a -> a
+Int
k) Cell y
ptr))
oscillatorSuffixes :: (RealField.C t) =>
Margin ->
Margin ->
Int -> t -> Sig.T y ->
(t, Sig.T t) -> (Phase.T t, Sig.T t) ->
Sig.T ((t, Phase.T t), Cell y)
oscillatorSuffixes :: forall t y.
C t =>
Margin
-> Margin
-> Int
-> t
-> T y
-> (t, T t)
-> (T t, T t)
-> T ((t, T t), Cell y)
oscillatorSuffixes
Margin
marginLeap Margin
marginStep Int
periodInt t
period T y
sampledTone (t, T t)
shapes (T t, T t)
freqs =
let ptrs :: [T y]
ptrs =
forall a. [[a]] -> [[a]]
List.transpose forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$
forall a. (a -> a) -> a -> [a]
iterate (forall a. Int -> [a] -> [a]
drop Int
periodInt) T y
sampledTone
ipOffset :: Int
ipOffset =
Int
periodInt forall a. C a => a -> a -> a
+
Margin -> Margin -> Int -> Int
ToneMod.interpolationOffset Margin
marginLeap Margin
marginStep Int
periodInt
(Int
skip:[Int]
skips,[(t, T t)]
coords) =
forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$
forall t. C t => t -> (t, T t) -> (T t, T t) -> T (Skip t)
integrateFractional t
period
(forall t y.
(C t, Ord t) =>
Margin -> Margin -> Int -> T y -> (t, T t) -> (t, T t)
limitRelativeShapes Margin
marginLeap Margin
marginStep Int
periodInt T y
sampledTone (t, T t)
shapes)
(T t, T t)
freqs
in forall a b. [a] -> [b] -> [(a, b)]
zip [(t, T t)]
coords forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
n,[T y]
ptr) ->
if Int
nforall a. Ord a => a -> a -> Bool
>Int
0
then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"ToneModulation.oscillatorCells: " forall a. [a] -> [a] -> [a]
++
[Char]
"limit of shape parameter is buggy"
else [T y]
ptr) forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
(\ (Int
n,[T y]
ptr0) Int
d0 -> forall a. Int -> T a -> (Int, T a)
dropRem (Int
nforall a. C a => a -> a -> a
+Int
d0) [T y]
ptr0)
(Int
0,[T y]
ptrs)
((Int
skip forall a. C a => a -> a -> a
- Int
ipOffset) forall a. a -> [a] -> [a]
: [Int]
skips)
dropFrac :: RealField.C i => i -> Sig.T a -> (Int, i, Sig.T a)
dropFrac :: forall i a. C i => i -> T a -> (Int, i, T a)
dropFrac =
let recourse :: a -> b -> [a] -> (a, b, [a])
recourse a
acc b
n [a]
xt =
if b
nforall a. Ord a => a -> a -> Bool
>=b
1
then
case [a]
xt of
a
_:[a]
xs -> a -> b -> [a] -> (a, b, [a])
recourse (forall a. Enum a => a -> a
succ a
acc) (b
nforall a. C a => a -> a -> a
-b
1) [a]
xs
[] -> (a
acc, b
n, [])
else (a
acc,b
n,[a]
xt)
in forall {b} {a} {a}.
(Ord b, C b, Enum a) =>
a -> b -> [a] -> (a, b, [a])
recourse Int
0
dropFrac' :: RealField.C i => i -> Sig.T a -> (Int, i, Sig.T a)
dropFrac' :: forall i a. C i => i -> T a -> (Int, i, T a)
dropFrac' =
let recourse :: t -> a -> [a] -> (t, a, [a])
recourse t
acc a
n [a]
xt =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(t
acc,a
n,[a]
xt)
(t -> a -> [a] -> (t, a, [a])
recourse (forall a. Enum a => a -> a
succ t
acc) (a
nforall a. C a => a -> a -> a
-a
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
(forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
nforall a. Ord a => a -> a -> Bool
>=a
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. [a] -> Maybe (a, [a])
ListHT.viewL [a]
xt)
in forall {t} {a} {a}.
(Enum t, C a, Ord a) =>
t -> a -> [a] -> (t, a, [a])
recourse Int
0
propDropFrac :: (RealField.C i, Eq a) => i -> Sig.T a -> Bool
propDropFrac :: forall i a. (C i, Eq a) => i -> T a -> Bool
propDropFrac i
n T a
xs =
forall i a. C i => i -> T a -> (Int, i, T a)
dropFrac i
n T a
xs forall a. Eq a => a -> a -> Bool
== forall i a. C i => i -> T a -> (Int, i, T a)
dropFrac' i
n T a
xs
dropRem :: Int -> Sig.T a -> (Int, Sig.T a)
dropRem :: forall a. Int -> T a -> (Int, T a)
dropRem =
let recourse :: a -> [a] -> (a, [a])
recourse a
n [a]
xt =
if a
nforall a. Ord a => a -> a -> Bool
>a
0
then
case [a]
xt of
a
_:[a]
xs -> a -> [a] -> (a, [a])
recourse (forall a. Enum a => a -> a
pred a
n) [a]
xs
[] -> (a
n, [])
else (a
n,[a]
xt)
in forall {a} {a}. (Ord a, C a, Enum a) => a -> [a] -> (a, [a])
recourse
dropRem' :: Int -> Sig.T a -> (Int, Sig.T a)
dropRem' :: forall a. Int -> T a -> (Int, T a)
dropRem' =
let recourse :: a -> [a] -> (a, [a])
recourse a
n [a]
xt =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(a
n,[a]
xt)
(a -> [a] -> (a, [a])
recourse (forall a. Enum a => a -> a
pred a
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
(forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
nforall a. Ord a => a -> a -> Bool
>a
0) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. [a] -> Maybe (a, [a])
ListHT.viewL [a]
xt)
in forall {a} {a}. (Enum a, Ord a, C a) => a -> [a] -> (a, [a])
recourse
propDropRem :: (Eq a) => Int -> Sig.T a -> Bool
propDropRem :: forall a. Eq a => Int -> T a -> Bool
propDropRem Int
n T a
xs =
forall a. Int -> T a -> (Int, T a)
dropRem Int
n T a
xs forall a. Eq a => a -> a -> Bool
== forall a. Int -> T a -> (Int, T a)
dropRem' Int
n T a
xs
oscillatorCoords :: (RealField.C t) =>
Int -> t -> (t, Sig.T t) -> (Phase.T t, Sig.T t) -> Sig.T (ToneMod.Coords t)
oscillatorCoords :: forall t. C t => Int -> t -> (t, T t) -> (T t, T t) -> T (Coords t)
oscillatorCoords Int
periodInt t
period (t, T t)
shapes (T t, T t)
freqs =
forall a b. (a -> b) -> [a] -> [b]
map (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a. C a => Int -> a -> (a, T a) -> (Int, (a, a))
ToneMod.flattenShapePhase Int
periodInt t
period)) forall a b. (a -> b) -> a -> b
$
forall t. C t => t -> (t, T t) -> (T t, T t) -> T (Skip t)
integrateFractional t
period (t, T t)
shapes (T t, T t)
freqs
integrateFractional :: (RealField.C t) =>
t -> (t, Sig.T t) -> (Phase.T t, Sig.T t) -> Sig.T (ToneMod.Skip t)
integrateFractional :: forall t. C t => t -> (t, T t) -> (T t, T t) -> T (Skip t)
integrateFractional t
period (t
shape0, T t
shapes) (T t
phase, T t
freqs) =
let shapeOffsets :: [(Int, t)]
shapeOffsets =
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl
(\(Int
_,t
s) t
c -> forall a b. (C a, C b) => a -> (b, a)
splitFraction (t
sforall a. C a => a -> a -> a
+t
c))
(forall a b. (C a, C b) => a -> (b, a)
splitFraction t
shape0) T t
shapes
phases :: T (T t)
phases =
let (t
s:T t
ss) = forall a b. (a -> b) -> [a] -> [b]
map (\(Int
n,t
_) -> forall a b. (C a, C b) => a -> b
fromIntegral Int
n forall a. C a => a -> a -> a
/ t
period) [(Int, t)]
shapeOffsets
in forall a. C a => T a -> T a -> T (T a)
freqsToPhases
(forall a. C a => a -> T a -> T a
Phase.decrement t
s T t
phase)
(forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) T t
freqs T t
ss)
in forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(\(Int
d,t
s) T t
p -> (Int
d, (t
s,T t
p)))
[(Int, t)]
shapeOffsets
T (T t)
phases
freqsToPhases :: RealRing.C a => Phase.T a -> Sig.T a -> Sig.T (Phase.T a)
freqsToPhases :: forall a. C a => T a -> T a -> T (T a)
freqsToPhases T a
phase T a
freq = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. C a => a -> T a -> T a
Phase.increment) T a
phase T a
freq
limitRelativeShapes :: (Ring.C t, Ord t) =>
Margin ->
Margin ->
Int -> Sig.T y -> (t, Sig.T t) -> (t, Sig.T t)
limitRelativeShapes :: forall t y.
(C t, Ord t) =>
Margin -> Margin -> Int -> T y -> (t, T t) -> (t, T t)
limitRelativeShapes Margin
marginLeap Margin
marginStep Int
periodInt T y
sampledTone =
let
len :: T (T t)
len = forall a. C a => [a] -> T a
Chunky.fromChunks (forall a b. [a] -> b -> [b]
ListMatch.replicate T y
sampledTone forall a. C a => a
one)
(T (T t)
minShape, T (T t)
maxShape) =
forall t. C t => Margin -> Margin -> Int -> t -> (t, t)
ToneMod.shapeLimits Margin
marginLeap Margin
marginStep Int
periodInt T (T t)
len
fromChunky :: T (T t) -> t
fromChunky = forall a. T a -> a
NonNeg.toNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. C a => T a -> a
Chunky.toNumber
toChunky :: t -> T (T t)
toChunky = forall a. C a => a -> T a
Chunky.fromNumber forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Ord a, C a) => a -> T a
NonNeg.fromNumber
in forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (T (T t) -> t
fromChunky, forall a b. (a -> b) -> [a] -> [b]
map T (T t) -> t
fromChunky) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMaxRelativeValuesNonNeg T (T t)
maxShape) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (t -> T (T t)
toChunky, forall a b. (a -> b) -> [a] -> [b]
map t -> T (T t)
toChunky) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMinRelativeValues (T (T t) -> t
fromChunky T (T t)
minShape))
limitMinRelativeValues :: (Additive.C a, Ord a) =>
a -> a -> Sig.T a -> (a, Sig.T a)
limitMinRelativeValues :: forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMinRelativeValues a
xMin a
x0 T a
xs =
let ([(a, a)]
ys,[(a, a)]
zs) =
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Ord a => a -> a -> Bool
<forall a. C a => a
zero)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) (forall a b. [a] -> [b] -> [(a, b)]
zip (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. C a => a -> a -> a
(+) (a
x0forall a. C a => a -> a -> a
-a
xMin) T a
xs) (a
x0forall a. a -> [a] -> [a]
:T a
xs))
in case [(a, a)]
ys of
[] -> (a
x0,T a
xs)
((a, a)
_:[(a, a)]
yr) -> (a
xMin, forall a b. [a] -> b -> [b]
ListMatch.replicate [(a, a)]
yr forall a. C a => a
zero forall a. [a] -> [a] -> [a]
++
case [(a, a)]
zs of
[] -> []
((a, a)
z:[(a, a)]
zr) -> forall a b. (a, b) -> a
fst (a, a)
z forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(a, a)]
zr)
limitMaxRelativeValues :: (Additive.C a, Ord a) =>
a -> a -> Sig.T a -> (a, Sig.T a)
limitMaxRelativeValues :: forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMaxRelativeValues a
xMax a
x0 T a
xs =
let (T a
ys,T a
zs) =
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Ord a => a -> a -> Bool
>forall a. C a => a
zero) (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (-) (a
xMaxforall a. C a => a -> a -> a
-a
x0) T a
xs)
in forall a b. (a, b) -> (a, b)
forcePair forall a b. (a -> b) -> a -> b
$
forall b a. b -> ([a] -> a -> b) -> [a] -> b
ListHT.switchR
(a
xMax, forall a b. [a] -> b -> [b]
ListMatch.replicate T a
xs forall a. C a => a
zero)
(\ T a
yl a
yr -> (a
x0, forall b a. [b] -> [a] -> [a]
ListMatch.take T a
yl T a
xs forall a. [a] -> [a] -> [a]
++ forall b a. [b] -> [a] -> [a]
ListMatch.take T a
zs (a
yr forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat forall a. C a => a
zero)))
T a
ys
limitMaxRelativeValuesNonNeg :: (Additive.C a, Ord a) =>
a -> a -> Sig.T a -> (a, Sig.T a)
limitMaxRelativeValuesNonNeg :: forall a. (C a, Ord a) => a -> a -> T a -> (a, T a)
limitMaxRelativeValuesNonNeg a
xMax a
x0 T a
xs =
let ([(Bool, a)]
ys,[(Bool, a)]
zs) =
forall a. (a -> Bool) -> [a] -> ([a], [a])
span forall a b. (a, b) -> a
fst (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\(Bool
_,a
acc) a
d -> forall a. (C a, Ord a) => a -> a -> (Bool, a)
safeSub a
acc a
d) (forall a. (C a, Ord a) => a -> a -> (Bool, a)
safeSub a
xMax a
x0) T a
xs)
in forall a b. (a, b) -> (a, b)
forcePair forall a b. (a -> b) -> a -> b
$
forall b a. b -> ([a] -> a -> b) -> [a] -> b
ListHT.switchR
(a
xMax, forall a b. [a] -> b -> [b]
ListMatch.replicate T a
xs forall a. C a => a
zero)
(\ [(Bool, a)]
yl ~(Bool
_,a
yr) -> (a
x0, forall b a. [b] -> [a] -> [a]
ListMatch.take [(Bool, a)]
yl T a
xs forall a. [a] -> [a] -> [a]
++ forall b a. [b] -> [a] -> [a]
ListMatch.take [(Bool, a)]
zs (a
yr forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat forall a. C a => a
zero)))
[(Bool, a)]
ys
safeSub :: (Additive.C a, Ord a) => a -> a -> (Bool, a)
safeSub :: forall a. (C a, Ord a) => a -> a -> (Bool, a)
safeSub a
a a
b = (a
aforall a. Ord a => a -> a -> Bool
>=a
b, a
aforall a. C a => a -> a -> a
-a
b)