/[svn]/types/types.ml
ViewVC logotype

Diff of /types/types.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 12 by abate, Tue Jul 10 16:57:31 2007 UTC revision 13 by abate, Tue Jul 10 16:57:42 2007 UTC
# Line 6  Line 6 
6  type label = int  type label = int
7  type atom  = int  type atom  = int
8    
9  type const = Integer of int | Atom of atom | String of string  type const = Integer of int | Atom of atom | String of string | Char of Chars.Unichar.t
10    
11  module I = struct  module I = struct
12    type 'a t = {    type 'a t = {
# Line 15  Line 15 
15      times : ('a * 'a) Boolean.t;      times : ('a * 'a) Boolean.t;
16      arrow : ('a * 'a) Boolean.t;      arrow : ('a * 'a) Boolean.t;
17      record: (label * bool * 'a) Boolean.t;      record: (label * bool * 'a) Boolean.t;
18        chars : Chars.t;
19      strs  : Strings.t;      strs  : Strings.t;
20    }    }
21    
# Line 24  Line 25 
25      record= Boolean.empty;      record= Boolean.empty;
26      ints  = Intervals.empty;      ints  = Intervals.empty;
27      atoms = Atoms.empty;      atoms = Atoms.empty;
28        chars = Chars.empty;
29      strs  = Strings.empty;      strs  = Strings.empty;
30    }    }
31    let any =  {    let any =  {
# Line 32  Line 34 
34      record= Boolean.full;      record= Boolean.full;
35      ints  = Intervals.full;      ints  = Intervals.full;
36      atoms = Atoms.full;      atoms = Atoms.full;
37        chars = Chars.full;
38      strs  = Strings.any;      strs  = Strings.any;
39    }    }
40    
# Line 41  Line 44 
44    let record label opt t = { empty with record = Boolean.atom (label,opt,t) }    let record label opt t = { empty with record = Boolean.atom (label,opt,t) }
45    let atom a = { empty with atoms = Atoms.atom a }    let atom a = { empty with atoms = Atoms.atom a }
46    let string r = { empty with strs = Strings.Regexp.compile r }    let string r = { empty with strs = Strings.Regexp.compile r }
47      let char c = { empty with chars = Chars.atom c }
48      let char_class c1 c2 = { empty with chars = Chars.char_class c1 c2 }
49    let constant = function    let constant = function
50      | Integer i -> interval i i      | Integer i -> interval i i
51      | Atom a -> atom a      | Atom a -> atom a
52      | String s -> string (Strings.Regexp.str s)      | String s -> string (Strings.Regexp.str s)
53        | Char c -> char c
54    
55    
56    let any_record = { empty with record = any.record }    let any_record = { empty with record = any.record }
# Line 56  Line 62 
62        record= Boolean.cup x.record y.record;        record= Boolean.cup x.record y.record;
63        ints  = Intervals.cup x.ints  y.ints;        ints  = Intervals.cup x.ints  y.ints;
64        atoms = Atoms.cup x.atoms y.atoms;        atoms = Atoms.cup x.atoms y.atoms;
65          chars = Chars.cup x.chars y.chars;
66        strs  = Strings.cup x.strs y.strs;        strs  = Strings.cup x.strs y.strs;
67      }      }
68    
# Line 66  Line 73 
73        arrow = Boolean.cap x.arrow y.arrow;        arrow = Boolean.cap x.arrow y.arrow;
74        ints  = Intervals.cap x.ints  y.ints;        ints  = Intervals.cap x.ints  y.ints;
75        atoms = Atoms.cap x.atoms y.atoms;        atoms = Atoms.cap x.atoms y.atoms;
76          chars = Chars.cap x.chars y.chars;
77        strs  = Strings.cap x.strs y.strs;        strs  = Strings.cap x.strs y.strs;
78      }      }
79    
# Line 76  Line 84 
84        record= Boolean.diff x.record y.record;        record= Boolean.diff x.record y.record;
85        ints  = Intervals.diff x.ints  y.ints;        ints  = Intervals.diff x.ints  y.ints;
86        atoms = Atoms.diff x.atoms y.atoms;        atoms = Atoms.diff x.atoms y.atoms;
87          chars = Chars.diff x.chars y.chars;
88        strs  = Strings.diff x.strs y.strs;        strs  = Strings.diff x.strs y.strs;
89      }      }
90    
# Line 84  Line 93 
93    let equal e a b =    let equal e a b =
94      if a.ints <> b.ints then raise NotEqual;      if a.ints <> b.ints then raise NotEqual;
95      if a.atoms <> b.atoms then raise NotEqual;      if a.atoms <> b.atoms then raise NotEqual;
96        if a.chars <> b.chars then raise NotEqual;
97      if a.strs <> b.strs then raise NotEqual;      if a.strs <> b.strs then raise NotEqual;
98      Boolean.equal (fun (x1,x2) (y1,y2) -> e x1 y1; e x2 y2) a.times b.times;      Boolean.equal (fun (x1,x2) (y1,y2) -> e x1 y1; e x2 y2) a.times b.times;
99      Boolean.equal (fun (x1,x2) (y1,y2) -> e x1 y1; e x2 y2) a.arrow b.arrow;      Boolean.equal (fun (x1,x2) (y1,y2) -> e x1 y1; e x2 y2) a.arrow b.arrow;
# Line 97  Line 107 
107        record= Boolean.map (fun (l,o,x) -> (l,o, f x)) a.record;        record= Boolean.map (fun (l,o,x) -> (l,o, f x)) a.record;
108        ints  = a.ints;        ints  = a.ints;
109        atoms = a.atoms;        atoms = a.atoms;
110          chars = a.chars;
111        strs  = a.strs;        strs  = a.strs;
112      }      }
113    
# Line 220  Line 231 
231    else if Assumptions.mem d !memo then true    else if Assumptions.mem d !memo then true
232    else if not (Intervals.is_empty d.ints) then false    else if not (Intervals.is_empty d.ints) then false
233    else if not (Atoms.is_empty d.atoms) then false    else if not (Atoms.is_empty d.atoms) then false
234      else if not (Chars.is_empty d.chars) then false
235    else if not (Strings.is_empty d.strs) then false    else if not (Strings.is_empty d.strs) then false
236    else (    else (
237      let backup = !memo in      let backup = !memo in
# Line 298  Line 310 
310  type t =  type t =
311    | Int of int    | Int of int
312    | Atom of atom    | Atom of atom
313      | Char of Chars.Unichar.t
314    | String of string    | String of string
315    | Pair of t * t    | Pair of t * t
316    | Record of (label * t) list    | Record of (label * t) list
# Line 311  Line 324 
324    else    else
325      try Int (Intervals.sample d.ints) with Not_found ->      try Int (Intervals.sample d.ints) with Not_found ->
326      try Atom (Atoms.sample (gen_atom 0) d.atoms) with Not_found ->      try Atom (Atoms.sample (gen_atom 0) d.atoms) with Not_found ->
327        try Char (Chars.sample d.chars) with Not_found ->
328      try String (Strings.sample d.strs) with Not_found ->      try String (Strings.sample d.strs) with Not_found ->
329      try sample_rec_arrow d.arrow with Not_found ->      try sample_rec_arrow d.arrow with Not_found ->
330    
# Line 604  Line 618 
618      if d = any then Format.fprintf ppf "Any" else      if d = any then Format.fprintf ppf "Any" else
619      print_union ppf      print_union ppf
620        (Intervals.print d.ints @        (Intervals.print d.ints @
621           Chars.print d.chars @
622         Strings.print d.strs @         Strings.print d.strs @
623         Atoms.print "AnyAtom" print_atom d.atoms @         Atoms.print "AnyAtom" print_atom d.atoms @
624         Boolean.print "(Any,Any)" print_times d.times @         Boolean.print "(Any,Any)" print_times d.times @
# Line 653  Line 668 
668    let rec print_sample ppf = function    let rec print_sample ppf = function
669      | Sample.Int i -> Format.fprintf ppf "%i" i      | Sample.Int i -> Format.fprintf ppf "%i" i
670      | Sample.Atom a -> Format.fprintf ppf "`%s" (atom_name a)      | Sample.Atom a -> Format.fprintf ppf "`%s" (atom_name a)
671        | Sample.Char c -> Chars.Unichar.print ppf c
672      | Sample.String s -> Format.fprintf ppf "%S" s      | Sample.String s -> Format.fprintf ppf "%S" s
673      | Sample.Pair (x1,x2) ->      | Sample.Pair (x1,x2) ->
674          Format.fprintf ppf "(%a,%a)"          Format.fprintf ppf "(%a,%a)"

Legend:
Removed from v.12  
changed lines
  Added in v.13

CVS Admin">CVS Admin
ViewVC Help
Powered by ViewVC 1.1.5