summaryrefslogtreecommitdiffstats
path: root/debugger/primitives.ml
blob: 8cbc5387cba7e0378b44e1114ab7db5ddced6c9f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
(***********************************************************************)
(*                                                                     *)
(*                                OCaml                                *)
(*                                                                     *)
(*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
(*          OCaml port by John Malecki and Xavier Leroy                *)
(*                                                                     *)
(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the Q Public License version 1.0.               *)
(*                                                                     *)
(***********************************************************************)

(*********************** Basic functions and types *********************)

(*** Miscellaneous ***)
exception Out_of_range

let nothing _ = ()

(*** Operations on lists. ***)

(* Remove an element from a list *)
let except e l =
 let rec except_e = function
     [] -> []
   | elem::l -> if e = elem then l else elem::except_e l
 in except_e l

(* Position of an element in a list. Head of list has position 0. *)
let index a l =
 let rec index_rec i = function
     []  -> raise Not_found
  | b::l -> if a = b then i else index_rec (i + 1) l
 in index_rec 0 l

(* Return the `n' first elements of `l' *)
(* ### n l -> l' *)
let rec list_truncate =
  fun
    p0 p1 -> match (p0,p1) with (0, _)      -> []
  | (_, [])     -> []
  | (n, (a::l)) -> a::(list_truncate (n - 1) l)

(* Separe the `n' first elements of `l' and the others *)
(* ### n list -> (first, last) *)
let rec list_truncate2 =
  fun
    p0 p1 -> match (p0,p1) with (0, l) ->
      ([], l)
  | (_, []) ->
      ([], [])
  | (n, (a::l)) ->
      let (first, last) = (list_truncate2 (n - 1) l) in
        (a::first, last)

(* Replace x by y in list l *)
(* ### x y l -> l' *)
let list_replace x y =
  let rec repl =
    function
      [] -> []
    | a::l ->
        if a == x then y::l
        else a::(repl l)
  in repl

(*** Operations on strings. ***)

(* Remove blanks (spaces and tabs) at beginning and end of a string. *)
let is_space = function
  | ' ' | '\t' -> true | _ -> false

let string_trim s =
  let l = String.length s and i = ref 0 in
    while
      !i < l && is_space (String.get s !i)
    do
      incr i
    done;
    let j = ref (l - 1) in
      while
        !j >= !i && is_space (String.get s !j)
      do
        decr j
      done;
      String.sub s !i (!j - !i + 1)

(* isprefix s1 s2 returns true if s1 is a prefix of s2. *)

let isprefix s1 s2 =
  let l1 = String.length s1 and l2 = String.length s2 in
  (l1 = l2 && s1 = s2) || (l1 < l2 && s1 = String.sub s2 0 l1)

(* Split a string at the given delimiter char *)

let split_string sep str =
  let rec split i j =
    if j >= String.length str then
      if i >= j then [] else [String.sub str i (j-i)]
    else if str.[j] = sep then
      if i >= j
      then skip_sep (j+1)
      else String.sub str i (j-i) :: skip_sep (j+1)
    else
      split i (j+1)
  and skip_sep j =
    if j < String.length str && str.[j] = sep
    then skip_sep (j+1)
    else split j j
  in split 0 0

(*** I/O channels ***)

type io_channel = {
  io_in : in_channel;
  io_out : out_channel;
  io_fd : Unix.file_descr
  }

let io_channel_of_descr fd = {
  io_in = Unix.in_channel_of_descr fd;
  io_out = Unix.out_channel_of_descr fd;
  io_fd = fd
  }

let close_io io_channel =
  close_out_noerr io_channel.io_out;
  close_in_noerr io_channel.io_in;
;;

let std_io = {
  io_in = stdin;
  io_out = stdout;
  io_fd = Unix.stdin
  }