[ds] move Ring and PriorityQueue to core/ds

Makefile

@@ -31,7 +31,7 @@ STATICLINK?=0
 # Configuration
 
 # Modules in these directories should only depend on modules that are in directories to the left
-HAXE_DIRECTORIES=core core/json core/display syntax context context/display codegen codegen/gencommon generators generators/jvm optimization filters macro macro/eval macro/eval/bytes typing compiler
+HAXE_DIRECTORIES=core core/ds core/json core/display syntax context context/display codegen codegen/gencommon generators generators/jvm optimization filters macro macro/eval macro/eval/bytes typing compiler
 EXTLIB_LIBS=extlib-leftovers extc neko javalib swflib ttflib ilib objsize pcre ziplib
 OCAML_LIBS=unix str threads dynlink
 OPAM_LIBS=sedlex.ppx xml-light extlib ptmap sha

src/compiler/server.ml

@@ -565,55 +565,6 @@ let cleanup () =
 	| None -> ()
 	end
 
-module Ring = struct
-	type 'a t = {
-		values : 'a array;
-		mutable index : int;
-		mutable num_filled : int;
-	}
-
-	let create len x = {
-		values = Array.make len x;
-		index = 0;
-		num_filled = 0;
-	}
-
-	let push r x =
-		r.values.(r.index) <- x;
-		r.num_filled <- r.num_filled + 1;
-		if r.index = Array.length r.values - 1 then begin
-			r.index <- 0;
-		end else
-			r.index <- r.index + 1
-
-	let iter r f =
-		let len = Array.length r.values in
-		for i = 0 to len - 1 do
-			let off = r.index + i in
-			let off = if off >= len then off - len else off in
-			f r.values.(off)
-		done
-
-	let fold r acc f =
-		let len = Array.length r.values in
-		let rec loop i acc =
-			if i = len then
-				acc
-			else begin
-				let off = r.index + i in
-				let off = if off >= len then off - len else off in
-				loop (i + 1) (f acc r.values.(off))
-			end
-		in
-		loop 0 acc
-
-	let is_filled r =
-		r.num_filled >= Array.length r.values
-
-	let reset_filled r =
-		r.num_filled <- 0
-end
-
 let gc_heap_stats () =
 	let stats = Gc.quick_stat() in
 	stats.major_words,stats.heap_words

src/context/compilationServer.ml

@@ -88,65 +88,6 @@ class virtual server_task (id : string list) (priority : int) = object(self)
 	method get_id = id
 end
 
-(* Taken from the OCaml manual... *)
-module PriorityQueue = struct
-	type priority = int
-
-	type 'a t =
-	| Empty
-	| Node of priority * 'a * 'a t * 'a t
-
-	let empty = Empty
-
-	let rec insert queue prio elt = match queue with
-		| Empty -> Node(prio, elt, Empty, Empty)
-		| Node(p, e, left, right) ->
-			if prio <= p then
-				Node(prio, elt, insert right p e, left)
-			else
-				Node(p, e, insert right prio elt, left)
-
-	exception Queue_is_empty
-
-	let rec remove_top = function
-		| Empty -> raise Queue_is_empty
-		| Node(prio, elt, left, Empty) -> left
-		| Node(prio, elt, Empty, right) -> right
-		| Node(prio, elt, (Node(lprio, lelt, _, _) as left), (Node(rprio, relt, _, _) as right)) ->
-			if lprio <= rprio then
-				Node(lprio, lelt, remove_top left, right)
-			else
-				Node(rprio, relt, left, remove_top right)
-
-	let extract = function
-		| Empty -> raise Queue_is_empty
-		| Node(prio, elt, _, _) as queue -> (prio, elt, remove_top queue)
-
-	let is_empty = function
-		| Empty -> true
-		| Node _ -> false
-
-	let fold queue f acc =
-		let rec loop queue acc = match queue with
-			| Empty -> acc
-			| Node(prio, elt, left, Empty) -> loop left (f acc prio elt)
-			| Node(prio, elt, Empty, right) -> loop right (f acc prio elt)
-			| Node(prio, elt, (Node(lprio,_,_,_) as left), (Node(rprio,relt,_,_) as right)) ->
-				let acc = f acc prio elt in
-				if lprio <= rprio then begin
-					let acc = loop left acc in
-					loop right acc
-				end else begin
-					let acc = loop right acc in
-					loop left acc
-				end
-		in
-		loop queue acc
-
-	let merge queue1 queue2 =
-		fold queue1 insert queue2
-end
-
 class cache = object(self)
 	val contexts : (string,context_cache) Hashtbl.t = Hashtbl.create 0
 	val mutable context_list = []

