simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-06 03:05:28 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

examples: clean up

Browse source
This commit is contained in:
Fardale 2020-01-25 00:35:13 +01:00
parent 8c43e345ad
commit 2689fb1a70
7 changed files with 10 additions and 223 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
examples/bencode_write.ml
View file

@ -1,22 +0,0 @@
(** Write 10_000 Bencode values on the given file *)
(* write n times the same value in the file *)
let write_values file n =
let out = BencodeOnDisk.open_out file in
Printf.printf "[%d] opened file\n" (Unix.getpid ());
let v = Bencode.(L [I 0; I 1; S "foo"]) in
for i = 0 to n-1 do
Printf.printf "[%d] iteration %d\n" (Unix.getpid ()) i;
flush stdout;
BencodeOnDisk.write out v;
done;
BencodeOnDisk.close_out out;
Printf.printf "done\n";
()
let _ =
let file = Sys.argv.(1) in
Printf.printf "[%d] start: write to %s\n" (Unix.getpid ()) file;
flush stdout;
write_values file 100

26
examples/cgi/web_pwd.ml
View file

@ -1,26 +0,0 @@
(** Export the list of files in a directory *)
let dir = "/tmp/"
(* list of files in a dir *)
let lsdir dir =
let d = Unix.opendir dir in
let l = ref [] in
begin try while true do
l := Unix.readdir d :: !l
done with End_of_file -> Unix.closedir d
end;
!l
let export dir =
let l = lsdir dir in
ToWeb.HTML.(concat
[ h1 (str ("files in "^ dir))
; list (List.map str l)
])
let state = ToWeb.State.create dir ~export
let _ =
ToWeb.serve_state ~sockfile:"/tmp/foo.sock" state

20
examples/collatz.ml
View file

@ -1,20 +0,0 @@
(** Display the graph of the collatz conjecture, starting from the given int *)
let g = LazyGraph.map
~edges:(fun () -> [])
~vertices:(fun i -> [`Label (string_of_int i)])
LazyGraph.collatz_graph
let collatz n filename =
Format.printf "print graph to %s@." filename;
let out = open_out filename in
let fmt = Format.formatter_of_out_channel out in
LazyGraph.Dot.pp ~name:"collatz" g fmt (Sequence.singleton n);
Format.pp_print_flush fmt ();
close_out out
let _ =
if Array.length Sys.argv < 3
then (Format.printf "use: collatz num file@."; exit 0)
else collatz (int_of_string Sys.argv.(1)) Sys.argv.(2)

83
examples/crawl.ml
View file

@ -1,83 +0,0 @@
(** Crawl the web to find shortest path between two urls *)
open Batteries
let pool = Future.Pool.create ~timeout:15. ~size:50
let split_lines s = String.nsplit s ~by:"\n"
let get_and_parse url =
let cmd = Format.sprintf "wget -q '%s' -O - | grep -o 'http\\(s\\)\\?://[^ \"]\\+'" url in
let content = Future.spawn_process ?stdin:None ~pool ~cmd in
content
|> Future.map (fun (_, stdout, _) -> stdout)
|> Future.map split_lines
|> Batteries.tap (fun lines ->
Future.on_success lines (fun lines -> Format.printf "downloaded %s (%d urls)@." url (List.length lines)))
type page = string * (string list Future.t)
(** The web graph; its vertices are annotated by futures of the content *)
let g : (page, string, unit) LazyGraph.t =
let force (url, future) =
Format.printf "force %s@." url;
let urls =
try Future.get future |> List.map (fun url -> (), (url, get_and_parse url))
with e -> [] in
let edges = Gen.of_list urls in
(* need to parse the page to get the urls *)
LazyGraph.Node ((url, future), url, edges)
in LazyGraph.make
~eq:(fun (url1,_) (url2,_) -> url1 = url2)
~hash:(fun (url,_) -> Hashtbl.hash url)
force
let pp_path fmt path =
List.print ~sep:"\n"
(fun fmt ((u1,_), (), (u2,_)) ->
String.print fmt u1; String.print fmt " -> "; String.print fmt u2)
fmt path
(* seek a path from the first url to the second *)
let path_between from into =
Format.printf "seek path from %s to %s@." from into;
let on_explore (url,_) = Format.printf " explore %s...@." url in
try
let cost, path = LazyGraph.dijkstra ~on_explore g
(from, get_and_parse from) (into, get_and_parse into) in
Printf.printf "found path (cost %f):\n%a\n" cost pp_path path
with Not_found ->
Format.printf "no path could be found@."
let print_limit file start depth =
Format.printf "print into %s webgraph starting from %s, up to depth %d@."
file start depth;
let start = start, get_and_parse start in
let g' = LazyGraph.limit_depth g depth (Gen.singleton start) in
let g'' = LazyGraph.map ~vertices:(fun v -> [`Label v]) ~edges:(fun _ -> []) g' in
let out = Format.formatter_of_out_channel (open_out file) in
LazyGraph.Dot.pp ~name:"web" g'' out (Gen.singleton start);
Format.pp_print_flush out ();
()
let _ =
let timer = Future.Timer.create () in
let rec ping () =
Format.printf "*** ping! (size of pool: %d)@." (Future.Pool.size pool);
Future.Timer.schedule_in timer 10. ping
in ping ()
let print_usage () =
Format.printf "usage: crawl path url1 url2@.";
Format.printf "usage: crawl print file url depth@.";
()
let _ =
match Sys.argv with
| [|_; "print"; file; url; depth|] ->
print_limit file url (int_of_string depth)
| [|_; "path"; from; into|] ->
path_between from into
| _ ->
print_usage ()

