Commits

Anonymous committed a4aefc3

renamed modules (Types -> Am_Types, Ops -> It_Ops), installing via findlib

  • Participants
  • Parent commits 642a774

Comments (0)

Files changed (16)

+name="iteratees"
+version="0.1"
+description="Iteratees (safe, practical, declarative input processing)"
+requires="unix, lwt, lwt.unix"
+archive(byte)="iteratees.cma"
+archive(native)="iteratees.cmxa"
+PKG=iteratees
+VERSION=0.1
+
+TESTBIN=tests_lwt.byte
+
+all :
+	ocamlbuild \
+	   iteratees.cma iteratees.cmxa tests_lwt.byte tests_lwt.native \
+	   tests_direct.byte tests_direct.native
+
+install : all
+	ocamlfind install \
+	  -patch-version $(VERSION) \
+	  $(PKG) META \
+	  _build/iteratees.cma _build/iteratees.cmxa _build/iteratees.a \
+	  _build/iteratees.cmi \
+	  _build/it_Lwt_IO.cmi _build/direct_IO.cmi \
+	  _build/iteratees_http.cmi _build/it_Lwt_IO.cmi \
+	  _build/it_misc.cmi _build/it_Ops.cmi _build/it_Types.cmi \
+	  _build/subarray_cat.cmi _build/subarray.cmi
+
+deinstall :
+	ocamlfind remove $(PKG)
+
+reinstall :
+	-$(MAKE) deinstall
+	$(MAKE) install
+
+tests : all
+	_build/$(TESTBIN)
 <*.ml> | <*.mli> : camlp4r, warn_A
 
-"ops.ml" | "extStream.ml" : -camlp4r, camlp4o
+"it_Ops.ml" | "extStream.ml" : -camlp4r, camlp4o
 
 "iteratees.ml" : camlp4:no_quot
 

File direct_IO.ml

-open Types
+open It_Types
 ;
 
 (* OCaml Pervasives IO *)

File it_Lwt_IO.ml

-open Types
+open It_Types
 ;
 
 (* Lwt IO *)
