Le lundi 29 novembre 2010 15:51:28, Romain Beauxis a écrit :
> I will fix and generalize the existing code, then.
Ok, I have a first patch.
There are many stuff that I don't understand in the internals of the language,
so I adapted the code I saw.. Of course, this needs comments and fixes :)
Romain
Index: operators/insert_metadata.ml
===================================================================
--- operators/insert_metadata.ml (révision 7993)
+++ operators/insert_metadata.ml (copie de travail)
@@ -34,74 +34,28 @@
method abort_track = source#abort_track
val mutable metadata = None
+ val lock_m = Mutex.create ()
val mutable ns = []
- method private wake_up l =
- super#wake_up l ;
- if ns = [] then
- ns <- Server.register [self#id] "insert_metadata" ;
- self#set_id (Server.to_string ns) ;
- Server.add ~ns "insert" ~usage:"insert key1=\"val1\",key2=\"val2\",.."
- ~descr:"Insert a metadata chunk."
- (fun s ->
- let l = String.length s in
- let pos = ref 0 in
- let str =
- Stream.from (fun i ->
- pos := i ;
- if i<l then Some s.[i] else None)
- in
- let lexer = make_lexer [",";"="] str in
- let m = Hashtbl.create 10 in
- let state = ref `Ident in
- try
- while true do
- match Stream.next lexer with
- | Kwd "," when `Comma = !state ->
- state := `Ident
- | Ident key when `Ident = !state ->
- state := `Internal ;
- begin match Stream.next lexer with
- | Kwd "=" -> begin match Stream.next lexer with
- | String s ->
- Hashtbl.add m key s ;
- state := `Comma
- | _ -> raise Error
- end
- | _ -> raise Error
- end
- | _ -> raise Error
- done ;
- assert false
- with
- | Stream.Failure when `Indent = !state || `Comma = !state ->
- metadata <- Some m ;
- "Done"
- | Error | Stream.Failure | Stream.Error _ ->
- "Syntax error: use key1=\"val1\",key2=\"val2\",..")
+ method insert_metadata m =
+ Mutex.lock lock_m ;
+ metadata <- Some m ;
+ Mutex.unlock lock_m
method private get_frame buf =
let p = Frame.position buf in
source#get buf ;
- match metadata with
- | Some m ->
- Frame.set_metadata buf p m ;
- metadata <- None
- | None -> ()
+ Mutex.lock lock_m ;
+ Tutils.finalize ~k:(fun () -> Mutex.unlock lock_m)
+ (fun () ->
+ match metadata with
+ | Some m ->
+ Frame.set_metadata buf p m ;
+ metadata <- None
+ | None -> ())
end
-let register =
- let kind = Lang.univ_t 1 in
- Lang.add_operator "insert_metadata" [ "", Lang.source_t kind, None, None ]
- ~category:Lang.SoundProcessing
- ~descr:"Interactively insert metadata using the command \
- <code>ID.insert key1=\"val1\",key2=\"val2\",...</code>."
- ~kind:(Lang.Unconstrained kind)
- (fun p kind ->
- let source = Lang.to_source (Lang.assoc "" 1 p) in
- new insert_metadata ~kind source)
-
(** Insert metadata at the beginning if none is set.
* Currently used by the switch classes. *)
class replay ~kind meta src =
Index: lang/lang.ml
===================================================================
--- lang/lang.ml (révision 7993)
+++ lang/lang.ml (copie de travail)
@@ -37,6 +37,14 @@
let bool_t = ground_t T.Bool
let string_t = ground_t T.String
let product_t a b = T.make (T.Product (a,b))
+let of_fst_product_t t = match (T.deref t).T.descr with
+ | T.Product (t,_) -> t
+ | _ -> assert false
+let of_snd_product_t t = match (T.deref t).T.descr with
+ | T.Product (_,t) -> t
+ | _ -> assert false
+
+
let fun_t p b = T.make (T.Arrow (p,b))
let list_t t = T.make (T.List t)
Index: lang/lang_builtins.ml
===================================================================
--- lang/lang_builtins.ml (révision 7997)
+++ lang/lang_builtins.ml (copie de travail)
@@ -1381,6 +1381,46 @@
Lang.unit)
let () =
+ let kind = Lang.univ_t 1 in
+ let fresh = (* TODO *) 1 in
+ let kind_type =
+ Lang.kind_type_of_kind_format ~fresh
+ (Lang.Unconstrained kind)
+ in
+ let return_t =
+ Lang.product_t
+ (Lang.fun_t [false,"",Lang.metadata_t] Lang.unit_t)
+ (Lang.source_t kind_type)
+ in
+ Lang.add_builtin "source.insert_metadata"
+ ~category:(string_of_category Liq)
+ ~descr:"Dynamically insert metadata in a stream. \
+ Returns a pair (f,s) where s is a new source and \
+ f is a function of type metadata -> unit, used to \
+ insert metadata in s."
+ [ "id",Lang.string_t,Some (Lang.string ""),
+ Some "Force the value of the source ID.";
+ "",Lang.source_t kind,None,None ] return_t
+ (fun p t ->
+ let s = Lang.to_source (List.assoc "" p) in
+ let id = Lang.to_string (List.assoc "id" p) in
+ let kind =
+ Lang.frame_kind_of_kind_type
+ (Lang.of_source_t
+ (Lang.of_snd_product_t t))
+ in
+ let s = new Insert_metadata.insert_metadata ~kind s in
+ if id <> "" then s#set_id id ;
+ let f =
+ Lang.val_fun ["","",Lang.metadata_t,None] ~ret_t:Lang.unit_t
+ (fun p t ->
+ s#insert_metadata
+ (Lang.to_metadata (List.assoc "" p));
+ Lang.unit)
+ in
+ Lang.product f (Lang.source (s :> Source.source)))
+
+let () =
add_builtin "request.create.raw" ~cat:Liq
~descr:"Create a raw request, i.e. for files that should not be decoded \
for streaming. Creation may fail if there is no available RID, \
Index: lang/lang.mli
===================================================================
--- lang/lang.mli (révision 7993)
+++ lang/lang.mli (copie de travail)
@@ -168,6 +168,8 @@
val bool_t : t
val string_t : t
val product_t : t -> t -> t
+val of_fst_product_t : t -> t
+val of_snd_product_t : t -> t
val list_t : t -> t
val of_list_t : t -> t
------------------------------------------------------------------------------
Increase Visibility of Your 3D Game App & Earn a Chance To Win $500!
Tap into the largest installed PC base & get more eyes on your game by
optimizing for Intel(R) Graphics Technology. Get started today with the
Intel(R) Software Partner Program. Five $500 cash prizes are up for grabs.
http://p.sf.net/sfu/intelisp-dev2dev
_______________________________________________
Savonet-devl mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/savonet-devl