src/core/ds/priorityQueue.ml

@@ -0,0 +1,55 @@
+type priority = int
+
+type 'a t =
+| Empty
+| Node of priority * 'a * 'a t * 'a t
+
+let empty = Empty
+
+let rec insert queue prio elt = match queue with
+	| Empty -> Node(prio, elt, Empty, Empty)
+	| Node(p, e, left, right) ->
+		if prio <= p then
+			Node(prio, elt, insert right p e, left)
+		else
+			Node(p, e, insert right prio elt, left)
+
+exception Queue_is_empty
+
+let rec remove_top = function
+	| Empty -> raise Queue_is_empty
+	| Node(prio, elt, left, Empty) -> left
+	| Node(prio, elt, Empty, right) -> right
+	| Node(prio, elt, (Node(lprio, lelt, _, _) as left), (Node(rprio, relt, _, _) as right)) ->
+		if lprio <= rprio then
+			Node(lprio, lelt, remove_top left, right)
+		else
+			Node(rprio, relt, left, remove_top right)
+
+let extract = function
+	| Empty -> raise Queue_is_empty
+	| Node(prio, elt, _, _) as queue -> (prio, elt, remove_top queue)
+
+let is_empty = function
+	| Empty -> true
+	| Node _ -> false
+
+let fold queue f acc =
+	let rec loop queue acc = match queue with
+		| Empty -> acc
+		| Node(prio, elt, left, Empty) -> loop left (f acc prio elt)
+		| Node(prio, elt, Empty, right) -> loop right (f acc prio elt)
+		| Node(prio, elt, (Node(lprio,_,_,_) as left), (Node(rprio,relt,_,_) as right)) ->
+			let acc = f acc prio elt in
+			if lprio <= rprio then begin
+				let acc = loop left acc in
+				loop right acc
+			end else begin
+				let acc = loop right acc in
+				loop left acc
+			end
+	in
+	loop queue acc
+
+let merge queue1 queue2 =
+	fold queue1 insert queue2

src/core/ds/ring.ml

@@ -0,0 +1,46 @@
+type 'a t = {
+	values : 'a array;
+	mutable index : int;
+	mutable num_filled : int;
+}
+
+let create len x = {
+	values = Array.make len x;
+	index = 0;
+	num_filled = 0;
+}
+
+let push r x =
+	r.values.(r.index) <- x;
+	r.num_filled <- r.num_filled + 1;
+	if r.index = Array.length r.values - 1 then begin
+		r.index <- 0;
+	end else
+		r.index <- r.index + 1
+
+let iter r f =
+	let len = Array.length r.values in
+	for i = 0 to len - 1 do
+		let off = r.index + i in
+		let off = if off >= len then off - len else off in
+		f r.values.(off)
+	done
+
+let fold r acc f =
+	let len = Array.length r.values in
+	let rec loop i acc =
+		if i = len then
+			acc
+		else begin
+			let off = r.index + i in
+			let off = if off >= len then off - len else off in
+			loop (i + 1) (f acc r.values.(off))
+		end
+	in
+	loop 0 acc
+
+let is_filled r =
+	r.num_filled >= Array.length r.values
+
+let reset_filled r =
+	r.num_filled <- 0