module Sound.DF.Uniform.GADT.DF where
import Data.Int
import Data.Typeable
import Data.Digest.Murmur32
import Sound.DF.Uniform.LL
import Sound.DF.Uniform.UDF
data DF a where
K :: K' a => a -> DF a
A :: Vec Float -> DF (Vec Float)
R :: K' a => R_Id -> TypeRep -> Either a (DF b,DF a) -> DF b
P0 :: K' a => String -> TypeRep -> DF a
P1 :: (K' a,K' b) => String -> TypeRep -> DF a -> DF b
P2 :: (K' a,K' b,K' c) => String -> TypeRep -> DF a -> DF b -> DF c
P3 :: (K' a,K' b,K' c,K' d) =>
String -> TypeRep -> DF a -> DF b -> DF c -> DF d
M :: K' a => DF a -> DF () -> DF a
deriving instance Show a => Show (DF a)
df_typeOf :: K' a => DF a -> TypeRep
df_typeOf df =
case df of
K k -> typeOf k
A _ -> vec_float_t
R _ t _ -> t
P0 _ t -> t
P1 _ t _ -> t
P2 _ t _ _ -> t
P3 _ t _ _ _ -> t
M n _ -> df_typeOf n
instance K' a => Typeable (DF a) where typeOf = df_typeOf
df_primitive :: DF a -> Maybe String
df_primitive df =
case df of
P0 nm _ -> Just nm
P1 nm _ _ -> Just nm
P2 nm _ _ _ -> Just nm
P3 nm _ _ _ _ -> Just nm
_ -> Nothing
mrg :: K' a => DF a -> DF () -> DF a
mrg = M
df_vec :: V_Id -> [Float] -> DF (Vec Float)
df_vec k v = A (Vec k (length v) v)
df_vec_m :: UId m => [Float] -> m (DF (Vec Float))
df_vec_m v = do
k <- generateId
return (df_vec (V_Id k) v)
df_vec_size :: DF a -> Maybe Int
df_vec_size df =
case df of
A (Vec _ n _) -> Just n
_ -> Nothing
df_tbl_size :: DF a -> Maybe Int
df_tbl_size = fmap (+ (1)) . df_vec_size
type Unary_Op a = a -> a
type Binary_Op a = a -> a -> a
type Ternary_Op a = a -> a -> a -> a
type Quaternary_Op a = a -> a -> a -> a -> a
type Quinary_Op a = a -> a -> a -> a -> a -> a
type Senary_Op a = a -> a -> a -> a -> a -> a -> a
type Binary_Fn i o = i -> i -> o
mk_uop :: (K' a) => String -> Unary_Op (DF a)
mk_uop nm p = P1 nm (df_typeOf p) p
mk_binop :: K' a => String -> Binary_Op (DF a)
mk_binop nm p q = P2 nm (df_typeOf p) p q
mk_ternaryop :: K' a => String -> Ternary_Op (DF a)
mk_ternaryop nm p q r = P3 nm (df_typeOf p) p q r
df_mul_add :: K_Num a => DF a -> DF a -> DF a -> DF a
df_mul_add = mk_ternaryop "df_mul_add"
df_add_optimise :: K_Num a => DF a -> DF a -> DF a
df_add_optimise p q =
case (p,q) of
(P2 "df_mul" t l r,_) -> P3 "df_mul_add" t l r q
(_,P2 "df_mul" t l r) -> P3 "df_mul_add" t l r p
_ -> mk_binop "df_add" p q
instance K_Num a => Num (DF a) where
(+) = df_add_optimise
(*) = mk_binop "df_mul"
() = mk_binop "df_sub"
negate = mk_uop "df_negate"
abs = mk_uop "df_abs"
signum = mk_uop "df_signum"
fromInteger = K . fromInteger
instance Fractional (DF Float) where
(/) = P2 "df_div" float_t
recip = P1 "df_recip" float_t
fromRational = K . fromRational
instance Floating (DF Float) where
pi = K pi
exp = P1 "df_exp" float_t
sqrt = P1 "df_sqrt" float_t
log = P1 "df_log" float_t
(**) = P2 "df_pow" float_t
logBase = undefined
sin = P1 "df_sin" float_t
tan = P1 "df_tan" float_t
cos = P1 "df_cos" float_t
asin = undefined
atan = undefined
acos = undefined
sinh = undefined
tanh = undefined
cosh = undefined
asinh = undefined
atanh = undefined
acosh = undefined
df_bw_and :: DF Int32 -> DF Int32 -> DF Int32
df_bw_and = P2 "df_bw_and" int32_t
df_bw_or :: DF Int32 -> DF Int32 -> DF Int32
df_bw_or = P2 "df_bw_or" int32_t
df_bw_not :: DF Int32 -> DF Int32
df_bw_not = P1 "df_bw_not" int32_t
df_eq :: K_Ord a => DF a -> DF a -> DF Bool
df_eq = P2 "df_eq" bool_t
df_lt :: K_Ord a => DF a -> DF a -> DF Bool
df_lt = P2 "df_lt" bool_t
df_gte :: K_Ord a => DF a -> DF a -> DF Bool
df_gte = P2 "df_gte" bool_t
df_gt :: K_Ord a => DF a -> DF a -> DF Bool
df_gt = P2 "df_gt" bool_t
df_lte :: K_Ord a => DF a -> DF a -> DF Bool
df_lte = P2 "df_lte" bool_t
df_max :: K_Ord a => DF a -> DF a -> DF a
df_max = mk_binop "df_max"
df_min :: K_Ord a => DF a -> DF a -> DF a
df_min = mk_binop "df_min"
df_float_to_int32 :: DF Float -> DF Int32
df_float_to_int32 = P1 "df_float_to_int32" int32_t
df_int32_to_float :: DF Int32 -> DF Float
df_int32_to_float = P1 "df_int32_to_float" float_t
i32_to_normal_f32 :: DF Int32 -> DF Float
i32_to_normal_f32 = (/ 2147483647) . df_int32_to_float
df_mod :: Binary_Op (DF Int32)
df_mod = P2 "df_mod" int32_t
df_fmodf :: Binary_Op (DF Float)
df_fmodf = P2 "df_fmodf" float_t
df_ceilf :: DF Float -> DF Float
df_ceilf = P1 "df_ceilf" float_t
df_floorf :: DF Float -> DF Float
df_floorf = P1 "df_floorf" float_t
df_lrintf :: DF Float -> DF Int32
df_lrintf = P1 "df_lrintf" int32_t
df_roundf :: DF Float -> DF Float
df_roundf = P1 "df_roundf" float_t
rec_r :: K' a => R_Id -> a -> (DF a -> (DF b,DF a)) -> DF b
rec_r n y0 f =
let t = typeOf y0
i = R n t (Left y0)
in R n t (Right (f i))
rec_m :: (K' a,UId m) => a -> (DF a -> (DF b,DF a)) -> m (DF b)
rec_m y0 f = do
n <- generateId
return (rec_r (R_Id n) y0 f)
rec_h :: (K' a,Show b) => a -> (DF a -> (DF b,DF a)) -> DF b
rec_h y0 f =
let n = abs (fromIntegral (asWord32 (hash32 (show (f (K y0))))))
in rec_r (R_Id n) y0 f
rec_mM :: (K' a,UId m) => a -> (DF a -> m (DF b,DF a)) -> m (DF b)
rec_mM i f = do
n <- generateId
let t = typeOf i
r_r = R (R_Id n) t (Left i)
r <- f r_r
return (R (R_Id n) t (Right r))
in1 :: DF Float
in1 = P0 "df_in1" float_t
out1 :: DF Float -> DF ()
out1 = P1 "df_out1" nil_t
out2 :: DF Float -> DF Float -> DF ()
out2 = P2 "df_out2" nil_t
out3 :: DF Float -> DF Float -> DF Float -> DF ()
out3 = P3 "df_out3" nil_t
ctl1 :: DF Int32 -> DF Float
ctl1 = P1 "df_ctl1" float_t
df_and :: DF Bool -> DF Bool -> DF Bool
df_and = P2 "df_and" bool_t
df_or :: DF Bool -> DF Bool -> DF Bool
df_or = P2 "df_or" bool_t
df_not :: DF Bool -> DF Bool
df_not = P1 "df_not" bool_t
select2 :: K' a => DF Bool -> DF a -> DF a -> DF a
select2 p q = P3 "df_select2" (df_typeOf q) p q
w_sample_rate :: DF Float
w_sample_rate = P0 "df_sample_rate" float_t
w_kr_nframes :: DF Int32
w_kr_nframes = P0 "df_kr_nframes" int32_t
w_kr_edge :: DF Bool
w_kr_edge = P0 "df_kr_edge" bool_t
b_read :: DF Int32 -> DF Int32 -> DF Float
b_read = P2 "df_b_read" float_t
b_write :: DF Int32 -> DF Int32 -> DF Float -> DF ()
b_write = P3 "df_b_write" nil_t
a_read :: DF (Vec Float)-> DF Int32 -> DF Float
a_read = P2 "df_a_read" float_t
a_write :: DF (Vec Float) -> DF Int32 -> DF Float -> DF ()
a_write = P3 "df_a_write" nil_t
df_erase :: K' a => DF a -> UDF
df_erase n =
case n of
K i -> UDF_K (to_k i)
A a -> UDF_A a
R k _ (Left i) -> UDF_R k (Left (to_k i))
R k _ (Right (i,j)) -> UDF_R k (Right (df_erase i,df_erase j))
P0 nm t -> UDF_P nm t []
P1 nm t i -> UDF_P nm t [df_erase i]
P2 nm t i j -> UDF_P nm t [df_erase i,df_erase j]
P3 nm t i j k -> UDF_P nm t [df_erase i,df_erase j,df_erase k]
M i j -> UDF_M (df_erase i) (df_erase j)