l4/pkg/ocaml/ocaml/contrib/otherlibs/labltk/support/support.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                 MLTk, Tcl/Tk interface of Objective Caml            *)
   4 (*                                                                     *)
   5 (*    Francois Rouaix, Francois Pessaux, Jun Furuse and Pierre Weis    *)
   6 (*               projet Cristal, INRIA Rocquencourt                    *)
   7 (*            Jacques Garrigue, Kyoto University RIMS                  *)
   8 (*                                                                     *)
   9 (*  Copyright 2002 Institut National de Recherche en Informatique et   *)
  10 (*  en Automatique and Kyoto University.  All rights reserved.         *)
  11 (*  This file is distributed under the terms of the GNU Library        *)
  12 (*  General Public License, with the special exception on linking      *)
  13 (*  described in file LICENSE found in the Objective Caml source tree. *)
  14 (*                                                                     *)
  15 (***********************************************************************)
  16
  17 (* $Id: support.ml 4745 2002-04-26 12:16:26Z furuse $ *)
  18
  19 (* Parsing results of Tcl *)
  20 (* List.split a string according to char_sep predicate *)
  21 let split_str ~pred:char_sep str =
  22   let len = String.length str in
  23   let rec skip_sep cur =
  24     if cur >= len then cur
  25     else if char_sep str.[cur] then skip_sep (succ cur)
  26     else cur  in
  27   let rec split beg cur =
  28     if cur >= len then
  29       if beg = cur then []
  30       else [String.sub str beg (len - beg)]
  31     else if char_sep str.[cur]
  32          then
  33            let nextw = skip_sep cur in
  34             (String.sub str beg (cur - beg))
  35               ::(split nextw nextw)
  36          else split beg (succ cur) in
  37   let wstart = skip_sep 0 in
  38   split wstart wstart
  39
  40 (* Very easy hack for option type *)
  41 let may f = function
  42   Some x -> Some (f x)
  43 | None -> None
  44
  45 let maycons f x l =
  46   match x with
  47     Some x -> f x :: l
  48   | None -> l