New upstream version 0.8.0

5 files changed, 11 insertions, 410 deletions

diff --git a/src/META.in b/src/META.in
index f6d5d5c..9480812 100644
--- a/src/META.in
+++ b/src/META.in
@@ -8,5 +8,3 @@ archive(native)="duppy.cmxa"
 @DUPPY_SSL_META@
 
 @DUPPY_SECURE_TRANSPORT_META@
-
-@PA_DUPPY_META@
diff --git a/src/Makefile.in b/src/Makefile.in
index 660b8c0..2fb5511 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -27,8 +27,8 @@ OCAMLLIBPATH = @CAMLLIBPATH@
 SOURCES = duppy_stubs.c duppy.ml duppy.mli
 RESULT = duppy
 OCAMLDOCFLAGS = -stars
-DOC_FILES = $(filter %.mli, $(SOURCES)) @PA_DOC@
-LIBINSTALL_FILES = $(DOC_FILES) $(wildcard *pa_duppy.cm* *.cmi *.cma *.cmxa *.cmx *.a *.so)
+DOC_FILES = $(filter %.mli, $(SOURCES))
+LIBINSTALL_FILES = $(DOC_FILES) $(wildcard *.cmi *.cma *.cmxa *.cmx *.a *.so)
 ACLIBS = @LIBS@
 LDFLAGS = @LDFLAGS@
 CLIBS = $(ACLIBS:-l%=%)
@@ -39,16 +39,9 @@ CPPFLAGS = @CPPFLAGS@
 INCDIRS = @INC@
 NO_CUSTOM = yes
 OCAMLFLAGS = @OCAMLFLAGS@
-TRASH = pa_duppy.cm*
 ANNOTATE = true
 
-all: $(OCAMLBEST) @PA_DUPPY@ @DUPPY_SSL@ @DUPPY_SECURE_TRANSPORT@
-
-pa_duppy.cmo: pa_duppy.ml pa_duppy.cmi
-	$(OCAMLFIND) ocamlc -c -package camlp4 -package camlp4.quotations.o -package camlp4.extend -syntax camlp4o pa_duppy.ml
-
-pa_duppy.cmi: pa_duppy.mli
-	$(OCAMLFIND) ocamlc -c -package camlp4 -package camlp4.quotations.o -package camlp4.extend -syntax camlp4o pa_duppy.mli
+all: $(OCAMLBEST) @DUPPY_SSL@ @DUPPY_SECURE_TRANSPORT@
 
 duppy_ssl:
 	$(MAKE) SOURCES="duppy_ssl.mli duppy_ssl.ml" RESULT="duppy_ssl" $(OCAMLBEST)
diff --git a/src/duppy.ml b/src/duppy.ml
index 5b28871..3f855fa 100644
--- a/src/duppy.ml
+++ b/src/duppy.ml
@@ -346,11 +346,15 @@ let queue ?log ?(priorities=fun _ -> true) s name =
     end
    in
    let rec f () =
-     try run (); f () with
-      | Queue_processed -> f ()
-      | Queue_stopped -> ()
+    begin
+     try run () with
+      | Queue_processed -> ()
+    end;
+    (f [@tailcall]) ()
    in
-   f ()
+   try
+     f ()
+   with Queue_stopped -> ()
 
 module Async =
 struct
