[r2002-10-16 09:58:15 by cvscast] Empty log message

Original author: cvscast
Date: 2002-10-16 09:58:51+00:00

Makefile

@@ -4,7 +4,7 @@ TYPING = typing/typed.cmo typing/typer.cmo
 
 TYPES  = types/recursive.cmo types/sortedList.cmo \
          types/sortedMap.cmo types/boolean.cmo \
-         types/intervals.cmo types/atoms.cmo \
+         types/intervals.cmo types/chars.cmo types/atoms.cmo \
          types/strings.cmo types/types.cmo \
          types/patterns.cmo 
 

depend

@@ -18,6 +18,8 @@ types/atoms.cmo: types/sortedList.cmi types/atoms.cmi
 types/atoms.cmx: types/sortedList.cmx types/atoms.cmi 
 types/boolean.cmo: types/recursive.cmi types/sortedList.cmi types/boolean.cmi 
 types/boolean.cmx: types/recursive.cmx types/sortedList.cmx types/boolean.cmi 
+types/chars.cmo: types/chars.cmi 
+types/chars.cmx: types/chars.cmi 
 types/intervals.cmo: types/intervals.cmi 
 types/intervals.cmx: types/intervals.cmi 
 types/patterns.cmo: types/sortedList.cmi types/sortedMap.cmi types/types.cmi \
@@ -47,5 +49,7 @@ types/patterns.cmi: types/sortedList.cmi types/sortedMap.cmi types/types.cmi
 types/sortedMap.cmi: types/sortedList.cmi 
 types/syntax.cmi: types/patterns.cmi types/types.cmi 
 types/types.cmi: types/sortedMap.cmi types/strings.cmi 
-driver/cduce.cmo: parser/parser.cmi typing/typer.cmi types/types.cmi 
-driver/cduce.cmx: parser/parser.cmx typing/typer.cmx types/types.cmx 
+driver/cduce.cmo: parser/ast.cmo parser/location.cmi parser/parser.cmi \
+    typing/typer.cmi types/types.cmi 
+driver/cduce.cmx: parser/ast.cmx parser/location.cmx parser/parser.cmx \
+    typing/typer.cmx types/types.cmx 

types/chars.ml

+module Unichar = struct
+  type t = int
+
+  let max = 0x10FFFF
+
+  let from_int c = 
+    if (c < 0) || (c > max) then 
+      failwith "Chars.from_int: code point out of bound";
+    c
+
+  let to_int c = c
+
+  let print ppf c =
+    if (c < 128) 
+    then Format.fprintf ppf "%C" (Char.chr c)
+    else Format.fprintf ppf "#x%x" c
+end
+
+type t = (Unichar.t * Unichar.t) list
+
+let max_char = Unichar.max
+
+let from_int c = 
+  if (c < 0) || (c > max_char) then 
+    failwith "Chars.from_int: code point out of bound";
+  c
+
+let to_int c = c
+
+let empty = []
+let full = [0,max_char]
+
+let char_class (a,b) =
+  if a<=b then [a,b] else empty
+
+let rec add l ((a,b) as i) = match l with
+  | [] -> 
+      [i]
+  | ((a1,_) :: _) as l when (b < a1 - 1) -> 
+      i::l
+  | ((a1,b1) as i' :: l') when (a > b1 + 1) -> 
+      i'::(add l' i)
+  | (a1,b1) :: l' -> 
+      add l' (min a a1, max b b1)
+
+let rec neg' start l = match l with
+  | [] -> [start,max_char]
+  | [ (a,b) ] when b = max_char -> [start,a-1]
+  | (a,b) :: l' -> (start, a-1) :: (neg' (b+1) l')
+
+let neg = function
+  | (0,b) :: l -> if b = max_char then []  else neg' (b+1) l
+  | l -> neg' 0 l
+
+let cup i1 i2 = List.fold_left add i1 i2
+
+(* TODO: optimize this ? *)
+let cap i1 i2 = neg (cup (neg i1) (neg i2))
+
+let diff i1 i2 = neg (cup (neg i1) i2)
+
+let is_empty i = i = []
+
+let contains n = List.exists (fun (a,b) -> (n>=a) && (n<=b))
+
+let sample = function
+  | (i,j) :: _ -> i
+  | _ -> raise Not_found
+  
+
+let print =
+  List.map 
+    (fun (a,b) ->
+       if a = b 
+       then fun ppf -> 
+	 Unichar.print ppf a
+       else fun ppf -> 
+	 Format.fprintf ppf "%a--%a" Unichar.print a Unichar.print b
+    )

types/chars.mli

+module Unichar : sig
+  type t
+  val from_int: int -> t
+  val to_int: t -> int
+  val print : Format.formatter -> t -> unit
+end
+
+type t = (Unichar.t * Unichar.t) list
+
+val empty : t
+val full  : t
+val cup   : t -> t -> t
+val cap   : t -> t -> t
+val diff  : t -> t -> t
+val char_class  : Unichar.t * Unichar.t -> t
+
+
+val is_empty : t -> bool
+val contains : int -> t -> bool
+val sample : t -> Unichar.t
+
+val print : t -> (Format.formatter -> unit) list