structure sc3 :> SC3 = struct

structure B = Word8Vector
structure C = Char
structure L = List
structure M = Math
structure S = String

structure H = hml
structure O = osc

(* operating rates *)
datatype rate = ir | kr | ar | dr

fun rate_id ir = 0
  | rate_id kr = 1
  | rate_id ar = 2
  | rate_id dr = 3

fun rate_ord ir = 0
  | rate_ord kr = 1
  | rate_ord ar = 2
  | rate_ord dr = 3

fun rate_compare (p, q) =
    Int.compare (rate_ord p, rate_ord q)

datatype ugen = constant of real
              | control of rate * string * real
              | primitive of rate * string * ugen list * rate list * int * int
              | proxy of ugen * int
              | mce of ugen list
              | mrg of ugen * ugen

fun c x = constant x

(* control value constructor *)
fun ctl r s x = control (r, s, x)

fun mce2 x y = mce [x, y]

fun iota 0 _ _ = []
  | iota n x j = x :: iota (n - 1) (x+j) j

fun extend l n =
    let val z = L.length l
    in if z = n
       then l
       else (if z > n
             then L.take (l, n)
             else extend (l @ l) n)
    end

fun is_sink (primitive (_, _, _, x, _, _)) = null x
  | is_sink (mce x) = L.all is_sink x
  | is_sink (mrg (x, _)) = is_sink x
  | is_sink _ = false

fun check_input u =
    if is_sink u
    then raise Fail "check_input"
    else u

fun rate_of (constant _) = ir
  | rate_of (control (x, _, _)) = x
  | rate_of (primitive (x, _, _, _, _, _)) = x
  | rate_of (proxy (x, _)) = rate_of x
  | rate_of (mce xs) = H.maximum_by rate_compare (map rate_of xs)
  | rate_of (mrg (x, _)) = rate_of x

fun mce_degree (mce xs) = L.length xs
  | mce_degree (mrg (x, _)) = mce_degree x
  | mce_degree _ = raise Fail "mce_degree"

fun mce_extend n (mce xs) =
    extend xs n
  | mce_extend n (mrg (x, y)) =
    let val (r::rs) = mce_extend n x
    in (mrg (r, y))::rs
    end
  | mce_extend n u =
    H.replicate n u

fun is_mce (mce _) = true
  | is_mce _ = false

fun mce_transform (primitive (r, n, i, ou, s, d)) =
    let fun f j = primitive (r, n, j, ou, s, d)
        val upr = H.maximum_by Int.compare (map mce_degree (L.filter is_mce i))
        val iet = H.transpose (map (mce_extend upr) i)
    in mce (map f iet)
    end
  | mce_transform _ = raise Fail "mce_transform"

fun mce_expand (mce xs) = mce (map mce_expand xs)
  | mce_expand (mrg (x, y)) = mrg (mce_expand x, y)
  | mce_expand u =
    let fun req (primitive (_, _, i, _, _, _)) = not (null (L.filter is_mce i))
          | req _ = false
    in if req u
       then mce_expand (mce_transform u)
       else u
    end

fun mce_channel n (mce xs) = L.nth (xs, n)
  | mce_channel _ _ = raise Fail "mce_channel"

fun mce_channels (mce xs) = xs
  | mce_channels (mrg (x, y)) = let val (r::rs) = mce_channels x
                                in (mrg (r, y))::rs
                                end
  | mce_channels x = [x]

fun proxify (mce xs) = mce (map proxify xs)
  | proxify (mrg (x,y)) = mrg (proxify x, y)
  | proxify (primitive x) =
    let val (r, n, i, ou, s, d) = x
        val ou_n = L.length ou
    in if ou_n < 2
       then primitive (r, n, i, ou, s, d)
       else mce (map (fn j => proxy (primitive x, j)) (iota ou_n 0 1))
    end
  | proxify _ = raise Fail "proxify"

fun mk_ugen r n i ou s z =
    let val u = primitive (r, n, map check_input i, ou, s, z)
    in proxify (mce_expand u)
    end

fun mk_operator c i s =
       let val r = H.maximum_by rate_compare (map rate_of i)
       in mk_ugen r c i [r] s 0
       end

fun mk_unary_operator i f (constant x) = constant (f x)
  | mk_unary_operator i _ u = mk_operator "UnaryOpUGen" [u] i

fun mk_binary_operator _ f (constant x) (constant y) = constant (f (x, y))
  | mk_binary_operator i f p q = mk_operator "BinaryOpUGen" [p, q] i

val uid_ref = ref 0

fun next_uid () =
    ( uid_ref := !uid_ref + 1;
      !uid_ref )

fun mk_oscillator_uid z r c i ou = mk_ugen r c i (H.replicate ou r) 0 z

val mk_oscillator = mk_oscillator_uid 0

fun mk_oscillator_id r c i ou =
    mk_oscillator_uid (next_uid ()) r c i ou

fun mk_oscillator_mce r c i j ou =
    mk_oscillator r c (i @ mce_channels j) ou

fun mk_filter_uid z c i ou =
    let val r = H.maximum_by rate_compare (map rate_of i)
        val oo = H.replicate ou r
    in mk_ugen r c i oo 0 z
    end

