summaryrefslogtreecommitdiff
path: root/utils
diff options
context:
space:
mode:
Diffstat (limited to 'utils')
-rw-r--r--utils/clflags.ml21
-rw-r--r--utils/config.mli26
-rw-r--r--utils/config.mlp16
-rw-r--r--utils/crc.ml12
-rw-r--r--utils/crc.mli6
-rw-r--r--utils/cset.ml103
-rw-r--r--utils/cset.mli9
-rw-r--r--utils/meta.ml7
-rw-r--r--utils/meta.mli9
-rw-r--r--utils/misc.ml94
-rw-r--r--utils/misc.mli38
-rw-r--r--utils/tbl.ml71
-rw-r--r--utils/tbl.mli12
-rw-r--r--utils/terminfo.ml7
-rw-r--r--utils/terminfo.mli7
15 files changed, 0 insertions, 438 deletions
diff --git a/utils/clflags.ml b/utils/clflags.ml
deleted file mode 100644
index 77d3909353..0000000000
--- a/utils/clflags.ml
+++ /dev/null
@@ -1,21 +0,0 @@
-(* Command-line parameters *)
-
-let objfiles = ref ([] : string list) (* .cmo and .cma files *)
-and ccobjs = ref ([] : string list) (* .o, .a and -lxxx files *)
-
-let compile_only = ref false (* -c *)
-and exec_name = ref "a.out" (* -o *)
-and archive_name = ref "library.cma" (* -o *)
-and include_dirs = ref ([] : string list)(* - I *)
-and print_types = ref false (* -i *)
-and make_archive = ref false (* -a *)
-and fast = ref false (* -fast *)
-and link_everything = ref false (* -linkall *)
-and custom_runtime = ref false (* -custom *)
-and ccopts = ref ([] : string list) (* -ccopt *)
-and nopervasives = ref false (* -nopervasives *)
-
-let dump_lambda = ref false (* -dlambda *)
-and dump_instr = ref false (* -dinstr *)
-
-let write_lambda = ref false (* -wlambda *)
diff --git a/utils/config.mli b/utils/config.mli
deleted file mode 100644
index 483de0b515..0000000000
--- a/utils/config.mli
+++ /dev/null
@@ -1,26 +0,0 @@
-(* System configuration *)
-
-val version: string
- (* The current version number of the system *)
-
-val standard_library: string
- (* The directory containing the standard libraries *)
-val c_compiler: string
- (* The C compiler to use for custom runtime mode *)
-val c_libraries: string
- (* The C libraries to link with custom runtimes *)
-
-val load_path: string list ref
- (* Directories in the search path for .cmi and .cmo files *)
-
-val exec_magic_number: string
- (* Magic number for bytecode executable files *)
-val cmi_magic_number: string
- (* Magic number for compiled interface files *)
-val cmo_magic_number: string
- (* Magic number for object bytecode files *)
-val cma_magic_number: string
- (* Magic number for archive files *)
-
-val max_tag: int
- (* Biggest tag that can be stored in the header of a block. *)
diff --git a/utils/config.mlp b/utils/config.mlp
deleted file mode 100644
index 27505fde09..0000000000
--- a/utils/config.mlp
+++ /dev/null
@@ -1,16 +0,0 @@
-let standard_library = "%%LIBDIR%%"
-
-let c_compiler = "%%CC%%"
-
-let c_libraries = "%%CCLIBS%%"
-
-let version = "1.02"
-
-let exec_magic_number = "Caml1999X001"
-and cmi_magic_number = "Caml1999I001"
-and cmo_magic_number = "Caml1999O001"
-and cma_magic_number = "Caml1999A001"
-
-let load_path = ref ([] : string list)
-
-let max_tag = 251
diff --git a/utils/crc.ml b/utils/crc.ml
deleted file mode 100644
index e296ac9122..0000000000
--- a/utils/crc.ml
+++ /dev/null
@@ -1,12 +0,0 @@
-(* CRC computation *)
-
-external unsafe_for_string: string -> int -> int -> int = "crc_string"
-
-let for_string str ofs len =
- if ofs < 0 or ofs + len > String.length str
- then invalid_arg "Crc.for_string"
- else unsafe_for_string str ofs len
-
-external for_channel: in_channel -> int -> int = "crc_chan"
-
-
diff --git a/utils/crc.mli b/utils/crc.mli
deleted file mode 100644
index eae8ca6eb2..0000000000
--- a/utils/crc.mli
+++ /dev/null
@@ -1,6 +0,0 @@
-(* CRC computation *)
-
-val for_string: string -> int -> int -> int
-external for_channel: in_channel -> int -> int = "crc_chan"
-
-
diff --git a/utils/cset.ml b/utils/cset.ml
deleted file mode 100644
index f2c8482b55..0000000000
--- a/utils/cset.ml
+++ /dev/null
@@ -1,103 +0,0 @@
-(* Sets over ordered types *)
-
-type 'a t = Empty | Node of 'a t * 'a * 'a t * int
-
-let empty = Empty
-
-(* Compute the size (number of nodes and leaves) of a tree. *)
-
-let size = function
- Empty -> 1
- | Node(_, _, _, s) -> s
-
-(* Creates a new node with left son l, value x and right son r.
- l and r must be balanced and size l / size r must be between 1/N and N.
- Inline expansion of size for better speed. *)
-
-let new l x r =
- let sl = match l with Empty -> 0 | Node(_,_,_,s) -> s in
- let sr = match r with Empty -> 0 | Node(_,_,_,s) -> s in
- Node(l, x, r, sl + sr + 1)
-
-(* Same as new, but performs rebalancing if necessary.
- Assumes l and r balanced, and size l / size r "reasonable".
- Inline expansion of new for better speed in the most frequent case
- where no rebalancing is required. *)
-
-let bal l x r =
- let sl = match l with Empty -> 0 | Node(_,_,_,s) -> s in
- let sr = match r with Empty -> 0 | Node(_,_,_,s) -> s in
- if sl > 3 * sr then begin
- match l with
- Empty -> invalid_arg "Cset.bal"
- | Node(ll, lv, lr, _) ->
- if size ll >= size lr then
- new ll lv (new lr x r)
- else begin
- match lr with
- Empty -> invalid_arg "Cset.bal"
- | Node(lrl, lrv, lrr, _)->
- new (new ll lv lrl) lrv (new lrr x r)
- end
- end else if sr > 3 * sl then begin
- match r with
- Empty -> invalid_arg "Cset.bal"
- | Node(rl, rv, rr, _) ->
- if size rr >= size rl then
- new (new l x rl) rv rr
- else begin
- match rl with
- Empty -> invalid_arg "Cset.bal"
- | Node(rll, rlv, rlr, _) ->
- new (new l x rll) rlv (new rlr rv rr)
- end
- end else
- Node(l, x, r, sl + sr + 1)
-
-(* Merge two trees l and r into one.
- All elements of l must precede the elements of r.
- Assumes size l / size r between 1/N and N. *)
-
-let rec merge l r =
- match (l, r) with
- (Empty, t) -> t
- | (t, Empty) -> t
- | (Node(l1, v1, r1, h1), Node(l2, v2, r2, h2)) ->
- bal l1 v1 (bal (merge r1 l2) v2 r2)
-
-(* Insertion *)
-
-let rec add x = function
- Empty ->
- Node(Empty, x, Empty, 1)
- | Node(l, v, r, _) as t ->
- let c = compare x v in
- if c = 0 then t else
- if c < 0 then bal (add x l) v r else bal l v (add x r)
-
-(* Membership *)
-
-let rec mem x = function
- Empty ->
- false
- | Node(l, v, r, _) ->
- let c = compare x v in
- c = 0 or mem x (if c < 0 then l else r)
-
-(* Removal *)
-
-let rec remove x = function
- Empty ->
- Empty
- | Node(l, v, r, _) ->
- let c = compare x v in
- if c = 0 then merge l r else
- if c < 0 then bal (remove x l) v r else bal l v (remove x r)
-
-(* Contents *)
-
-let elements s =
- let rec elements accu = function
- Empty -> accu
- | Node(l, v, r, _) -> elements (v :: elements accu r) l
- in elements [] s
diff --git a/utils/cset.mli b/utils/cset.mli
deleted file mode 100644
index a7f4cae9c7..0000000000
--- a/utils/cset.mli
+++ /dev/null
@@ -1,9 +0,0 @@
-(* Sets over types ordered with the default ordering *)
-
-type 'a t
-
-val empty: 'a t
-val mem: 'a -> 'a t -> bool
-val add: 'a -> 'a t -> 'a t
-val remove: 'a -> 'a t -> 'a t
-val elements: 'a t -> 'a list
diff --git a/utils/meta.ml b/utils/meta.ml
deleted file mode 100644
index 08077cf993..0000000000
--- a/utils/meta.ml
+++ /dev/null
@@ -1,7 +0,0 @@
-external global_data : unit -> Obj.t array = "get_global_data"
-external realloc_global_data : int -> unit = "realloc_global"
-external static_alloc : int -> string = "static_alloc"
-external static_free : string -> unit = "static_free"
-external static_resize : string -> int -> string = "static_resize"
-external execute_bytecode : string -> int -> Obj.t = "execute_bytecode"
-external available_primitives : unit -> string array = "available_primitives"
diff --git a/utils/meta.mli b/utils/meta.mli
deleted file mode 100644
index 9987ba7e86..0000000000
--- a/utils/meta.mli
+++ /dev/null
@@ -1,9 +0,0 @@
-(* To control the runtime system and bytecode interpreter *)
-
-external global_data : unit -> Obj.t array = "get_global_data"
-external realloc_global_data : int -> unit = "realloc_global"
-external static_alloc : int -> string = "static_alloc"
-external static_free : string -> unit = "static_free"
-external static_resize : string -> int -> string = "static_resize"
-external execute_bytecode : string -> int -> Obj.t = "execute_bytecode"
-external available_primitives : unit -> string array = "available_primitives"
diff --git a/utils/misc.ml b/utils/misc.ml
deleted file mode 100644
index 9325246535..0000000000
--- a/utils/misc.ml
+++ /dev/null
@@ -1,94 +0,0 @@
-(* Errors *)
-
-exception Fatal_error
-
-let fatal_error msg =
- prerr_string ">> Fatal error: "; prerr_endline msg; raise Fatal_error
-
-(* List functions *)
-
-let rec map_end f l1 l2 =
- match l1 with
- [] -> l2
- | hd::tl -> f hd :: map_end f tl l2
-
-let rec for_all2 pred l1 l2 =
- match (l1, l2) with
- ([], []) -> true
- | (hd1::tl1, hd2::tl2) -> pred hd1 hd2 & for_all2 pred tl1 tl2
- | (_, _) -> false
-
-(* File functions *)
-
-let find_in_path path name =
- if Filename.is_absolute name then
- if Sys.file_exists name then name else raise Not_found
- else begin
- let rec try_dir = function
- [] -> raise Not_found
- | dir::rem ->
- let fullname = Filename.concat dir name in
- if Sys.file_exists fullname then fullname else try_dir rem
- in try_dir path
- end
-
-let remove_file filename =
- try
- Sys.remove filename
- with Sys_error msg ->
- ()
-
-let temp_file base suffix =
- let rec try_name counter =
- let name = "/tmp/" ^ base ^ string_of_int counter ^ suffix in
- if Sys.file_exists name then try_name (counter + 1) else name
- in try_name 0
-
-(* Hashtable functions *)
-
-let create_hashtable size init =
- let tbl = Hashtbl.new size in
- List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
- tbl
-
-(* String functions *)
-
-let capitalize s =
- let r = String.create (String.length s) in
- String.blit s 0 r 0 (String.length s);
- let c = s.[0] in
- if c >= 'a' & c <= 'z' then r.[0] <- Char.chr(Char.code c - 32);
- r
-
-let lowercase s =
- let r = String.create (String.length s) in
- String.blit s 0 r 0 (String.length s);
- let c = s.[0] in
- if c >= 'A' & c <= 'Z' then r.[0] <- Char.chr(Char.code c + 32);
- r
-
-(* File copy *)
-
-let copy_file ic oc =
- let buff = String.create 0x1000 in
- let rec copy () =
- let n = input ic buff 0 0x1000 in
- if n = 0 then () else (output oc buff 0 n; copy())
- in copy()
-
-let copy_file_chunk ic oc len =
- let buff = String.create 0x1000 in
- let rec copy n =
- if n <= 0 then () else begin
- let r = input ic buff 0 (min n 0x1000) in
- if r = 0 then raise End_of_file else (output oc buff 0 r; copy(n-r))
- end
- in copy len
-
-(* Integer operations *)
-
-let rec log2 n =
- if n <= 1 then 0 else 1 + log2(n asr 1)
-
-let align n a =
- (n + a - 1) land (-a)
diff --git a/utils/misc.mli b/utils/misc.mli
deleted file mode 100644
index 4f95391904..0000000000
--- a/utils/misc.mli
+++ /dev/null
@@ -1,38 +0,0 @@
-(* Miscellaneous useful types and functions *)
-
-val fatal_error: string -> 'a
-exception Fatal_error
-
-val map_end: ('a -> 'b) -> 'a list -> 'b list -> 'b list
-val for_all2: ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
-
-val find_in_path: string list -> string -> string
- (* Search a file in a list of directories. *)
-val remove_file: string -> unit
- (* Delete the given file if it List.exists. Never raise an error. *)
-val temp_file: string -> string -> string
- (* Return the name of a non-existent temporary file in [/tmp]. *)
-
-val create_hashtable: int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t
- (* Create a hashtable of the given size and fills it with the
- given bindings. *)
-
-val capitalize: string -> string
-val lowercase: string -> string
-
-val copy_file: in_channel -> out_channel -> unit
- (* [copy_file ic oc] reads the contents of file [ic] and copies
- them to [oc]. It stops when encountering EOF on [ic]. *)
-val copy_file_chunk: in_channel -> out_channel -> int -> unit
- (* [copy_file_chunk ic oc n] reads [n] bytes from [ic] and copies
- them to [oc]. It raises [End_of_file] when encountering
- EOF on [ic]. *)
-
-val log2: int -> int
- (* [log2 n] returns [s] such that [n = 1 lsl s]
- if [n] is a power of 2*)
-val align: int -> int -> int
- (* [align n a] rounds [n] upwards to a multiple of [a]
- (a power of 2). *)
-
-
diff --git a/utils/tbl.ml b/utils/tbl.ml
deleted file mode 100644
index 3daf8c1be3..0000000000
--- a/utils/tbl.ml
+++ /dev/null
@@ -1,71 +0,0 @@
-type ('a, 'b) t =
- Empty
- | Node of ('a, 'b) t * 'a * 'b * ('a, 'b) t * int
-
-let empty = Empty
-
-let height = function
- Empty -> 0
- | Node(_,_,_,_,h) -> h
-
-let new l x d r =
- let hl = height l and hr = height r in
- Node(l, x, d, r, (if hl >= hr then hl + 1 else hr + 1))
-
-let bal l x d r =
- let hl = height l and hr = height r in
- if hl > hr + 1 then
- let (Node(ll, lv, ld, lr, _)) = l in
- if height ll >= height lr then
- new ll lv ld (new lr x d r)
- else
- let (Node(lrl, lrv, lrd, lrr, _)) = lr in
- new (new ll lv ld lrl) lrv lrd (new lrr x d r)
- else if hr > hl + 1 then
- let (Node(rl, rv, rd, rr, _)) = r in
- if height rr >= height rl then
- new (new l x d rl) rv rd rr
- else
- let (Node(rll, rlv, rld, rlr, _)) = rl in
- new (new l x d rll) rlv rld (new rlr rv rd rr)
- else
- new l x d r
-
-let rec add x data = function
- Empty ->
- Node(Empty, x, data, Empty, 1)
- | Node(l, v, d, r, h) as t ->
- let c = compare x v in
- if c = 0 then
- Node(l, x, data, r, h)
- else if c < 0 then
- bal (add x data l) v d r
- else
- bal l v d (add x data r)
-
-let rec find x = function
- Empty ->
- raise Not_found
- | Node(l, v, d, r, _) ->
- let c = compare x v in
- if c = 0 then d
- else find x (if c < 0 then l else r)
-
-let rec iter f = function
- Empty -> ()
- | Node(l, v, d, r, _) ->
- iter f l; f v d; iter f r
-
-open Format
-
-let print print_key print_data tbl =
- open_hvbox 2;
- print_string "[[";
- iter (fun k d ->
- open_hovbox 2;
- print_key k; print_string " ->"; print_space();
- print_data d; print_string ";";
- close_box(); print_space())
- tbl;
- print_string "]]";
- close_box()
diff --git a/utils/tbl.mli b/utils/tbl.mli
deleted file mode 100644
index 9ab22e0cba..0000000000
--- a/utils/tbl.mli
+++ /dev/null
@@ -1,12 +0,0 @@
-(* Association tables from any ordered type to any type.
- We use the generic ordering to compare keys. *)
-
-type ('a, 'b) t
-
-val empty: ('a, 'b) t
-val add: 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t
-val find: 'a -> ('a, 'b) t -> 'b
-
-val iter: ('a -> 'b -> 'c) -> ('a, 'b) t -> unit
-
-val print: ('a -> unit) -> ('b -> unit) -> ('a, 'b) t -> unit
diff --git a/utils/terminfo.ml b/utils/terminfo.ml
deleted file mode 100644
index 682edaa81f..0000000000
--- a/utils/terminfo.ml
+++ /dev/null
@@ -1,7 +0,0 @@
-(* Basic interface to the terminfo database *)
-
-external setupterm: unit -> unit = "terminfo_setup"
-external getstr: string -> string = "terminfo_getstr"
-external getnum: string -> int = "terminfo_getnum"
-external puts: out_channel -> string -> int -> unit = "terminfo_puts"
-
diff --git a/utils/terminfo.mli b/utils/terminfo.mli
deleted file mode 100644
index 682edaa81f..0000000000
--- a/utils/terminfo.mli
+++ /dev/null
@@ -1,7 +0,0 @@
-(* Basic interface to the terminfo database *)
-
-external setupterm: unit -> unit = "terminfo_setup"
-external getstr: string -> string = "terminfo_getstr"
-external getnum: string -> int = "terminfo_getnum"
-external puts: out_channel -> string -> int -> unit = "terminfo_puts"
-
View Lorry Controller Status