1. Dmitry Grebeniuk
  2. cadastr

Commits

Dmitry Grebeniuk  committed 6b31d53

code move: amall -> cadastr

  • Participants
  • Parent commits 2f41183
  • Branches default

Comments (0)

Files changed (7)

File _oasis

View file
  • Ignore whitespace
 Library cadastr
   Path:       src
   BuildDepends: num
-  Modules:    Cadastr, Monoid, Cd_All, Cd_Int, Cd_List, Cd_Ops, Cd_Byte, Cd_Bytes, Cd_Chars, Cd_Strings, Cd_Array, Cd_Typeinfo, Cdt, Cd_Types, Cd_Option, Cd_Num, Cd_Tuples, Cd_Bool, Cd_Ref, Cd_Partapp, Cd_Int64, Cd_Ser, Cd_SortedArray, Cd_SortedArraySet, Cd_Utf8, Cd_Buffer, Cd_StringsCommon, Cd_Exn
+  Modules:    Cadastr, Monoid, Cd_All, Cd_Int, Cd_List, Cd_Ops, Cd_Byte, Cd_Bytes, Cd_Chars, Cd_Strings, Cd_Array, Cd_Typeinfo, Cdt, Cd_Types, Cd_Option, Cd_Num, Cd_Tuples, Cd_Bool, Cd_Ref, Cd_Partapp, Cd_Int64, Cd_Ser, Cd_SortedArray, Cd_SortedArraySet, Cd_Utf8, Cd_Buffer, Cd_StringsCommon, Cd_Exn, Cd_Queue, Cd_Stream, Cd_Sys
   NativeOpt:       -w A
   ByteOpt:         -w A
 

File setup.ml

View file
  • Ignore whitespace
 (* setup.ml generated for the first time by OASIS v0.2.1~alpha1 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 04fedc487b8764927a891e9ef1925c73) *)
+(* DO NOT EDIT (digest: f10c5d5ab73b3fdf377d722e740bcb81) *)
 (*
    Regenerated by OASIS v0.2.1~alpha1
    Visit http://oasis.forge.ocamlcore.org for more information and
                            "Cd_Utf8";
                            "Cd_Buffer";
                            "Cd_StringsCommon";
-                           "Cd_Exn"
+                           "Cd_Exn";
+                           "Cd_Queue";
+                           "Cd_Stream";
+                           "Cd_Sys"
                         ];
                       lib_internal_modules = [];
                       lib_findlib_parent = None;

File src/cadastr.mllib

View file
  • Ignore whitespace
 # OASIS_START
-# DO NOT EDIT (digest: 6c0d6c348445da4b0f7ba2a64728a48c)
+# DO NOT EDIT (digest: c3a203ba5b6438547a43398b0a741493)
 Cadastr
 Monoid
 Cd_All
 Cd_Buffer
 Cd_StringsCommon
 Cd_Exn
+Cd_Queue
+Cd_Stream
+Cd_Sys
 # OASIS_STOP

File src/cd_Array.ml

View file
  • Ignore whitespace
              else loop (i + 1)
     ;
 
+
+    value map_filter func arr =
+      inner [] (Array.length arr - 1)
+      where rec inner acc i =
+        if i < 0
+        then
+          Array.of_list acc
+        else
+          match func arr.(i) with
+          [ None -> inner acc (i - 1)
+          | Some x -> inner [x :: acc] (i - 1)
+          ]
+    ;
+
+
+    value findi_opt pred arr =
+      inner 0
+      where rec inner i =
+        if i = Array.length arr
+        then None
+        else
+          if pred arr.(i)
+          then Some (i, arr.(i))
+          else inner (i + 1)
+    ;
+
+
+    value eqlen funcname a1 a2 =
+      let len = Array.length a1 in
+      if len <> Array.length a2
+      then invalid_arg ("Am_Array." ^ funcname
+        ^ ": arrays must have equal length")
+      else
+        len
+    ;
+
+
+    value map2 f a1 a2 =
+      let len = eqlen "map2" a1 a2 in
+      Array.init len
+        (fun i -> f a1.(i) a2.(i)
+        )
+    ;
+
+
+    value mapi2 f a1 a2 =
+      let len = eqlen "mapi2" a1 a2 in
+      Array.init len
+        (fun i -> f i a1.(i) a2.(i)
+        )
+    ;
+
+
+    value iter2 f a1 a2 =
+      let len = eqlen "iter2" a1 a2 in
+      for i = 0 to len-1
+      do
+        ( f a1.(i) a2.(i) )
+      done
+    ;
+
+
+    value findi_all pred arr =
+      inner [] (Array.length arr - 1)
+      where rec inner acc i =
+        if i < 0
+        then acc
+        else
+          let new_acc =
+            if pred arr.(i)
+            then [(i, arr.(i)) :: acc]
+            else acc
+          in
+            inner new_acc (i - 1)
+    ;
+
+
+
+
     value dump ~t arr =
       arr
       |> map_to_list t#show
       |> sprintf "[| %s |]"
     ;
 
