l4/pkg/ocaml/ocaml/contrib/lex/cset.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Luc Maranget, Jerome Vouillon projet Cristal,            *)
   6 (*                         INRIA Rocquencourt                          *)
   7 (*                                                                     *)
   8 (*  Copyright 2002 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: cset.ml 6269 2004-04-29 11:12:49Z maranget $ *)
  15
  16
  17 exception Bad
  18
  19 type t = (int * int) list
  20
  21
  22 let empty = []
  23 let is_empty = function
  24   | [] -> true
  25   | _  -> false
  26
  27 let singleton c = [c,c]
  28
  29 let interval c1 c2 =
  30   if c1 <= c2 then [c1,c2]
  31   else [c2,c1]
  32
  33
  34 let rec union s1 s2 = match s1,s2 with
  35 | [],_ -> s2
  36 | _,[] -> s1
  37 | (c1,d1) as p1::r1, (c2,d2)::r2 ->
  38     if c1 > c2 then
  39       union s2 s1
  40     else begin (* c1 <= c2 *)
  41       if d1+1 < c2 then
  42         p1::union r1 s2
  43       else if d1 < d2 then
  44         union ((c1,d2)::r2) r1
  45       else
  46         union s1 r2
  47     end
  48
  49 let rec inter l l' =  match l, l' with
  50     _, [] -> []
  51   | [], _ -> []
  52   | (c1, c2)::r, (c1', c2')::r' ->
  53       if c2 < c1' then
  54         inter r l'
  55       else if c2' < c1 then
  56         inter l r'
  57       else if c2 < c2' then
  58         (max c1 c1', c2)::inter r l'
  59       else
  60         (max c1 c1', c2')::inter l r'
  61
  62 let rec diff l l' =  match l, l' with
  63     _, [] -> l
  64   | [], _ -> []
  65   | (c1, c2)::r, (c1', c2')::r' ->
  66       if c2 < c1' then
  67         (c1, c2)::diff r l'
  68       else if c2' < c1 then
  69         diff l r'
  70       else
  71         let r'' = if c2' < c2 then (c2' + 1, c2) :: r else r in
  72         if c1 < c1' then
  73           (c1, c1' - 1)::diff r'' r'
  74         else
  75           diff r'' r'
  76
  77
  78 let eof = singleton 256
  79 and all_chars = interval 0 255
  80 and all_chars_eof = interval 0 256
  81
  82 let complement s = diff all_chars s
  83
  84 let env_to_array env = match env with
  85 | []         -> assert false
  86 | (_,x)::rem ->
  87     let res = Array.create 257 x in
  88     List.iter
  89       (fun (c,y) ->
  90         List.iter
  91           (fun (i,j) ->
  92             for k=i to j do
  93               res.(k) <- y
  94             done)
  95           c)
  96       rem ;
  97     res
  98
  99