val mk_filter = mk_filter_uid 0

fun mk_filter_mce c i j ou =
    mk_filter c (i @ mce_channels j) ou

fun mk_filter_id c i ou =
    mk_filter_uid (next_uid ()) c i ou

datatype from_port =
         from_port_c of int
       | from_port_k of int
       | from_port_u of int * int

datatype node =
         node_c of int * real
       | node_k of int * rate * string * real
       | node_u of int * rate * string * from_port list * rate list * int * int
       | node_p of int * node * int

fun node_c_value (node_c (_, x)) = x
  | node_c_value _ = raise Fail "node_c_value"

fun node_k_default (node_k (_, _, _, x)) = x
  | node_k_default _ = raise Fail "node_k_default"

datatype graph =
         graph of int * node list * node list * node list

fun node_id (node_c (n, _)) = n
  | node_id (node_k (n, _, _, _)) = n
  | node_id (node_u (n, _, _, _, _, _, _)) = n
  | node_id (node_p (n, _, _)) = n

fun as_from_port (node_c (n, _)) = from_port_c n
  | as_from_port (node_k (n, _, _, _)) = from_port_k n
  | as_from_port (node_u (n, _, _, _, _, _, _)) = from_port_u (n, 0)
  | as_from_port (node_p (_, u, p)) = from_port_u (node_id u, p)

val empty_graph = graph (0, [], [], [])

(* Predicate to locate constant. *)
fun find_c_p x (node_c (_, y)) = Real.== (x, y)
  | find_c_p _ _ = raise Fail "find_c_p"

(* Insert a constant node into the graph. *)
fun push_c x (graph (id, c, k, u)) =
    let val n = node_c (id+1, x)
    in (n, graph (id+1, n::c, k, u))
    end

(* Either find existing constant node, or insert a new node. *)
fun mk_node_c (constant x) g =
    let val (graph (_, c, _, _)) = g
        val y = L.find (find_c_p x) c
    in if isSome y then (Option.valOf y, g) else push_c x g
    end
  | mk_node_c _ _ = raise Fail "mk_node_c"

(* Predicate to locate control, names must be unique. *)
fun find_k_p x (node_k (_, _, y, _)) = x = y
  | find_k_p _ _ = raise Fail "find_k_p"

(* Insert a control node into the graph. *)
fun push_k (r, nm, d) (graph (id, c, k, u)) =
    let val n = node_k (id+1, r, nm, d)
    in (n, graph (id+1, c, n::k, u))
    end

(* Either find existing control node, or insert a new node. *)
fun mk_node_k (control (r, nm, d)) g =
    let val (graph (_, _, k, _)) = g
        val y = L.find (find_k_p nm) k
    in if isSome y then (Option.valOf y, g) else push_k (r, nm, d) g
    end
  | mk_node_k _ _ =
    raise Fail "mk_node_k"

(* Predicate to locate primitive, names must be unique. *)
fun find_u_p (r, n, i, ou, s, d) (node_u (_, r', n', i', ou', s', d')) =
    r = r' andalso
    n = n' andalso
    i = i' andalso
    ou = ou' andalso
    s = s' andalso
    d = d'
  | find_u_p _ _ =
    raise Fail "find_u_p"

(* Insert a primitive node into the graph. *)
fun push_u (r, nm, i, ou, s, d) g =
    let val (graph (id, c, k, u)) = g
        val n = node_u (id+1, r, nm, i, ou, s, d)
    in (n, graph (id+1, c, k, n::u))
    end

