Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

added examples + futures

  • Loading branch information...
commit d2818552fc3d81b7ade7ef50c8c0aca0a5422552 1 parent 82232b8
@pikatchu authored
View
2  compiler/main.ml
@@ -234,7 +234,7 @@ let _ =
if !no_stdlib then cmd else
cmd ^ " -L"^Global.stdlibdir ^ " -lliml" in
let cmd = List.fold_left add_link cmd !module_l in
- let cmd = cmd^" -lm" in
+ let cmd = cmd^" -lm -lpthread" in
run cmd
end ;
remove [bc ; asm ; obj]
View
2  stdlib/Makefile
@@ -7,6 +7,7 @@ default: libliml.a
.PHONY: libliml.a
SOURCES =\
+ thread.c\
array.c\
print.c\
math.c\
@@ -19,6 +20,7 @@ LML_SOURCES =\
print.lml \
string.lml \
math.lml \
+ thread.lml\
list.lml
OBJECTS = $(SOURCES:.c=.o)
View
13 test/parsort.lml
@@ -16,10 +16,17 @@ module TestParsort = struct
match l1, l2 with
| Empty, l -> rev_append l acc
| l, Empty -> rev_append l acc
+ (* Arghh the as pattern is buggy in linear check ... *)
+(*
| (Cons x1 rl1 as l1), (Cons x2 rl2 as l2) ->
if x1 > x2
then merge (Cons x1 acc) rl1 l2
- else merge (Cons x2 acc) l1 rl2
+ else merge (Cons x2 acc) l1 rl2
+*)
+ | Cons x1 rl1, Cons x2 rl2 ->
+ if x1 > x2
+ then merge (Cons x1 acc) rl1 (Cons x2 rl2)
+ else merge (Cons x2 acc) (Cons x1 rl1) rl2
val split: int * t * t * t -> int * t * t
let split n l1 l2 l =
@@ -35,7 +42,7 @@ module TestParsort = struct
| Cons _ Empty as l -> l
| Cons x rl as l ->
let length1, l1, l2 = split 0 Empty Empty l in
- if length1 > 10000
+ if length1 > 100000
then
let l1 = Future.make c_sort l1 in
let l2 = Future.make c_sort l2 in
@@ -63,7 +70,7 @@ module TestParsort = struct
then acc
else loop (n-1) (acc + sum 0 (sort (make Empty 2000000)))
- val main: unit #-> unit
+ val main: unit -> unit
let main _ =
Print.int (loop 1 0)
View
2  test/shootout/Makefile
@@ -2,7 +2,7 @@
LIMLC = ../../compiler/limlc
-default: fankuch.run bintree.run spectral.run nbody.run
+default: fankuch.run bintree.run spectral.run
%.run: %.lml
$(LIMLC) $< -root Main -o $@
View
129 test/shootout/parBintree.lml
@@ -0,0 +1,129 @@
+module Triplet = struct
+ type ('a, 'b, 'c) t = T of 'a * 'b * 'c
+end
+
+module Pair = struct
+ type ('a, 'b) t = P of 'a * 'b
+end
+
+module Tree = struct
+
+ type t =
+ | Empty
+ | Node of t * int * t
+
+ val make: int * int -> t
+ let make i depth =
+ if depth = 0
+ then
+ Node Empty i Empty
+ else
+ let i2 = 2 * i in
+ let depth = depth - 1 in
+ let left = make (i2 - 1) depth in
+ let right = make i2 depth in
+ Node left i right
+
+ val check: t -> int
+ let check t =
+ match t with
+ | Empty -> 0
+ | Node l i r -> i + check l - check r
+
+end
+
+module CheckMake = struct
+
+ type private env = {
+ depth : int;
+ last : int;
+ acc : int;
+ }
+
+ val private loop: env * int -> int
+ let loop env i =
+ if i > env.last
+ then
+ let res = env.acc in
+ free env;
+ res
+ else
+ let fst = Tree.check (Tree.make i env.depth) in
+ let snd = Tree.check (Tree.make (0-i) env.depth) in
+ let env = { env with acc = env.acc + fst + snd } in
+ loop env (i+1)
+
+ val go: (int, int) Pair.t #-> int
+ let go x =
+ match x with
+ | Pair.P d niter ->
+ let env = { depth = d; last = niter; acc = 0 } in
+ loop env 1
+
+end
+
+module Main = struct
+
+(* This should be replaced by << soon *)
+ val lsl: int * int -> int
+ let lsl x y =
+ if y <= 0 then x else 2*lsl x (y-1)
+
+ type acc = (int, int, int Future.t) Triplet.t List.t
+
+ val private loop1: int * int * int * int * int * int * acc
+ -> acc
+ let loop1 min_depth max_depth d threads i iend acc =
+ if i > iend
+ then acc
+ else begin
+ let dv = d + (i * 2) in
+ let niter = lsl 1 (max_depth - dv + min_depth) in
+ let c = Future.make CheckMake.go (Pair.P d niter) in
+ let acc = Triplet.T (dv, niter, c) :: acc in
+ loop1 min_depth max_depth d threads (i+1) iend acc
+ end
+
+ val private loop_depths: int * int * int -> acc
+ let loop_depths min_depth max_depth d =
+ let last = ((max_depth - d) / 2 + 1) - 1 in
+ let threads = 2 in
+ loop1 min_depth max_depth d threads 0 last List.Empty
+
+ val debug: 'a obs #-> unit = "liml_debug"
+
+ val private print_results: acc -> unit
+ let print_results l =
+ match l with
+ | List.Empty -> ()
+ | List.Cons (Triplet.T (d, niter, c)) rl ->
+ Print.int (2 * niter);
+ Print.string "\t trees of depth ";
+ Print.int d;
+ Print.string "\t check: ";
+ Print.int (Future.wait c);
+ Print.newline();
+ print_results rl
+
+ val main: unit -> unit
+ let main() =
+ let min_depth = 4 in
+ let max_depth = 20 in
+ let stretch_depth = max_depth + 1 in
+ let c = Tree.check (Tree.make 0 stretch_depth) in
+ Print.string "stretch tree of depth ";
+ Print.int stretch_depth;
+ Print.string "\t check: ";
+ Print.int c;
+ Print.newline();
+ let long_lived_tree = Tree.make 0 max_depth in
+ let res_list = loop_depths min_depth max_depth min_depth in
+ let res_list = List.rev res_list in
+ print_results res_list;
+ Print.string "long lived tree of depth ";
+ Print.int max_depth;
+ Print.string "\t check: ";
+ Print.int (Tree.check long_lived_tree);
+ Print.newline()
+
+end
Please sign in to comment.
Something went wrong with that request. Please try again.