l4/pkg/ocaml/ocaml/contrib/debugger/primitives.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*          Jerome Vouillon, projet Cristal, INRIA Rocquencourt        *)
   6 (*          Objective Caml port by John Malecki and Xavier Leroy       *)
   7 (*                                                                     *)
   8 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   9 (*  en Automatique.  All rights reserved.  This file is distributed    *)
  10 (*  under the terms of the Q Public License version 1.0.               *)
  11 (*                                                                     *)
  12 (***********************************************************************)
  13
  14 (* $Id: primitives.ml 9226 2009-04-02 09:44:21Z xclerc $ *)
  15
  16 (*********************** Basic functions and types *********************)
  17
  18 (*** Miscellaneous ***)
  19 exception Out_of_range
  20
  21 let nothing _ = ()
  22
  23 (*** Operations on lists. ***)
  24
  25 (* Remove an element from a list *)
  26 let except e l =
  27  let rec except_e = function
  28      [] -> []
  29    | elem::l -> if e = elem then l else elem::except_e l
  30  in except_e l
  31
  32 (* Position of an element in a list. Head of list has position 0. *)
  33 let index a l =
  34  let rec index_rec i = function
  35      []  -> raise Not_found
  36   | b::l -> if a = b then i else index_rec (i + 1) l
  37  in index_rec 0 l
  38
  39 (* Return the `n' first elements of `l' *)
  40 (* ### n l -> l' *)
  41 let rec list_truncate =
  42   fun
  43     p0 p1 -> match (p0,p1) with (0, _)      -> []
  44   | (_, [])     -> []
  45   | (n, (a::l)) -> a::(list_truncate (n - 1) l)
  46
  47 (* Separe the `n' first elements of `l' and the others *)
  48 (* ### n list -> (first, last) *)
  49 let rec list_truncate2 =
  50   fun
  51     p0 p1 -> match (p0,p1) with (0, l) ->
  52       ([], l)
  53   | (_, []) ->
  54       ([], [])
  55   | (n, (a::l)) ->
  56       let (first, last) = (list_truncate2 (n - 1) l) in
  57         (a::first, last)
  58
  59 (* Replace x by y in list l *)
  60 (* ### x y l -> l' *)
  61 let list_replace x y =
  62   let rec repl =
  63     function
  64       [] -> []
  65     | a::l ->
  66         if a == x then y::l
  67         else a::(repl l)
  68   in repl
  69
  70 (*** Operations on strings. ***)
  71
  72 (* Remove blanks (spaces and tabs) at beginning and end of a string. *)
  73 let is_space = function
  74   | ' ' | '\t' -> true | _ -> false
  75
  76 let string_trim s =
  77   let l = String.length s and i = ref 0 in
  78     while
  79       !i < l && is_space (String.get s !i)
  80     do
  81       incr i
  82     done;
  83     let j = ref (l - 1) in
  84       while
  85         !j >= !i && is_space (String.get s !j)
  86       do
  87         decr j
  88       done;
  89       String.sub s !i (!j - !i + 1)
  90
  91 (* isprefix s1 s2 returns true if s1 is a prefix of s2. *)
  92
  93 let isprefix s1 s2 =
  94   let l1 = String.length s1 and l2 = String.length s2 in
  95   (l1 = l2 && s1 = s2) || (l1 < l2 && s1 = String.sub s2 0 l1)
  96
  97 (* Split a string at the given delimiter char *)
  98
  99 let split_string sep str =
 100   let rec split i j =
 101     if j >= String.length str then
 102       if i >= j then [] else [String.sub str i (j-i)]
 103     else if str.[j] = sep then
 104       if i >= j
 105       then skip_sep (j+1)
 106       else String.sub str i (j-i) :: skip_sep (j+1)
 107     else
 108       split i (j+1)
 109   and skip_sep j =
 110     if j < String.length str && str.[j] = sep
 111     then skip_sep (j+1)
 112     else split j j
 113   in split 0 0
 114
 115 (*** I/O channels ***)
 116
 117 type io_channel = {
 118   io_in : in_channel;
 119   io_out : out_channel;
 120   io_fd : Unix.file_descr
 121   }
 122
 123 let io_channel_of_descr fd = {
 124   io_in = Unix.in_channel_of_descr fd;
 125   io_out = Unix.out_channel_of_descr fd;
 126   io_fd = fd
 127   }
 128
 129 let close_io io_channel =
 130   close_out_noerr io_channel.io_out;
 131   close_in_noerr io_channel.io_in;
 132 ;;
 133
 134 let std_io = {
 135   io_in = stdin;
 136   io_out = stdout;
 137   io_fd = Unix.stdin
 138   }