module Sound.DF.Uniform.PhT.Node where
import Data.Bits
import Data.Int
import Data.Typeable
import Sound.DF.Uniform.LL
import Sound.DF.Uniform.UDF
data KT ty = KT {kt_k :: K} deriving (Eq)
data DF ty = DF {df_udf :: UDF} deriving (Eq)
k_Int32 :: Int32 -> KT Int32
k_Int32 = KT . I
k_Float :: Float -> KT Float
k_Float = KT . F
k_zero :: KT ty
k_zero = KT (F 0)
df_Int32 :: Int32 -> DF Int32
df_Int32 = DF . UDF_K . I
df_Float :: Float -> DF Float
df_Float = DF . UDF_K . F
df_tbl_size :: DF a -> Maybe Int
df_tbl_size df =
case df of
DF (UDF_A (Vec _ k _)) -> Just (k 1)
_ -> Nothing
mrg :: DF a -> DF () -> DF a
mrg p q = DF (UDF_M (df_udf p) (df_udf q))
df_type :: DF a -> TypeRep
df_type = udf_typeOf . df_udf
mk_a :: String -> [DF a] -> TypeRep -> DF ty
mk_a s i ty = DF (UDF_P s ty (map df_udf i))
unary_operator :: String -> DF a -> DF a
unary_operator s p = mk_a s [p] (df_type p)
binary_operator :: String -> DF a -> DF a -> DF a
binary_operator s p q = mk_a s [p,q] (df_type p)
comparison_operator :: String -> DF a -> DF a -> DF Bool
comparison_operator s p q = mk_a s [p,q] bool_t
sink_node :: String -> [DF a] -> DF ()
sink_node s ps = mk_a s ps nil_t
alt_unary_operator :: (String,String) -> DF a -> DF a
alt_unary_operator (nm_i,nm_f) n =
let ty = df_type n
in if ty == int32_t
then mk_a nm_i [n] int32_t
else if ty == float_t
then mk_a nm_f [n] float_t
else error "alt_unary_operator"
df_vec_m :: UId m => [Float] -> m (DF (Vec Float))
df_vec_m v = do
k <- generateId
return (DF (UDF_A (Vec (V_Id k) (length v) v)))
instance Num n => Num (DF n) where
(+) = binary_operator "df_add"
(*) = binary_operator "df_mul"
() = binary_operator "df_sub"
negate = unary_operator "df_negate"
abs = alt_unary_operator ("df_labs","df_fabsf")
signum = unary_operator "df_signum"
fromInteger = DF . UDF_K . I . fromInteger
instance Fractional (DF Float) where
(/) = binary_operator "df_div"
recip = unary_operator "df_recip"
fromRational = DF . UDF_K . F . fromRational
instance Floating (DF Float) where
pi = DF (UDF_K (F pi))
exp = unary_operator "df_exp"
sqrt = unary_operator "df_sqrt"
log = unary_operator "df_log"
(**) = binary_operator "df_pow"
logBase = undefined
sin = unary_operator "df_sin"
tan = unary_operator "df_tan"
cos = unary_operator "df_cos"
asin = undefined
atan = undefined
acos = undefined
sinh = undefined
tanh = undefined
cosh = undefined
asinh = undefined
atanh = undefined
acosh = undefined
instance Eq a => Bits (DF a) where
(.&.) = binary_operator "df_and"
(.|.) = binary_operator "df_or"
xor = undefined
complement = undefined
bit = undefined
testBit = undefined
bitSize = undefined
isSigned = undefined
popCount = undefined
df_eq :: DF a -> DF a -> DF Bool
df_eq = comparison_operator "df_eq"
df_lt :: Num a => DF a -> DF a -> DF Bool
df_lt = comparison_operator "df_lt"
df_gte :: Num a => DF a -> DF a -> DF Bool
df_gte = comparison_operator "df_gte"
df_gt :: Num a => DF a -> DF a -> DF Bool
df_gt = comparison_operator "df_gt"
n_lte :: Num a => DF a -> DF a -> DF Bool
n_lte = comparison_operator "df_lte"
instance Eq a => Ord (DF a) where
compare = undefined
(<) = undefined
(>=) = undefined
(>) = undefined
(<=) = undefined
max = binary_operator "df_max"
min = binary_operator "df_min"
df_ceilingf :: DF Float -> DF Float
df_ceilingf = unary_operator "df_ceilf"
df_floorf :: DF Float -> DF Float
df_floorf = unary_operator "df_floorf"
df_lrintf :: DF Float -> DF Int32
df_lrintf p = mk_a "df_lrintf" [p] int32_t
df_roundf :: DF Float -> DF Float
df_roundf = unary_operator "df_roundf"
out1 :: DF Float -> DF ()
out1 p = sink_node "df_out1" [p]
out2 :: DF Float -> DF Float -> DF ()
out2 p q = sink_node "df_out2" [p,q]
out3 :: DF Float -> DF Float -> DF Float -> DF ()
out3 p q r = sink_node "df_out3" [p,q,r]
ctl1 :: DF Int32 -> DF Float
ctl1 p = mk_a "df_ctl1" [p] float_t
select2 :: DF Bool -> DF a -> DF a -> DF a
select2 p q r = DF (UDF_P "df_select2" (df_type q) [df_udf p,df_udf q,df_udf r])
w_sample_rate :: DF Float
w_sample_rate = mk_a "df_sample_rate" [] float_t
b_read :: DF Int32 -> DF Int32 -> DF Float
b_read p q = mk_a "df_b_read" [p,q] float_t
b_write :: DF Int32 -> DF Int32 -> DF Float -> DF ()
b_write p q r = DF (UDF_P "df_b_write" nil_t [df_udf p,df_udf q,df_udf r])
a_read :: DF (Vec Float)-> DF Int32 -> DF Float
a_read p q = DF (UDF_P "df_a_read" float_t [df_udf p,df_udf q])
a_write :: DF (Vec Float) -> DF Int32 -> DF Float -> DF ()
a_write p q r = DF (UDF_P "df_a_write" nil_t [df_udf p,df_udf q,df_udf r])
rec_r :: R_Id -> KT a -> (DF a -> (DF a,DF a)) -> DF a
rec_r n i f =
let (p,q) = f (DF (UDF_R n (Left (kt_k i))))
in DF (UDF_R n (Right (df_udf p,df_udf q)))
rec :: UId m => KT a -> (DF a -> (DF a,DF a)) -> m (DF a)
rec i f = do
n <- generateId
return (rec_r (R_Id n) i f)
recm :: UId m => KT a -> (DF a -> m (DF a,DF a)) -> m (DF a)
recm i f = do
n <- generateId
let r_r = DF (UDF_R (R_Id n) (Left (kt_k i)))
(p,q) <- f r_r
return (DF (UDF_R (R_Id n) (Right (df_udf p,df_udf q))))