(* Either find existing primitive node, or insert a new node. *)
fun mk_node_u mk_node (primitive (r, nm, i, ou, s, d)) g =
    let fun acc [] n g =
            (L.rev n, g)
          | acc (x::xs) ys g =
            let val (y, g') = mk_node x g
            in acc xs (y::ys) g'
            end
        val (i', g') = acc i [] g
        val (graph (_, _, _, us)) = g'
        val i'' = map as_from_port i'
        val u = (r, nm, i'', ou, s, d)
        val y = L.find (find_u_p u) us
    in if isSome y then (Option.valOf y, g') else push_u u g'
    end
  | mk_node_u _ _ _ = raise Fail "mk_node_u"

(* Proxies do not get stored in the graph. *)
fun mk_node_p n p (graph (id, c, k, u)) =
    (node_p (id+1, n, p), (graph (id+1, c, k, u)))

fun mk_node (constant x) g =
    mk_node_c (constant x) g
  | mk_node (control x) g =
    mk_node_k (control x) g
  | mk_node (primitive x) g =
    mk_node_u mk_node (primitive x) g
  | mk_node (proxy (s, i)) g =
    let val (n, g') = mk_node_u mk_node s g
    in mk_node_p n i g'
    end
  | mk_node (mrg (x,y)) g =
    let val (_, g') = mk_node y g
    in mk_node x g'
    end
  | mk_node (mce x) g =
    raise Fail "mk_node"

(* Generate maps from node identifiers to synthdef indexes. *)
fun mk_maps (graph (_, cs, ks, us)) =
    ( Array.fromList (map node_id cs)
    , Array.fromList (map node_id ks)
    , Array.fromList (map node_id us) )

(* Locate index in map give node identifer. *)
fun fetch x m =
    H.fst (Option.valOf (Array.findi (fn (_, y) => x = y) m))

datatype input = input of int * int

(* Construct input form required by byte-code generator. *)
fun make_input (cs, _, _) (from_port_c n) =
    input (~1, fetch n cs)
  | make_input (_, ks, _) (from_port_k n) =
    input (0, fetch n ks)
  | make_input (_, _, us) (from_port_u (n, p)) =
    input (fetch n us, p)

(* Byte-encode input value. *)
fun encode_input (input (u, p)) =
    B.concat [O.encode_i16 u, O.encode_i16 p]

(* Pascal strings are length prefixed byte strings. *)
fun str_pstr s =
    let val n = Word8.fromInt (S.size s)
    in n :: L.map (Word8.fromInt o Char.ord) (S.explode s)
    end

(* Byte-encode control node. *)
fun encode_node_k (_, ks, _) (node_k (n, _, nm, _)) =
    B.concat [ B.fromList (str_pstr nm)
             , O.encode_i16 (fetch n ks) ]
  | encode_node_k _ _ = raise Fail "encode_node_k"

(* Byte-encode primitive node. *)
fun encode_node_u m (node_u (_, r, nm, i, ou, s, _)) =
    let val i' = map (encode_input o make_input m) i
        val o' = map (O.encode_i8 o rate_id) ou
    in B.concat [ B.fromList (str_pstr nm)
                , O.encode_i8 (rate_id r)
                , O.encode_i16 (L.length i)
                , O.encode_i16 (L.length ou)
                , O.encode_i16 s
                , B.concat i'
                , B.concat o' ]
    end
  | encode_node_u _ _ = raise Fail "encode_ugen"

(* Construct instrument definition bytecode. *)
fun encode_graphdef s g =
    let val (graph (_, cs, ks, us)) = g
        val mm = mk_maps g
    in B.concat [ O.encode_str "SCgf"
                , O.encode_i32 0
                , O.encode_i16 1
                , B.fromList (str_pstr s)
                , O.encode_i16 (L.length cs)
                , B.concat (L.map (O.encode_f32 o node_c_value) cs)
                , O.encode_i16 (L.length ks)
                , B.concat (L.map (O.encode_f32 o node_k_default) ks)
                , O.encode_i16 (L.length ks)
                , B.concat (L.map (encode_node_k mm) ks)
                , O.encode_i16 (L.length us)
                , B.concat (L.map (encode_node_u mm) us) ]
    end

(* Construct implicit control unit generator node (k-rate only). *)
fun implicit n =
    node_u (~1, kr, "Control", [], H.replicate n kr, 0, 0)

fun mrg_n [p] = p
  | mrg_n [p, q] = mrg (p, q)
  | mrg_n (p::q::xs) = mrg (p, mrg_n (q::xs))
  | mrg_n _ = raise Fail "mrg_n"

(* Transform mce nodes to mrg nodes *)
fun prepare_root (mce xs) = mrg_n xs
  | prepare_root (mrg (x, y)) = mrg (prepare_root x, prepare_root y)
  | prepare_root u = u

(* Transform a unit generator into a graph. *)
fun synth u =
    let val (_, g) = mk_node (prepare_root u) empty_graph
        val (graph (_, cs, ks, us)) = g
        val us' = if null ks
                  then L.rev us
                  else implicit (L.length ks) :: L.rev us
    in graph (~1, cs, ks, us')
    end

(* Transform a unit generator into bytecode. *)
fun synthdef s u =
    H.b_unpack (encode_graphdef s (synth u))

fun s_log2 x =
    M.ln (abs x) / M.ln 2.0

fun s_amp_db x =
    M.log10 x * 20.0

fun s_db_amp x =
    M.pow (10.0, x * 0.05)

fun pow_db x =
    M.log10 x * 10.0

fun db_pow x =
    M.pow (10.0, x * 0.1)

fun s_midi_cps x = 
    440.0 * M.pow (2.0, (x - 69.0) * 0.083333333333)

fun s_cps_midi x =
    s_log2 (x * 0.0022727272727) * 12.0 + 69.0

fun s_midi_ratio x =
    M.pow (2.0, x * 0.083333333333)

fun s_ratio_midi x =
    12.0 * (s_log2 x)

fun s_oct_cps x =
    440.0 * M.pow (2.0, x - 4.75)

fun s_cps_oct x =
    s_log2 (x * 0.0022727272727) + 4.75

fun s_degree_to_key degree scale steps =
    let val scale_n = L.length scale
    in steps * (degree div scale_n) + L.nth (scale, degree mod scale_n)
    end

fun s_squared x =
    x * x

fun s_cubed x =
    x * x * x

fun s_recip x =
    1.0 / x

fun unimplemented x =
    raise Fail "unimplemented"

fun curry f x y =
    f (x, y)

(* unary operators *)
val u_abs = mk_unary_operator 5 abs
val amp_db = mk_unary_operator 22 s_amp_db
val arc_cos = mk_unary_operator 32 M.acos
val arc_sin = mk_unary_operator 31 M.asin
val arc_tan = mk_unary_operator 33 M.atan
val as_float = mk_unary_operator 6 unimplemented
val as_int = mk_unary_operator 7 unimplemented
val bi_lin_rand = mk_unary_operator 40 unimplemented
val bit_not = mk_unary_operator 4 unimplemented
val cps_midi = mk_unary_operator 18 s_cps_midi
val cps_oct = mk_unary_operator 24 s_cps_oct
val u_ceil = mk_unary_operator 8 Real.realCeil
val coin = mk_unary_operator 44 unimplemented
val u_cos = mk_unary_operator 29 M.cos
val cos_h = mk_unary_operator 35 M.cosh
val cubed = mk_unary_operator 13 s_cubed
val db_amp = mk_unary_operator 21 s_db_amp
val digit_value = mk_unary_operator 45 unimplemented
val distort = mk_unary_operator 42 unimplemented
val exp = mk_unary_operator 15 M.exp
val u_floor = mk_unary_operator 9 Real.realFloor
val frac = mk_unary_operator 10 unimplemented
val han_window = mk_unary_operator 49 unimplemented
val is_nil = mk_unary_operator 2 unimplemented
val u_log = mk_unary_operator 25 M.ln
val u_log10 = mk_unary_operator 27 M.log10
val log2 = mk_unary_operator 26 s_log2
val midi_cps = mk_unary_operator 17 s_midi_cps
val midi_ratio = mk_unary_operator 19 s_midi_ratio
val neg = mk_unary_operator 0 ~
val u_not = mk_unary_operator 1 unimplemented
val not_nil = mk_unary_operator 3 unimplemented
val oct_cps = mk_unary_operator 23 s_oct_cps
val rand2 = mk_unary_operator 38 unimplemented
val ratio_midi = mk_unary_operator 20 s_ratio_midi
val recip = mk_unary_operator 16 s_recip
val rect_window = mk_unary_operator 48 unimplemented
val scurve = mk_unary_operator 53 unimplemented
val sign = mk_unary_operator 11 unimplemented
val silence = mk_unary_operator 46 unimplemented
val u_sin = mk_unary_operator 28 M.sin
val sin_h = mk_unary_operator 34 unimplemented
val soft_clip = mk_unary_operator 43 unimplemented
val u_sqrt = mk_unary_operator 14 M.sqrt
val squared = mk_unary_operator 12 s_squared
val sum3rand = mk_unary_operator 41 unimplemented
val u_tan = mk_unary_operator 30 M.tan
val tan_h = mk_unary_operator 36 unimplemented
val thru = mk_unary_operator 47 unimplemented
val tri_window = mk_unary_operator 51 unimplemented
val welch_window = mk_unary_operator 50 unimplemented
val lin_rand' = mk_unary_operator 39 unimplemented
val ramp' = mk_unary_operator 52 unimplemented
val rand' = mk_unary_operator 37 unimplemented

(* binary operators *)
val add = mk_binary_operator 0 (fn (x, y) => x+y)
val sub = mk_binary_operator 1 (fn (x, y) => x-y)
val mul = mk_binary_operator 2 (fn (x, y) => x*y)
val fdiv = mk_binary_operator 4 (fn (x, y) => x/y)
val u_trunc = mk_binary_operator 21 (fn (x, y) => raise Fail "unimplemented")

(* oscillators *)
fun amplitude r a b c = mk_oscillator r "Amplitude" [a, b, c] 1
fun blip r a b = mk_oscillator r "Blip" [a, b] 1
fun brown_noise r = mk_oscillator_id r "BrownNoise" [] 1
fun buf_channels r a = mk_oscillator r "BufChannels" [a] 1
fun buf_dur r a = mk_oscillator r "BufDur" [a] 1
fun buf_frames r a = mk_oscillator r "BufFrames" [a] 1
fun buf_rate_scale r a = mk_oscillator r "BufRateScale" [a] 1
fun buf_sample_rate r a = mk_oscillator r "BufSampleRate" [a] 1
fun buf_samples r a = mk_oscillator r "BufSamples" [a] 1
fun c_osc r a b c = mk_oscillator r "COsc" [a, b, c] 1
fun clip_noise r = mk_oscillator_id r "ClipNoise" [] 1
fun crackle r a = mk_oscillator r "Crackle" [a] 1
fun cusp_l r a b c d = mk_oscillator r "CuspL" [a, b, c, d] 1
fun cusp_n r a b c d = mk_oscillator r "CuspN" [a, b, c, d] 1
fun demand_env_gen r a b c d e f g h i j = mk_oscillator r "DemandEnvGen" [a, b, c, d, e, f, g, h, i, j] 1
fun dust r a = mk_oscillator_id r "Dust" [a] 1
fun dust2 r a = mk_oscillator_id r "Dust2" [a] 1
fun duty r a b c d = mk_oscillator_mce r "Duty" [a, b, c] d 1
fun env_gen r a b c d e f = mk_oscillator_mce r "EnvGen" [a, b, c, d, e] f 1
fun f_sin_osc r a b = mk_oscillator r "FSinOsc" [a, b] 1
fun fb_sine_c r a b c d e f g = mk_oscillator r "FBSineC" [a, b, c, d, e, f, g] 1
fun fb_sine_l r a b c d e f g = mk_oscillator r "FBSineL" [a, b, c, d, e, f, g] 1
fun fb_sine_n r a b c d e f g = mk_oscillator r "FBSineN" [a, b, c, d, e, f, g] 1
fun formant r a b c = mk_oscillator r "Formant" [a, b, c] 1
fun gbman_c r a b c = mk_oscillator r "GbmanC" [a, b, c] 1
fun gbman_l r a b c = mk_oscillator r "GbmanL" [a, b, c] 1
fun gbman_n r a b c = mk_oscillator r "GbmanN" [a, b, c] 1
fun gendy1 r a b c d e f g h i j = mk_oscillator r "Gendy1" [a, b, c, d, e, f, g, h, i, j] 1
fun gendy2 r a b c d e f g h i j k l = mk_oscillator r "Gendy2" [a, b, c, d, e, f, g, h, i, j, k, l] 1
fun gendy3 r a b c d e f g h i = mk_oscillator r "Gendy3" [a, b, c, d, e, f, g, h, i] 1
fun gray_noise r = mk_oscillator_id r "GrayNoise" [] 1
fun henon_c r a b c d e = mk_oscillator r "HenonC" [a, b, c, d, e] 1
fun henon_l r a b c d e = mk_oscillator r "HenonL" [a, b, c, d, e] 1
fun henon_n r a b c d e = mk_oscillator r "HenonN" [a, b, c, d, e] 1
fun impulse r a b = mk_oscillator r "Impulse" [a, b] 1
fun key_state r a b c d = mk_oscillator r "KeyState" [a, b, c, d] 1
fun klang r a b c = mk_oscillator_mce r "Klang" [a, b] c 1
fun latoocarfian_c r a b c d e f g = mk_oscillator r "LatoocarfianC" [a, b, c, d, e, f, g] 1
fun latoocarfian_l r a b c d e f g = mk_oscillator r "LatoocarfianL" [a, b, c, d, e, f, g] 1
fun latoocarfian_n r a b c d e f g = mk_oscillator r "LatoocarfianN" [a, b, c, d, e, f, g] 1
fun lf_clip_noise r a = mk_oscillator_id r "LFClipNoise" [a] 1
fun lf_cub r a b = mk_oscillator r "LFCub" [a, b] 1
fun lf_noise0 r a = mk_oscillator_id r "LFNoise0" [a] 1
fun lf_noise1 r a = mk_oscillator_id r "LFNoise1" [a] 1
fun lf_noise2 r a = mk_oscillator_id r "LFNoise2" [a] 1
fun lf_par r a b = mk_oscillator r "LFPar" [a, b] 1
fun lf_pulse r a b c = mk_oscillator r "LFPulse" [a, b, c] 1
fun lf_saw r a b = mk_oscillator r "LFSaw" [a, b] 1
fun lf_tri r a b = mk_oscillator r "LFTri" [a, b] 1
fun lfd_clip_noise r a = mk_oscillator_id r "LFDClipNoise" [a] 1
fun lfd_noise0 r a = mk_oscillator_id r "LFDNoise0" [a] 1
fun lfd_noise1 r a = mk_oscillator_id r "LFDNoise1" [a] 1
fun lfd_noise3 r a = mk_oscillator_id r "LFDNoise3" [a] 1
fun lin_cong_c r a b c d e = mk_oscillator r "LinCongC" [a, b, c, d, e] 1
fun lin_cong_l r a b c d e = mk_oscillator r "LinCongL" [a, b, c, d, e] 1
fun lin_cong_n r a b c d e = mk_oscillator r "LinCongN" [a, b, c, d, e] 1
fun line r a b c d = mk_oscillator r "Line" [a, b, c, d] 1
fun logistic r a b = mk_oscillator r "Logistic" [a, b] 1
fun lorenz_l r a b c d e f g h = mk_oscillator r "LorenzL" [a, b, c, d, e, f, g, h] 1
fun mouse_button r a b c = mk_oscillator r "MouseButton" [a, b, c] 1
fun mouse_x r a b c d = mk_oscillator r "MouseX" [a, b, c, d] 1
fun mouse_y r a b c d = mk_oscillator r "MouseY" [a, b, c, d] 1
fun noah_noise r = mk_oscillator_id r "NoahNoise" [] 1
fun osc r a b c = mk_oscillator r "Osc" [a, b, c] 1
fun osc_n r a b c = mk_oscillator r "OscN" [a, b, c] 1
fun p_sin_grain r a b c = mk_oscillator r "PSinGrain" [a, b, c] 1
fun phasor r a b c d e = mk_oscillator r "Phasor" [a, b, c, d, e] 1
fun pink_noise r = mk_oscillator_id r "PinkNoise" [] 1
fun pulse r a b = mk_oscillator r "Pulse" [a, b] 1
fun quad_c r a b c d e = mk_oscillator r "QuadC" [a, b, c, d, e] 1
fun quad_l r a b c d e = mk_oscillator r "QuadL" [a, b, c, d, e] 1
fun quad_n r a b c d e = mk_oscillator r "QuadN" [a, b, c, d, e] 1
fun rand_id r a = mk_oscillator_id r "RandID" [a] 1
fun rand_seed r a b = mk_oscillator_id r "RandSeed" [a, b] 1
fun saw r a = mk_oscillator r "Saw" [a] 1
fun shared_in r = mk_oscillator r "SharedIn" [] 1
fun sin_osc r a b = mk_oscillator r "SinOsc" [a, b] 1
fun sin_osc_fb r a b = mk_oscillator r "SinOscFB" [a, b] 1
fun standard_l r a b c d = mk_oscillator r "StandardL" [a, b, c, d] 1
fun standard_n r a b c d = mk_oscillator r "StandardN" [a, b, c, d] 1
fun sync_saw r a b = mk_oscillator r "SyncSaw" [a, b] 1
fun t_duty r a b c d e = mk_oscillator_mce r "TDuty" [a, b, c, d] e 1
fun v_osc r a b c = mk_oscillator r "VOsc" [a, b, c] 1
fun v_osc3 r a b c d = mk_oscillator r "VOsc3" [a, b, c, d] 1
fun var_saw r a b c = mk_oscillator r "VarSaw" [a, b, c] 1
fun white_noise r = mk_oscillator_id r "WhiteNoise" [] 1
fun x_line r a b c d = mk_oscillator r "XLine" [a, b, c, d] 1

(* filters *)
fun allpass_c a b c d = mk_filter "AllpassC" [a, b, c, d] 1
fun allpass_l a b c d = mk_filter "AllpassL" [a, b, c, d] 1
fun allpass_n a b c d = mk_filter "AllpassN" [a, b, c, d] 1
fun amp_comp a b c = mk_filter "AmpComp" [a, b, c] 1
fun amp_comp_a a b c d = mk_filter "AmpCompA" [a, b, c, d] 1
fun apf a b c = mk_filter "APF" [a, b, c] 1
fun balance2 a b c d = mk_filter "Balance2" [a, b, c, d] 1
fun ball a b c d = mk_filter "Ball" [a, b, c, d] 1
fun bi_pan_b2 a b c d = mk_filter "BiPanB2" [a, b, c, d] 3
fun bpf a b c = mk_filter "BPF" [a, b, c] 1
fun bpz2 a = mk_filter "BPZ2" [a] 1
fun brf a b c = mk_filter "BRF" [a, b, c] 1
fun brz2 a = mk_filter "BRZ2" [a] 1
fun buf_allpass_c a b c d = mk_filter "BufAllpassC" [a, b, c, d] 1
fun buf_allpass_l a b c d = mk_filter "BufAllpassL" [a, b, c, d] 1
fun buf_allpass_n a b c d = mk_filter "BufAllpassN" [a, b, c, d] 1
fun buf_comb_c a b c d = mk_filter "BufCombC" [a, b, c, d] 1
fun buf_comb_l a b c d = mk_filter "BufCombL" [a, b, c, d] 1
fun buf_comb_n a b c d = mk_filter "BufCombN" [a, b, c, d] 1
fun buf_delay_c a b c = mk_filter "BufDelayC" [a, b, c] 1
fun buf_delay_l a b c = mk_filter "BufDelayL" [a, b, c] 1
fun buf_delay_n a b c = mk_filter "BufDelayN" [a, b, c] 1
fun buf_wr a b c d = mk_filter_mce "BufWr" [a, b, c] d 1
fun clip a b c = mk_filter "Clip" [a, b, c] 1
fun coin_gate a b = mk_filter_id "CoinGate" [a, b] 1
fun comb_c a b c d = mk_filter "CombC" [a, b, c, d] 1
fun comb_l a b c d = mk_filter "CombL" [a, b, c, d] 1
fun comb_n a b c d = mk_filter "CombN" [a, b, c, d] 1
fun compander a b c d e f g = mk_filter "Compander" [a, b, c, d, e, f, g] 1
fun compander_d a b c d e f = mk_filter "CompanderD" [a, b, c, d, e, f] 1
fun decay a b = mk_filter "Decay" [a, b] 1
fun decay2 a b c = mk_filter "Decay2" [a, b, c] 1
fun degree_to_key a b c = mk_filter "DegreeToKey" [a, b, c] 1
fun delay_c a b c = mk_filter "DelayC" [a, b, c] 1
fun delay_l a b c = mk_filter "DelayL" [a, b, c] 1
fun delay_n a b c = mk_filter "DelayN" [a, b, c] 1
fun delay1 a = mk_filter "Delay1" [a] 1
fun delay2 a = mk_filter "Delay2" [a] 1
fun detect_silence a b c d = mk_filter "DetectSilence" [a, b, c, d] 1
fun disk_out a b = mk_filter_mce "DiskOut" [a] b 0
fun done a = mk_filter "Done" [a] 1
fun fold a b c = mk_filter "Fold" [a, b, c] 1
fun formlet a b c d = mk_filter "Formlet" [a, b, c, d] 1
fun fos a b c d = mk_filter "FOS" [a, b, c, d] 1
fun free a b = mk_filter "Free" [a, b] 1
fun free_self a = mk_filter "FreeSelf" [a] 1
fun free_self_when_done a = mk_filter "FreeSelfWhenDone" [a] 1
fun free_verb a b c d = mk_filter "FreeVerb" [a, b, c, d] 1
fun free_verb2 a b c d e = mk_filter "FreeVerb2" [a, b, c, d, e] 2
fun gate a b = mk_filter "Gate" [a, b] 1
fun hasher a = mk_filter "Hasher" [a] 1
fun hilbert a = mk_filter "Hilbert" [a] 2
fun hpf a b = mk_filter "HPF" [a, b] 1
fun hpz1 a = mk_filter "HPZ1" [a] 1
fun hpz2 a = mk_filter "HPZ2" [a] 1
fun image_warp a b c d = mk_filter "ImageWarp" [a, b, c, d] 1
fun in_range a b c = mk_filter "InRange" [a, b, c] 1
fun in_rect a b c = mk_filter "InRect" [a, b, c] 1
fun index a b = mk_filter "Index" [a, b] 1
fun integrator a b = mk_filter "Integrator" [a, b] 1
fun klank a b c d e = mk_filter_mce "Klank" [a, b, c, d] e 1
fun lag a b = mk_filter "Lag" [a, b] 1
fun lag2 a b = mk_filter "Lag2" [a, b] 1
fun lag3 a b = mk_filter "Lag3" [a, b] 1
fun last_value a b = mk_filter "LastValue" [a, b] 1
fun latch a b = mk_filter "Latch" [a, b] 1
fun leak_dc a b = mk_filter "LeakDC" [a, b] 1
fun least_change a b = mk_filter "LeastChange" [a, b] 1
fun limiter a b c = mk_filter "Limiter" [a, b, c] 1
fun lin_exp a b c d e = mk_filter "LinExp" [a, b, c, d, e] 1
fun lin_lin a b c d e = mk_filter "LinLin" [a, b, c, d, e] 1
fun lin_pan2 a b c = mk_filter "LinPan2" [a, b, c] 2
fun lin_x_fade2 a b c d = mk_filter "LinXFade2" [a, b, c, d] 1
fun linen a b c d e = mk_filter "Linen" [a, b, c, d, e] 1
fun local_out a = mk_filter_mce "LocalOut" [] a 0
fun lpf a b = mk_filter "LPF" [a, b] 1
fun lpz1 a = mk_filter "LPZ1" [a] 1
fun lpz2 a = mk_filter "LPZ2" [a] 1
fun mantissa_mask a b = mk_filter "MantissaMask" [a, b] 1
fun median a b = mk_filter "Median" [a, b] 1
fun mid_eq a b c d = mk_filter "MidEq" [a, b, c, d] 1
fun moog_ff a b c d = mk_filter "MoogFF" [a, b, c, d] 1
fun most_change a b = mk_filter "MostChange" [a, b] 1
fun mul_add a b c = mk_filter "MulAdd" [a, b, c] 1
fun normalizer a b c = mk_filter "Normalizer" [a, b, c] 1
fun offset_out a b = mk_filter_mce "OffsetOut" [a] b 0
fun one_pole a b = mk_filter "OnePole" [a, b] 1
fun one_zero a b = mk_filter "OneZero" [a, b] 1
fun out a b = mk_filter_mce "Out" [a] b 0
fun pan_az a b c d e f = mk_filter "PanAz" [a, b, c, d, e, f] 1
fun pan_b a b c d = mk_filter "PanB" [a, b, c, d] 3
fun pan_b2 a b c = mk_filter "PanB2" [a, b, c] 3
fun pan2 a b c = mk_filter "Pan2" [a, b, c] 2
fun pan4 a b c d = mk_filter "Pan4" [a, b, c, d] 4
fun pause a b = mk_filter "Pause" [a, b] 1
fun pause_self a = mk_filter "PauseSelf" [a] 1
fun pause_self_when_done a = mk_filter "PauseSelfWhenDone" [a] 1
fun peak a b = mk_filter "Peak" [a, b] 1
fun peak_follower a b = mk_filter "PeakFollower" [a, b] 1
fun pitch_shift a b c d e = mk_filter "PitchShift" [a, b, c, d, e] 1
fun pluck a b c d e f = mk_filter "Pluck" [a, b, c, d, e, f] 1
fun poll a b c d = mk_filter_mce "Poll" [a, b, c] d 0
fun pulse_count a b = mk_filter "PulseCount" [a, b] 1
fun pulse_divider a b c = mk_filter "PulseDivider" [a, b, c] 1
fun ramp a b = mk_filter "Ramp" [a, b] 1
fun record_buf a b c d e f g h = mk_filter_mce "RecordBuf" [a, b, c, d, e, f, g] h 1
fun replace_out a b = mk_filter_mce "ReplaceOut" [a] b 0
fun resonz a b c = mk_filter "Resonz" [a, b, c] 1
fun rhpf a b c = mk_filter "RHPF" [a, b, c] 1
fun ringz a b c = mk_filter "Ringz" [a, b, c] 1
fun rlpf a b c = mk_filter "RLPF" [a, b, c] 1
fun rotate2 a b c = mk_filter "Rotate2" [a, b, c] 2
fun running_max a b = mk_filter "RunningMax" [a, b] 1
fun running_min a b = mk_filter "RunningMin" [a, b] 1
fun running_sum a b = mk_filter "RunningSum" [a, b] 1
fun schmidt a b c = mk_filter "Schmidt" [a, b, c] 1
fun scope_out a b = mk_filter_mce "ScopeOut" [a] b 0
fun select a b = mk_filter_mce "Select" [a] b 1
fun send_trig a b c = mk_filter "SendTrig" [a, b, c] 0
fun set_reset_ff a b = mk_filter "SetResetFF" [a, b] 1
fun shaper a b = mk_filter "Shaper" [a, b] 1
fun slew a b c = mk_filter "Slew" [a, b, c] 1
fun slope a = mk_filter "Slope" [a] 1
fun sos a b c d e f = mk_filter "SOS" [a, b, c, d, e, f] 1
fun spring a b c = mk_filter "Spring" [a, b, c] 1
fun stepper a b c d e f = mk_filter "Stepper" [a, b, c, d, e, f] 1
fun sweep a b = mk_filter "Sweep" [a, b] 1
fun t_ball a b c d = mk_filter "TBall" [a, b, c, d] 1
fun t_delay a b = mk_filter "TDelay" [a, b] 1
fun t_exp_rand a b c = mk_filter_id "TExpRand" [a, b, c] 1
fun t_pulse a b c = mk_filter "TPulse" [a, b, c] 1
fun t_rand a b c = mk_filter_id "TRand" [a, b, c] 1
fun ti_rand a b c = mk_filter_id "TIRand" [a, b, c] 1
fun timer a = mk_filter "Timer" [a] 1
fun toggle_ff a = mk_filter "ToggleFF" [a] 1
fun trapezoid a b c d e = mk_filter "Trapezoid" [a, b, c, d, e] 1
fun trig a b = mk_filter "Trig" [a, b] 1
fun trig1 a b = mk_filter "Trig1" [a, b] 1
fun tw_index a b c = mk_filter_mce "TWindex" [a, b] c 1
fun two_pole a b c = mk_filter "TwoPole" [a, b, c] 1
fun two_zero a b c = mk_filter "TwoZero" [a, b, c] 1
fun vibrato a b c d e f g h = mk_filter "Vibrato" [a, b, c, d, e, f, g, h] 1
fun wrap a b c = mk_filter "Wrap" [a, b, c] 1
fun wrap_index a b = mk_filter "WrapIndex" [a, b] 1
fun x_fade2 a b c d = mk_filter "XFade2" [a, b, c, d] 1
fun x_out a b c = mk_filter_mce "XOut" [a, b] c 0
fun xy a b c d e f = mk_filter "XY" [a, b, c, d, e, f] 1
fun zero_crossing a = mk_filter "ZeroCrossing" [a] 1

(************** composite unit generators ******************)
fun mix (mce xs) = 
    L.foldl (fn (p, q) => add p q) (constant 0.0) xs
  | mix u = u

fun add3 p q r =
    add p (add q r)

(***************** server commands *************************)

datatype add_action = 
         add_to_head 
       | add_to_tail 
       | add_before 
       | add_after 
       | add_replace

fun add_action_id add_to_head = 0
  | add_action_id add_to_tail = 1
  | add_action_id add_before = 2
  | add_action_id add_after = 3
  | add_action_id add_replace = 4

fun mk_duples a b xys =
    List.concat (List.map (fn (x, y) => [a x, b y]) xys)

val clear_sched =
    O.Message ("/clearSched", [])

fun b_alloc i j k =
    O.Message ("/b_alloc", [O.Int i, O.Int j, O.Int k])

fun b_setn1 i j xs =
    O.Message ("/b_setn", [O.Int i, O.Int j, O.Int (L.length xs)] @ map O.Float xs)

fun d_recv x =
    O.Message ("/d_recv", [O.Blob x])

fun g_free_all1 x =
    O.Message ("/g_freeAll", [O.Int x])

fun g_new1 i j k =
    O.Message ("/g_new", [ O.Int i
                         , O.Int (add_action_id j)
                         , O.Int k ])

fun notify x =
    O.Message ("/notify", [O.Int (if x then 1 else 0)])

fun n_set i xys =
    let val d = mk_duples O.String O.Float xys
    in O.Message ("/n_set", (O.Int i) :: d)
    end

fun n_set1 i s r =
    n_set i [(s, r)]

fun s_new0 s i j k =
    O.Message ("/s_new", [O.String s, O.Int i, O.Int (add_action_id j), O.Int k])

val status =
    O.Message ("/status", [])

val reset = O.Bundle (~1.0, [ g_free_all1 0
                            , clear_sched
                            , g_new1 1 add_to_head 0 ])

fun async fd m = 
    ( O.send fd m
    ; O.wait fd "/done" )

fun with_sc3 f =
    let val fd = O.open_udp "127.0.0.1" 57110
        val _ = f fd
    in O.close fd
    end

fun play fd u =
    ( async fd (d_recv (synthdef "anonymous" u))
    ; O.send fd (s_new0 "anonymous" ~1 add_to_tail 1) )

fun audition u =
    with_sc3 (fn fd => play fd u)

end