11
examples/dune
View file

@ -1,10 +1,15 @@
(executables (executable
(names id_sexp) (name id_sexp)
(libraries containers.sexp) (libraries containers.sexp)
(modules id_sexp)
(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always)
(ocamlopt_flags :standard -O3 -color always (ocamlopt_flags :standard -O3 -color always
-unbox-closures -unbox-closures-factor 20) -unbox-closures -unbox-closures-factor 20)
) )
(executable
(name lambda)
(libraries printbox)
(modules lambda)
)

4
examples/lambda.ml
View file

@ -28,7 +28,7 @@ let rec fvars t = match t with
let rec replace t ~var ~by = match t with let rec replace t ~var ~by = match t with
| Var s -> if s=var then by else t | Var s -> if s=var then by else t
| App (t1,t2) -> App (replace t1 ~var ~by, replace t2 ~var ~by) | App (t1,t2) -> App (replace t1 ~var ~by, replace t2 ~var ~by)
| Lambda (v, t') when v=var -> t (* no risk *) | Lambda (v, _t') when v=var -> t (* no risk *)
| Lambda (v, t') -> Lambda (v, replace t' ~var ~by) | Lambda (v, t') -> Lambda (v, replace t' ~var ~by)
(* rename [t] so that [var] doesn't occur in it *) (* rename [t] so that [var] doesn't occur in it *)
@ -109,4 +109,4 @@ let print_reduction t =
let () = let () =
Random.self_init (); Random.self_init ();
let t = _random_term (5 + Random.int 20) [] in let t = _random_term (5 + Random.int 20) [] in
PrintBox.output ~indent:2 stdout (print_reduction t) PrintBox_text.output ~indent:2 stdout (print_reduction t)

67
examples/mem_size.ml
View file

@ -1,67 +0,0 @@
(** Compute the memory footprint of a value (and its subvalues). Reference is
http://rwmj.wordpress.com/2009/08/05/ocaml-internals-part-2-strings-and-other-types/ *)
(** A graph vertex is an Obj.t value *)
let graph =
let force x =
if Obj.is_block x
then
let children = Sequence.map (fun i -> i, Obj.field x i) (0--(Obj.size x - 1)) in
LazyGraph.Node (x, Obj.tag x, children)
else
LazyGraph.Node (x, Obj.obj x, Sequence.empty)
in LazyGraph.make ~eq:(==) force
let word_size = Sys.word_size / 8
let size x =
if Obj.is_block x
then (1+Obj.size x) * word_size
else word_size
let compute_size x =
let o = Obj.repr x in
let vertices = LazyGraph.bfs graph o in
Sequence.fold (fun sum (o',_,_) -> size o' + sum) 0 vertices
let print_val fmt x =
let o = Obj.repr x in
let graph' = LazyGraph.map ~edges:(fun i -> [`Label (string_of_int i)])
~vertices:(fun v -> [`Label (string_of_int v); `Shape "box"]) graph in
LazyGraph.Dot.pp ~name:"value" graph' fmt (Sequence.singleton o)
let print_val_file filename x =
let out = open_out filename in
let fmt = Format.formatter_of_out_channel out in
print_val fmt x;
Format.pp_print_flush fmt ();
close_out out
let process_val ~name x =
print_val_file (Format.sprintf "/tmp/%s.dot" name) x;
Format.printf "size of val is %d@." (compute_size x)
module ISet = Set.Make(struct type t = int let compare = compare end)
let mk_circ n =
let start = Sequence.to_list (1--n) in
(* make the end of the list point to its beginning *)
let rec cycle l = match l with
| [] -> assert false
| [_] -> Obj.set_field (Obj.repr l) 1 (Obj.repr start)
| _::l' -> cycle l'
in
cycle start;
start
let _ =
let s = Sequence.fold (fun s x -> ISet.add x s) ISet.empty (1--100) in
process_val ~name:"foo" s;
let l = Sequence.to_list (Sequence.map (fun i -> Sequence.to_list (i--(i+42)))
(Sequence.of_list [0;100;1000])) in
process_val ~name:"bar" l;
let l' = mk_circ 100 in
process_val ~name:"baaz" l';
()