diff --git a/src/pa_duppy.ml b/src/pa_duppy.ml
deleted file mode 100644
index 7743cf4..0000000
--- a/src/pa_duppy.ml
+++ /dev/null
@@ -1,222 +0,0 @@
-(* Ocaml-duppy syntax extension
- * Module Pa_duppy, based on an original work
- * from Jérémie Dimino.
- * Copyright (C) 2009 Jérémie Dimino
- * Copyright (C) 2010 Romain Beauxis
- *
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU Lesser General Public License as
- * published by the Free Software Foundation, with linking exceptions;
- * either version 2.1 of the License, or (at your option) any later
- * version. See COPYING file for details.
- *
- * This program is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
- * 02111-1307, USA.
- *)
-
-open Camlp4
-open Camlp4.PreCast
-open Syntax
-
-let gen_binding l =
-  let rec aux n = function
-    | [] ->
-        assert false
-    | [(_loc, p, e)] ->
-          <:binding< $lid:"__pa_duppy_" ^ string_of_int n$ = $e$ >>
-    | (_loc, p, e) :: l ->
-          <:binding< $lid:"__pa_duppy_" ^ string_of_int n$ = $e$ and $aux (n + 1) l$ >>
-  in
-  aux 0 l
-
-let gen_bind l e =
-  let rec aux n = function
-    | [] ->
-        e
-    | (_loc, p, e) :: l ->
-        <:expr< Duppy.Monad.bind $lid:"__pa_duppy_" ^ string_of_int n$ (fun $p$ -> $aux (n + 1) l$) >>
-  in
-  aux 0 l
-
-let rec gen_do _loc e = 
-  let rec aux = function
-    | e :: [] -> e
-    | e :: l  ->
-        <:expr< Duppy.Monad.bind begin $e$ end 
-                (fun () -> $aux l$) >>
-    | [] -> <:expr< () >>
-  in
-  aux (Ast.list_of_expr e [])
-
-let rec gen_write ~t ~p h _loc e =
-  let do_write e = 
-    <:expr< Duppy.Monad.Io.write
-                 ?timeout:$t$
-                 ~priority:$p$
-                 $h$ ($e$) >>
-  in
-  let rec aux = function
-    | e :: [] -> do_write e
-    | e :: l  ->
-     <:expr< 
-       Duppy.Monad.bind
-                 ($do_write e$)
-                 (fun () -> $aux l$) >>
-    | [] -> <:expr< Duppy.Monad.return () >>
-  in
-  aux (Ast.list_of_expr e [])
-
-exception Patt_assoc of Camlp4.PreCast.Syntax.Ast.expr
-
-let patt_assoc s l =
-  let f (p,x) = 
-    match p with
-      | <:patt< $lid:f$ >> when f = s -> 
-          raise (Patt_assoc x)
-      | _ -> ()
-  in
-  try
-    List.iter f l ;
-    raise Not_found
-  with
-    | Patt_assoc x -> x
-
-EXTEND Gram
-  GLOBAL: expr;
-
-    letb_binding:
-      [ [ b1 = SELF; "and"; b2 = SELF -> b1 @ b2
-        | p = patt; "="; e = expr -> [(_loc, p, e)]
-        ] ];
-
-    duppy_match:
-      [ [ p = patt; "="; v = expr LEVEL "top"; ";"; l = duppy_match -> (p,v) :: l
-        | p = patt; "="; v = expr LEVEL "top" -> [(p,v)]
-        ] ];
-
-    expr: LEVEL "top"
-      [ [ "duppy_try"; e = expr LEVEL ";"; "with"; c = match_case ->
-            <:expr< Duppy.Monad.catch $e$ (function $c$) >>
-
-        | "duppy_run"; e = expr LEVEL ";"; "with"; "{"; l = duppy_match; "}" ->
-            let return,raise = 
-              try
-                patt_assoc "return" l,
-                patt_assoc "raise"  l
-              with
-                | Not_found ->
-                    invalid_arg ("Invalid arguments for duppy_run")
-            in
-            <:expr< Duppy.Monad.run ~return:$return$ ~raise:$raise$ $e$ >>
-
-        | "duppy"; l = letb_binding; "in"; e = expr LEVEL ";" ->
-            <:expr< let $gen_binding l$ in $gen_bind l e$ >>
-
-        | "duppy_do"; e = do_sequence -> 
-             <:expr< $gen_do _loc e$ >>
-
-        | "duppy_iter" ->
-             <:expr< Duppy.Monad.iter >>
- 
-        | "duppy_delay" ->
-            <:expr< Duppy.Monad.Io.delay >>
-
-        | "duppy_fold_left" ->
-             <:expr< Duppy.Monad.fold_left >>
-
-        | "duppy_return"; e = expr LEVEL "top" ->
-             <:expr< Duppy.Monad.return $e$ >>
-
-        | "duppy_raise"; e = expr LEVEL "top" ->
-             <:expr< Duppy.Monad.raise $e$ >>
-
-        | "duppy_exec"; e = expr; "with"; "{"; l = duppy_match; "}" ->
-             let p,h = 
-               try
-                 patt_assoc "priority" l,
-                 patt_assoc "handler" l 
-               with
-                 | Not_found ->
-                    invalid_arg ("Invalid arguments for duppy_exec")
-             in
-             <:expr< Duppy.Monad.Io.exec ~priority:$p$ $h$ $e$ >>
-
-        | "duppy_write"; e = sequence; "with"; "{"; l = duppy_match; "}" ->
-             let p,h =
-               try
-                 patt_assoc "priority" l,
-                 patt_assoc "handler" l
-               with
-                 | Not_found ->
-                    invalid_arg ("Invalid arguments for duppy_write")
-             in
-             let t =
-               try
-                 let t = patt_assoc "timeout" l in
-                 <:expr< Some $t$ >>
-               with Not_found -> <:expr< None >>
-             in
-             gen_write ~t ~p h _loc e
-
-        | "duppy_write_bigarray"; e = expr; "with"; "{"; l = duppy_match; "}" ->
-             let p,h =
-               try
-                 patt_assoc "priority" l,
-                 patt_assoc "handler" l
-               with
-                 | Not_found ->
-                    invalid_arg ("Invalid arguments for duppy_write_big_array")
-             in
-             let t =
-               try
-                 let t = patt_assoc "timeout" l in
-                 <:expr< Some $t$ >>
-               with Not_found -> <:expr< None >>
-             in
-             <:expr< Duppy.Monad.Io.write_bigarray ?timeout:$t$ ~priority:$p$ $h$ $e$ >>
-
-        | "duppy_read"; e = expr; "with"; "{"; l = duppy_match; "}" ->
-             let p,h =
-               try
-                 patt_assoc "priority" l,
-                 patt_assoc "handler" l
-               with
-                 | Not_found ->
-                    invalid_arg ("Invalid arguments for duppy_read")
-             in
-             let t =
-               try
-                 let t = patt_assoc "timeout" l in
-                 <:expr< Some $t$ >>
-               with Not_found -> <:expr< None >>
-             in
-             <:expr< Duppy.Monad.Io.read ?timeout:$t$ ~priority:$p$ ~marker:$e$ $h$ >>
-
-        | "duppy_read_all"; e = expr; "with"; "{"; l = duppy_match; "}" ->
-             let p,s =
-               try
-                 patt_assoc "priority" l,
-                 patt_assoc "scheduler" l
-               with
-                 | Not_found ->
-                    invalid_arg ("Invalid arguments for duppy_read_all")
-             in
-             let t =
-               try
-                 let t = patt_assoc "timeout" l in
-                 <:expr< Some $t$ >>
-               with Not_found -> <:expr< None >>
-             in
-             <:expr< Duppy.Monad.Io.read_all ?timeout:$t$ ~priority:$p$ $s$ $e$ >>
-
-        ] ];
-
-END
-
diff --git a/src/pa_duppy.mli b/src/pa_duppy.mli
deleted file mode 100644
index f50f9fd..0000000
--- a/src/pa_duppy.mli
+++ /dev/null
@@ -1,172 +0,0 @@
-(*****************************************************************************
-
-  Duppy, a task scheduler for OCaml.
-  Copyright 2003-2010 Savonet team
-
-  This program is free software; you can redistribute it and/or modify
-  it under the terms of the GNU General Public License as published by
-  the Free Software Foundation; either version 2 of the License, or
-  (at your option) any later version.
-
-  This program is distributed in the hope that it will be useful,
-  but WITHOUT ANY WARRANTY; without even the implied warranty of
-  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-  GNU General Public License for more details, fully stated in the COPYING
-  file at the root of the liquidsoap distribution.
-
-  You should have received a copy of the GNU General Public License
-  along with this program; if not, write to the Free Software
-  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-
- *****************************************************************************)
-
-(** {2 Syntactic sugar for {!Duppy.Monad} }
-  *
-  * This module provides syntactic extensions to OCaml
-  * using Camlp4 used to write code using {!Duppy.Monad}.
-  *
-  * It provides the following extensions:
-  *
-  * {2 Main Monad }
-  * 
-  * {ul
-  * {- {[ duppy v = 
-  *   foo
-  *  in
-  *  bar x ]}
-  *
-  * is equivalent to:
-  * 
-  * [Duppy.Monad.bind foo (fun x -> bar x)] 
-  * 
-  * }
-  * {- {[ duppy_run
-  *     foo
-  *   with
-  *     { return = f ;
-  *       raise  = g } ]}
-  *
-  * is equivalent to:
-  *
-  * [Duppy.Monad.run ~return:f ~raise:g ()]
-  * 
-  * } 
-  * {- {[ duppy_try
-  *     foo
-  *   with
-  *     | a -> f
-  *     | b -> g ]}
-  *
-  * is equivalent to:
-  *
-  * {[ Duppy.Monad.catch
-  *     foo
-  *     (function
-  *         | a -> f
-  *         | b -> g) ]} 
-  * 
-  * }
-  * {- [duppy_fold_left] is equivalent to [Duppy.Monad.fold_left]
-  *
-  * }
-  * {- [duppy_iter] is equivalent to [Duppy.Monad.iter]
-  *
-  * }
-  * {- [duppy_return] is equivalent to [Duppy.Monad.return]
-  *
-  * }
-  * {- [duppy_raise] is equivalent to [Duppy.Monad.raise]
-  * 
-  * }
-  * {- {[ duppy_do
-  *   foo ;
-  *   bar ;
-  *   ...
-  * done ]}
-  *
-  * is equivalent to:
-  *
-  * {[ Duppy.Monad.bind
-  *     (Duppy.Monad.bind 
-  *       foo 
-  *       (fun () -> bar))
-  *     (fun () -> ...) ]}
-  *
-  * }}
-  * 
-  * {2 I/O module }
-  *
-  * {ul
-  * {- {[duppy_exec
-  *  foo
-  * with
-  *   { priority = p ;
-  *     handler  = h 
-  *     delay    = d } ]}
-  *
-  * is equivalent to:
-  *
-  * {[ Duppy.Monad.Io.exec
-  *  ~priority:p ~delay:d h foo ]} 
-  * 
-  * [delay] is an optional field.
-  *
-  * }
-  * {- [duppy_delay] is equivalent to [Duppy.Monad.Io.delay]}
-  * {- {[duppy_read
-  *  marker
-  * with
-  *   { priority = p ;
-  *     handler  = h ;
-  *     timeout  = t } ]} 
-  *
-  * is equivalent to:
-  *
-  * {[ Duppy.Monad.Io.read
-  *  ~timeout:t ~priority:p h marker ]}
-  *
-  * Timeout parameter is optional.
-  * }
-  * {- {[duppy_read_all
-  *  socket
-  * with
-  *   { priority  = p ;
-  *     handler   = h ;
-  *     timeout   = t } ]}
-  *
-  * is equivalent to:
-  *
-  * {[ Duppy.Monad.Io.read_all
-  *  ~timeout:t ~priority:p s socket ]}
-  *
-  * Timeout parameter is optional.
-  * }
-  * {- {[duppy_write
-  *  s
-  * with
-  *   { priority = p ;
-  *     handler  = h ;
-  *     timeout  = t } ]}
-  *
-  * is equivalent to:
-  *
-  * {[ Duppy.Monad.Io.write
-  *  ~timeout:t ~priority:p ~string:s h ]}
-  *
-  * Timeout parameter is optional.
-  * }
-  * {- {[duppy_write_bigarray
-  *  ba
-  * with
-  *   { priority = p ;
-  *     handler  = h ;
-  *     timeout  = t } ]}
-  *
-  * is equivalent to:
-  *
-  * {[ Duppy.Monad.Io.write
-  *  ~timeout:t ~priority:p ~bigarray:ba h ]}
-  *
-  * Timeout parameter is optional.
-  * }}
-  *)