Commits

Anonymous committed b91dbb7

+ oasis, + tests (oUnit)

  • Participants
  • Parent commits aeb5852

Comments (0)

Files changed (9)

 (* OASIS_START *)
-(* DO NOT EDIT (digest: c33a4bee2b831d60482bd1d81bb295f2) *)
+(* DO NOT EDIT (digest: b8cc7b7c2ff5566e6ed1bb993abd2ce7) *)
 This is the INSTALL file for the cadastr distribution.
 
 This package uses OASIS to generate its build system. See section OASIS for
 In order to compile this package, you will need:
 * ocaml
 * findlib
+* oUnit for executable tests
 
 Installing
 ==========
   BuildTools: ocamlbuild
   MainIs:     test.ml
   CompiledObject: byte
+  BuildDepends: oUnit
 
 Test all
   Command: ./test.byte
 # OASIS_START
-# DO NOT EDIT (digest: d1632898291679eee48139a68f63e2d0)
+# DO NOT EDIT (digest: b04a4f94642488bb29ba9dea4b828e6d)
 # Ignore VCS directories, you can use the same kind of rule outside 
 # OASIS_START/STOP if you want to exclude directories that contains 
 # useless stuff for the build process
 "_darcs": -traverse
 "_darcs": not_hygienic
 # Executable tests
+"test/test.byte": pkg_oUnit
+<test/*.ml{,i}>: pkg_oUnit
 # Library cadastr
 "src": include
 # OASIS_STOP
 
 <**/*> : warn_A
 <**/*.ml> | <**/*.mli> : camlp4r
+<src/cd_Ops.ml{,i}> : -camlp4r, camlp4o
 (* setup.ml generated for the first time by OASIS v0.2.1~alpha1 *)
 
 (* OASIS_START *)