+
+    module Build
+     :
+      sig
+        type t 'a;
+        value create : unit -> t 'a;
+        value add : 'a -> t 'a -> unit;
+        value get : t 'a -> array 'a;
+      end
+     =
+      struct
+        open Cd_Queue;
+        type t 'a = Queue.t 'a;
+        value create = Queue.create;
+        value add = Queue.push;
+        value get = Queue.copy_to_array;
+      end
+    ;
+
+
     module BuildSized
      :
       sig
 
       end
     ;
+
+
+    module Functor
+     =
+      struct
+        type t 'a = array 'a;
+        value fmap = Array.map;
+      end
+    ;
+
   end
 ;

File src/cd_Queue.ml

View file
  • Ignore whitespace
+module Queue
+ =
+  struct
+
+    include Queue;
+
+    value copy_to_array q =
+      let len = Queue.length q in
+      if len = 0
+      then [| |]
+      else
+        let q0 = Queue.peek q in
+        let arr = Array.make len q0 in
+        let i = ref 0 in
+        let () = iter
+          (fun x -> (arr.(i.val) := x; incr i))
+          q
+        in
+          arr
+    ;
+
+    value take_opt q = try Some (take q) with [ Empty -> None ]
+    ;
+
+  end
+;

File src/cd_Stream.ml

View file
  • Ignore whitespace
+module Stream
+ =
+  struct
+
+    include Stream;
+
+    value input_line_opt in_ch =
+      try Some (input_line in_ch) with
+      [ End_of_file -> None ]
+    ;
+
+(*
+    value lines_of_channel in_ch =
+      from
+        (fun _ ->
+           input_line_opt in_ch
+        )
+    ;
+*)
+
+    value next_opt s =
+      match peek s with
+      [ None -> None
+      | (Some _) as some_x ->
+          ( Stream.junk s
+          ; some_x
+          )
+      ]
+    ;
+
+    value map f s = Stream.from (fun _ ->
+      match next_opt s with
+      [ None -> None
+      | Some x -> Some (f x)
+      ]
+     )
+    ;
+
+    value map_filter
+     : ! 'a 'b . ('a -> option 'b) -> t 'a -> t 'b
+     = fun f s -> Stream.from inner
+      where rec inner _streamarg =
+        match next_opt s with
+        [ None -> None
+        | Some x ->
+            match f x with
+            [ None -> inner _streamarg
+            | some_v -> some_v
+            ]
+        ]
+    ;
+
+    value is_empty s =
+      try (Stream.empty s; True)
+      with [ Stream.Failure -> False ]
+    ;
+
+    value rec njunk n s =
+      if n <= 0
+      then ()
+      else (junk s; njunk (n - 1) s)
+    ;
+
+
+    (* leave no more than n last items of stream s, junk others. *)
+
+    value keep_last n s =
+      if n < 1 then invalid_arg "Am_Stream.last" else
+      loop ()
+      where rec loop () =
+        let l = List.length (npeek (n + 1) s) in
+        if l <= n
+        then ()
+        else (junk s; loop ())
+    ;
+
+    value to_list s =
+      inner []
+      where rec inner rev_acc =
+        match next_opt s with
+        [ None -> List.rev rev_acc
+        | Some x -> inner [x :: rev_acc]
+        ]
+    ;
+
+    value pervasives_eq a b = (Pervasives.compare a b = 0)
+    ;
+
+    value is_prefix ?(eq=pervasives_eq) ~prefix stream =
+      let pref_len = List.length prefix in
+      let spref = npeek pref_len stream in
+         List.length spref = pref_len
+      && List.for_all2 eq prefix spref
+    ;
+
+  end
+;

File src/cd_Sys.ml

View file
  • Ignore whitespace
+module Sys
+ =
+  struct
+
+    include Sys;
+
+    value names_of_signals =
+      [ (sigabrt, "sigabrt")
+      ; (sigalrm, "sigalrm")
+      ; (sigfpe, "sigfpe")
+      ; (sighup, "sighup")
+      ; (sigill, "sigill")
+      ; (sigint, "sigint")
+      ; (sigkill, "sigkill")
+      ; (sigpipe, "sigpipe")
+      ; (sigquit, "sigquit")
+      ; (sigsegv, "sigsegv")
+      ; (sigterm, "sigterm")
+      ; (sigusr1, "sigusr1")
+      ; (sigusr2, "sigusr2")
+      ; (sigchld, "sigchld")
+      ; (sigcont, "sigcont")
+      ; (sigstop, "sigstop")
+      ; (sigtstp, "sigtstp")
+      ; (sigttin, "sigttin")
+      ; (sigttou, "sigttou")
+      ; (sigvtalrm, "sigvtalrm")
+      ; (sigprof, "sigprof")
+      ]
+    ;
+
+    value name_of_signal n =
+      try
+        List.assoc n names_of_signals
+      with
+      [ Not_found -> Printf.sprintf "signal %i" n]
+    ;
+
+  end
+;