+let some x = Some x
+
+(** пропустить значение последовательно через функции:
+    123 >> string_of_int >> print_string
+*)
+let ( >> ) x f = f x
+
+(** применить значение к функции:
+    print_string & string_of_int & 123
+
+    NB: оператор "&" является ключевым словом в jocaml
+
+    Если попробовать объявить "let ( $ ) f x = f x",
+    то полученный оператор будет левоассоциативным,
+    что нежелательно в данном случае.
+*)
+let ( & ) f x = f x
+
+(** композиция функций:
+    let print_int = print_string % string_of_int
+    let print_int = print_string $ string_of_int
+    let print_int_sum = print_string % string_of_int %% ( + )
+    let print_int_sum = print_string %% (string_of_int %% ( + ) )
+    let for_all pred = not % List.exists (not % pred)
+    let for_all2 pred = not %% List.exists2 (not %% pred)
+
+    Операторы левоассоциативны, у оператора ($) приоритет ниже,
+    чем у (%), и ниже, чем у арифметических операторов.
+*)
+let ( % ) f g = fun x -> f (g x)
+let ( $ ) = ( % )
+let ( %% ) f g = fun x y -> f (g x y)
+let ( %%% ) f g = fun x y z -> f (g x y z)
+
+(** применить инфиксную функцию:
+    123L /* Int64.add */ 234L
+*)
+let ( /* ) x y = y x
+let ( */ ) x y = x y
+
+
+(* Для удобного использования инфиксных операторов
+   существует отличное решение: pa_do
+   ( http://pa-do.forge.ocamlcore.org/ )
+   Если использовать его не можете, то в качестве
+   слабого подобия можно взять нижеследующие модули.
+   Их названия имеют вид "Тип1_as_тип2", и при открытии
+   такого модуля со значениями типа1 можно будет работать
+   теми операторами, которыми обычно работают со значениями
+   типа2.
+   Например,
+   let my_int64 =
+     let module M =
+       struct
+         open Int32_as_int
+         open Int64_as_float
+         let x = (Int64.of_int32 (123l + 234l)) +. 345L
+       end
+     in
+       M.x
+*)
+
+(* Замечание: для консистентности модули "Тип1_as_тип2"
+   всегда должны переопределять одни и те же операторы.
+*)
+
+(* todo: добавить в Int* операции mod, rem, битовые *)
+
+module Int_as_int =
+  struct
+    let ( + ) = Pervasives.( + )
+    let ( - ) = Pervasives.( - )
+    let ( * ) = Pervasives.( * )
+    let ( / ) = Pervasives.( / )
+    let ( ~- ) = Pervasives.( ~- )
+  end
+
+module Float_as_float =
+  struct
+    let ( +. ) = Pervasives.( +. )
+    let ( -. ) = Pervasives.( -. )
+    let ( *. ) = Pervasives.( *. )
+    let ( /. ) = Pervasives.( /. )
+    let ( ~-. ) = Pervasives.( ~-. )
+  end
+
+
+(** TODO core, pa_do, pa_openin *)
+
+module Int32_as_int =
+  struct
+    let ( + ) = Int32.add
+    let ( - ) = Int32.sub
+    let ( * ) = Int32.mul
+    let ( / ) = Int32.div
+    let ( ~- ) = Int32.neg
+  end
+
+module Int64_as_int =
+  struct
+    let ( + ) = Int64.add
+    let ( - ) = Int64.sub
+    let ( * ) = Int64.mul
+    let ( / ) = Int64.div
+    let ( ~- ) = Int64.neg
+  end
+
+module Int_as_float =
+  struct
+    let ( +. ) = Pervasives.( + )
+    let ( -. ) = Pervasives.( - )
+    let ( *. ) = Pervasives.( * )
+    let ( /. ) = Pervasives.( / )
+    let ( ~-. ) = Pervasives.( ~- )
+  end
+
+module Float_as_int =
+  struct
+    let ( + ) = Pervasives.( +. )
+    let ( - ) = Pervasives.( -. )
+    let ( * ) = Pervasives.( *. )
+    let ( / ) = Pervasives.( /. )
+    let ( ~- ) = Pervasives.( ~-. )
+  end
+
+module Int32_as_float =
+  struct
+    let ( +. ) = Int32.add
+    let ( -. ) = Int32.sub
+    let ( *. ) = Int32.mul
+    let ( /. ) = Int32.div
+    let ( ~-. ) = Int32.neg
+  end
+
+module Int64_as_float =
+  struct
+    let ( +. ) = Int64.add
+    let ( -. ) = Int64.sub
+    let ( *. ) = Int64.mul
+    let ( /. ) = Int64.div
+    let ( ~-. ) = Int64.neg
+  end
+
+module Int_as_int_overflow =
+  (* from http://alan.petitepomme.net/cwn/2004.06.22.html *)
+  struct
+    exception Overflow
+
+    let ( + ) a b =
+      let c = a + b in
+      if (a lxor b) lor (a lxor (lnot c)) < 0 then c else raise Overflow
+
+    let ( - ) a b =
+      let c = a - b in
+      if (a lxor (lnot b)) lor (b lxor c) < 0 then c else raise Overflow
+
+    let ( * ) a b =
+      let c = a * b in
+      if Int64.of_int c = Int64.mul (Int64.of_int a) (Int64.of_int b)
+      then c else raise Overflow
+
+    let ( / ) a b =
+      if a = min_int && b = -1 then raise Overflow else a / b
+
+    let ( ~- ) x =
+      if x <> min_int then -x else raise Overflow
+
+  end
+(* +
+   The [place] type represents the place where exception
+   was raised.  For now, it's a name of IO function returned
+   an error.
+*)
+
+type place = string;
+
+
+(* +
+   IO exception, carrying the real IO exception and the place
+   (usually function name) where it was raised.
+*)
+
+exception EIO of (exn * place);
+
+
+(* +
+   Sometimes it's more convenient to have an IO result wrapped
+   in value with type [res 'a], than having to [IO.catch] errors.
+   See function [mres] in functor.
+*)
+
+type res +'a = [= `Ok of 'a | `Error of exn ]
+;
+
+
+(* +
+   This is a signature for IO monad.  These functions and types are used
+   by Iteratees functor.  It's possible that your implementation of IO
+   have much more functions than MonadIO, so you should not restrict
+   your IO implementation by this MonadIO signature.
+*)
+
+module type MonadIO
+ =
+  sig
+    type m +'a;
+    value return : 'a -> m 'a;
+    value bind : ('a -> m 'b) -> m 'a -> m 'b;
+
+    value error : exn -> m 'a;
+    value catch : (unit -> m 'a) -> (exn -> m 'a) -> m 'a;
+
+    type output_channel;
+    value stdout : output_channel;
+    value write : output_channel -> string -> m unit;
+
+    type input_channel;
+    value open_in : string -> m input_channel;
+    value close_in : input_channel -> m unit;  (* Lwt_io.close inch *)
+    value read_into : input_channel -> string -> int -> int -> m int;
+       (* in lwt: read_into ic buffer offset length *)
+
+    value runIO : m 'a -> res 'a;
+  end
+;
-open Ops
+open It_Ops
 ;
 
 module S = Subarray
     type t 'a = array (Subarray.t 'a)
     ;
 
-    open Ops
+    open It_Ops
     ;
 
     value make lst = Array.of_list &
 ;
 
 
-module UTF8(IO : Types.MonadIO)
+module UTF8(IO : It_Types.MonadIO)
  :
   sig
     type uchar = private int;

File iteratees.ml

 value break_chars_buf_init_size = 25
 ;
 
-open Ops
+open It_Ops
 ;
 
 open Dbg
 module S = Subarray
 ;
 
-open Types
+open It_Types
 ;
 
 (* +

File iteratees.mllib

+Iteratees
+Direct_IO
+Iteratees_http
+It_Lwt_IO
+It_misc
+Subarray_cat
+Subarray
+It_Types
+Dbg
+It_Ops

File iteratees_http.ml

-open Types
+open It_Types
 ;
 
 open Dbg
 ;
 
-open Ops
+open It_Ops
 ;
 
 module It_http (IO : MonadIO) =

File ops.ml

-let some x = Some x
-
-(** пропустить значение последовательно через функции:
-    123 >> string_of_int >> print_string
-*)
-let ( >> ) x f = f x
-
-(** применить значение к функции:
-    print_string & string_of_int & 123
-
-    NB: оператор "&" является ключевым словом в jocaml
-
-    Если попробовать объявить "let ( $ ) f x = f x",
-    то полученный оператор будет левоассоциативным,
-    что нежелательно в данном случае.
-*)
-let ( & ) f x = f x
-
-(** композиция функций:
-    let print_int = print_string % string_of_int
-    let print_int = print_string $ string_of_int
-    let print_int_sum = print_string % string_of_int %% ( + )
-    let print_int_sum = print_string %% (string_of_int %% ( + ) )
-    let for_all pred = not % List.exists (not % pred)
-    let for_all2 pred = not %% List.exists2 (not %% pred)
-
-    Операторы левоассоциативны, у оператора ($) приоритет ниже,
-    чем у (%), и ниже, чем у арифметических операторов.
-*)
-let ( % ) f g = fun x -> f (g x)
-let ( $ ) = ( % )
-let ( %% ) f g = fun x y -> f (g x y)
-let ( %%% ) f g = fun x y z -> f (g x y z)
-
-(** применить инфиксную функцию:
-    123L /* Int64.add */ 234L
-*)
-let ( /* ) x y = y x
-let ( */ ) x y = x y
-
-
-(* Для удобного использования инфиксных операторов
-   существует отличное решение: pa_do
-   ( http://pa-do.forge.ocamlcore.org/ )
-   Если использовать его не можете, то в качестве
-   слабого подобия можно взять нижеследующие модули.
-   Их названия имеют вид "Тип1_as_тип2", и при открытии
-   такого модуля со значениями типа1 можно будет работать
-   теми операторами, которыми обычно работают со значениями
-   типа2.
-   Например,
-   let my_int64 =
-     let module M =
-       struct
-         open Int32_as_int
-         open Int64_as_float
-         let x = (Int64.of_int32 (123l + 234l)) +. 345L
-       end
-     in
-       M.x
-*)
-
-(* Замечание: для консистентности модули "Тип1_as_тип2"
-   всегда должны переопределять одни и те же операторы.
-*)
-
-(* todo: добавить в Int* операции mod, rem, битовые *)
-
-module Int_as_int =
-  struct
-    let ( + ) = Pervasives.( + )
-    let ( - ) = Pervasives.( - )
-    let ( * ) = Pervasives.( * )
-    let ( / ) = Pervasives.( / )
-    let ( ~- ) = Pervasives.( ~- )
-  end
-
-module Float_as_float =
-  struct
-    let ( +. ) = Pervasives.( +. )
-    let ( -. ) = Pervasives.( -. )
-    let ( *. ) = Pervasives.( *. )
-    let ( /. ) = Pervasives.( /. )
-    let ( ~-. ) = Pervasives.( ~-. )
-  end
-
-
-(** TODO core, pa_do, pa_openin *)
-
-module Int32_as_int =
-  struct
-    let ( + ) = Int32.add
-    let ( - ) = Int32.sub
-    let ( * ) = Int32.mul
-    let ( / ) = Int32.div
-    let ( ~- ) = Int32.neg
-  end
-
-module Int64_as_int =
-  struct
-    let ( + ) = Int64.add
-    let ( - ) = Int64.sub
-    let ( * ) = Int64.mul
-    let ( / ) = Int64.div
-    let ( ~- ) = Int64.neg
-  end
-
-module Int_as_float =
-  struct
-    let ( +. ) = Pervasives.( + )
-    let ( -. ) = Pervasives.( - )
-    let ( *. ) = Pervasives.( * )
-    let ( /. ) = Pervasives.( / )
-    let ( ~-. ) = Pervasives.( ~- )
-  end
-
-module Float_as_int =
-  struct
-    let ( + ) = Pervasives.( +. )
-    let ( - ) = Pervasives.( -. )
-    let ( * ) = Pervasives.( *. )
-    let ( / ) = Pervasives.( /. )
-    let ( ~- ) = Pervasives.( ~-. )
-  end
-
-module Int32_as_float =
-  struct
-    let ( +. ) = Int32.add
-    let ( -. ) = Int32.sub
-    let ( *. ) = Int32.mul
-    let ( /. ) = Int32.div
-    let ( ~-. ) = Int32.neg
-  end
-
-module Int64_as_float =
-  struct
-    let ( +. ) = Int64.add
-    let ( -. ) = Int64.sub
-    let ( *. ) = Int64.mul
-    let ( /. ) = Int64.div
-    let ( ~-. ) = Int64.neg
-  end
-
-module Int_as_int_overflow =
-  (* from http://alan.petitepomme.net/cwn/2004.06.22.html *)
-  struct
-    exception Overflow
-
-    let ( + ) a b =
-      let c = a + b in
-      if (a lxor b) lor (a lxor (lnot c)) < 0 then c else raise Overflow
-
-    let ( - ) a b =
-      let c = a - b in
-      if (a lxor (lnot b)) lor (b lxor c) < 0 then c else raise Overflow
-
-    let ( * ) a b =
-      let c = a * b in
-      if Int64.of_int c = Int64.mul (Int64.of_int a) (Int64.of_int b)
-      then c else raise Overflow
-
-    let ( / ) a b =
-      if a = min_int && b = -1 then raise Overflow else a / b
-
-    let ( ~- ) x =
-      if x <> min_int then -x else raise Overflow
-
-  end
-open Ops
+open It_Ops
 ;
 
 module C

File subarray_cat.ml

-open Ops
+open It_Ops
 ;
 
 module S = Subarray

File tests_common.ml

-open Ops
+open It_Ops
 ;
 
-open Types
+open It_Types
 ;
 
 (*

File types.ml

-(* +
-   The [place] type represents the place where exception
-   was raised.  For now, it's a name of IO function returned
-   an error.
-*)
-
-type place = string;
-
-
-(* +
-   IO exception, carrying the real IO exception and the place
-   (usually function name) where it was raised.
-*)
-
-exception EIO of (exn * place);
-
-
-(* +
-   Sometimes it's more convenient to have an IO result wrapped
-   in value with type [res 'a], than having to [IO.catch] errors.
-   See function [mres] in functor.
-*)
-
-type res +'a = [= `Ok of 'a | `Error of exn ]
-;
-
-
-(* +
-   This is a signature for IO monad.  These functions and types are used
-   by Iteratees functor.  It's possible that your implementation of IO
-   have much more functions than MonadIO, so you should not restrict
-   your IO implementation by this MonadIO signature.
-*)
-
-module type MonadIO
- =
-  sig
-    type m +'a;
-    value return : 'a -> m 'a;
-    value bind : ('a -> m 'b) -> m 'a -> m 'b;
-
-    value error : exn -> m 'a;
-    value catch : (unit -> m 'a) -> (exn -> m 'a) -> m 'a;
-
-    type output_channel;
-    value stdout : output_channel;
-    value write : output_channel -> string -> m unit;
-
-    type input_channel;
-    value open_in : string -> m input_channel;
-    value close_in : input_channel -> m unit;  (* Lwt_io.close inch *)
-    value read_into : input_channel -> string -> int -> int -> m int;
-       (* in lwt: read_into ic buffer offset length *)
-
-    value runIO : m 'a -> res 'a;
-  end
-;