-(* DO NOT EDIT (digest: 5e611571d08d56506fd6be3e084144a8) *)
+(* DO NOT EDIT (digest: 1b161227833d5bdb796205b57c2d1e04) *)
 (*
    Regenerated by OASIS v0.2.1~alpha1
    Visit http://oasis.forge.ocamlcore.org for more information and
                       bs_install = [(OASISExpr.EBool true, true)];
                       bs_path = "test";
                       bs_compiled_object = Byte;
-                      bs_build_depends = [];
+                      bs_build_depends = [FindlibPackage ("oUnit", None)];
                       bs_build_tools = [ExternalTool "ocamlbuild"];
                       bs_c_sources = [];
                       bs_data_files = [];

File src/cadastr.ml

 ;
 
 
+class type map_foldable ['k, 'v] =
+  object
+    method fold : !'a . ('a -> 'k -> 'v -> 'a) -> 'a -> 'a;
+  end
+;
+
+
+
 
 (* types of functional/pure structures *)
 
         method remove : 'k -> map_rw 'k 'v;
         method replace : 'k -> 'v -> map_rw 'k 'v;
 
-        method fold : !'a . ('a -> 'k -> 'v -> 'a) -> 'a -> 'a;
+        inherit map_foldable ['k, 'v];
 
       end
     ;
         method add : 'k -> 'v -> unit;
         method remove : 'k -> unit;
         method replace : 'k -> 'v -> unit;
-        method fold : !'a . ('a -> 'k -> 'v -> 'a) -> 'a -> 'a;
+        inherit map_foldable ['k, 'v];
       end
     ;
 

File src/cd_All.ml

+module Int = Cd_Int.Int;
+
+
+
+
+
+include Cd_Ops;

File src/cd_Int.ml

+module Int
+ =
+  struct
+    type t = int;
+    value compare = Pervasives.compare;
+  end
+;

File src/cd_Ops.ml

+(** Оператор "|>" пропускает значение последовательно
+    через функции:
+
+    123 |> string_of_int |> print_string
+
+    Существует также старый оператор ">>", но его
+    невозможно использовать в коде синтаксических
+    расширений, поэтому в целом он не рекомендуется
+    к использованию.
+*)
+let ( |> ) x f = f x
+let ( >> ) = ( |> )
+
+(** Оператор "&" применяет значение к функции:
+
+    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 print_int = string_of_int @> print_string
+    let print_int_sum = ( + ) @@> string_of_int @> print_string
+    let print_int_sum = ( ( + ) @@> string_of_int) @@> print_string
+    let for_all pred = List.exists (pred @> not) @> not
+    let for_all2 pred = List.exists2 (pred @@> not) @@> not
+
+    Операторы "%<" левоассоциативны.
+
+    У оператора "$" приоритет ниже, чем у "%", и ниже,
+    чем у арифметических операторов.  Однако он не
+    рекомендуется к использованию, так как конфликтует
+    с операторами, используемыми в синтаксических
+    расширениях.
+
+    Операторы "@>" правоассоциативны (потому и не "%>",
+    что было бы красивее, учитывая наличие "%<").
+
+    Знак ">" и "<" показывает направление композиции:
+    "@>" -- сначала аргумент проходит через первую
+    функцию и идёт слева направо, "%<" -- сначала
+    аргумент проходит через последнюю функцию и идёт
+    справа налево.
+*)
+let ( %< ) f g = fun x -> f (g x)
+let ( %%< ) f g = fun x y -> f (g x y)
+let ( %%%< ) f g = fun x y z -> f (g x y z)
+
+let ( @> ) g f = fun x -> f (g x)
+let ( @@> ) g f = fun x y -> f (g x y)
+let ( @@@> ) g f = fun x y z -> f (g x y z)
+
+(* для совместимости со старым кодом: *)
+let ( % ) = ( %< )
+let ( %% ) = ( %%< )
+let ( %%% ) = ( %%%< )
+
+(* NB: оператор "$" воспринимается camlp4 как начало
+   antiquotation и делает невозможным его использование
+   в коде, который препроцессится, поэтому крайне
+   не рекомендуется к употреблению.
+   Были прецеденты.
+   Вы предупреждены.
+*)
+let ( $ ) = ( % )
+
+(** Есть две различные концепции композиции функций:
+
+     - можно пропускать один аргумент через цепочку функций:
+
+         x |> f |> g   ==   g & f & x   ==   g (f x)
+
+     - можно создавать функцию, равную композиции функций:
+
+         f @> g   ==   f %< g   ==   fun x -> g (f x)
+
+    Кроме того, композиционировать можно функции
+    с разным количеством аргументов принимающей
+    аргумент функции (той, которая слева в "f @> g"
+    и справа в "f %< g"), для этого есть "@@>" и
+    "%%<" для двух аргументов.  Внутри однородной
+    цепочки пропускается только один аргумент.
+
+    Рекомендуется в среднем случае использовать
+    "пропускание аргумента", так как в окамле существует
+    value restriction.  Если упрощённо, то значения,
+    являющиеся top-level module values, если синтаксически
+    являются результатом применения функции, должны быть
+    мономорфны.  Нижеприведённые композиции:
+        let comb_ltr = f %> g
+        let comb_rtl = f %< g
+    по смыслу равны
+        let comb_ltr x = x |> f |> g
+        let comb_rtl x = g & f & x
+    , но для достижения полиморфизма по пропускаемому
+    аргументу из-за value restriction, если эти значения
+    являются top-level module values, композиции должны
+    быть записаны как
+        let comb_ltr x = (f @> g) x
+        let comb_rtl x = (f %< g) x
+    -- тут делаем eta-expansion, что не всегда
+    синтаксически удобно, из-за чего и рекомендуется
+    "пропускать аргумент".
+    В случае, когда композиция не является top-level
+    module value, eta-expansion не является необходимой
+    мерой.
+*)
+
+(** применить инфиксную функцию:
+    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
+
+   В новых версиях OCaml появились новые синтаксические
+   конструкции, эквивалентные описанному трюку:
+
+   let f x = Float_as_int.(x * x);;
+   let f x = let open Float_as_int in x * x;;
+   (обе функции эквивалентны и имеют тип "float -> float")
+
+   Конструкцию "Modulepath.(expression)" удобно
+   использовать в случаях, когда выражение небольшое,
+   и по смыслу его неплохо бы ограничить скобками для
+   уверенности в его корректности либо для уменьшения
+   количества текста в исходнике.
+
+   Конструкция "let open Modulepath in expression"
+   удобна в случаях, когда нужно открыть модуль, и
+   не важно, когда закрыть (используется стандартный
+   механизм видимости let-in привязок), и не
+   ограничивать себя необходимостью закрывать его
+   область видимости закрывающей скобкой.
+*)
+
+
+(* Замечание: для консистентности модули "Тип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

File test/test.ml

+open OUnit;
+open Printf;
+open Cd_All;
+module Cd = Cadastr;
+
+
+value trie_test_env () =
+  let module Tree = Cd.Sfun.Tree(Int) in
+  let the_empty = new Cd.Sfun.trie [] (new Tree.map_rw_tree) in
+  object
+    method the_empty = the_empty
+    ;
+    method ex1 = (the_empty#add [1;2] "1;2")#add [1;3;4] "1;3;4"
+    ;
+  end
+;
+
+
+value string_of_int_string_trie t =
+  (t :> Cd.map_foldable _ _)#fold
+    (fun acc kl v ->
+       let str = sprintf "%s => %s"
+         (kl |> List.map string_of_int |> String.concat "/")
+         v
+       in
+         acc @ [str]
+    )
+    []
+;
+
+
+value trie_test1 () =
+  assert_equal (trie_test_env ())#the_empty#is_empty True
+;
+
+value printer_list_string l = l |>
+  List.map (sprintf "%S") |> String.concat " ; " |> sprintf "[%s]"
+;
+
+value trie_test2 () =
+  let s = List.sort Pervasives.compare in
+  assert_equal
+    ~printer:printer_list_string
+    ( (trie_test_env ())#ex1 |>
+      string_of_int_string_trie |> s
+    )
+    ( [ "1/3/4 => 1;3;4" ; "1/2 => 1;2" ] |> s
+    )
+;
+
+
+(*
+trie_test2
+trie_test3
+*)
+
+
+value suite = 
+  "trie" >:::
+    [ "trie_test1" >:: trie_test1
+    ; "trie_test2" >:: trie_test2
+    ]
+;
+
+value (_ : list test_result) = 
+  run_test_tt_main suite
+;