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

Diff of /types/types.ml

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

revision 77 by abate, Tue Jul 10 17:03:57 2007 UTC revision 78 by abate, Tue Jul 10 17:04:23 2007 UTC
# Line 5  Line 5 
5  let map_sort f l =  let map_sort f l =
6    SortedList.from_list (List.map f l)    SortedList.from_list (List.map f l)
7    
8  type label = int  module HashedString =
9  type atom  = int  struct
10      type t = string
11  let counter_label = ref 0    let hash = Hashtbl.hash
12  let label_table = Hashtbl.create 63    let equal = (=)
13  let label_names = Hashtbl.create 63  end
   
 let label s =  
   try Hashtbl.find label_table s  
   with Not_found ->  
     incr counter_label;  
     Hashtbl.add label_table s !counter_label;  
     Hashtbl.add label_names !counter_label s;  
     !counter_label  
   
 let label_name l =  
   Hashtbl.find label_names l  
14    
15  let mk_atom = label  module LabelPool = Pool.Make(HashedString)
16    module AtomPool  = Pool.Make(HashedString)
17    
18  let atom_name = label_name  type label = LabelPool.t
19    type atom  = AtomPool.t
20    
21  type const = Integer of Big_int.big_int | Atom of atom | Char of Chars.Unichar.t  type const = Integer of Big_int.big_int | Atom of atom | Char of Chars.Unichar.t
22    
# Line 168  Line 159 
159    
160  module Print =  module Print =
161  struct  struct
162    let print_atom ppf a = Format.fprintf ppf "`%s" (atom_name a)    let print_atom ppf a =
163        Format.fprintf ppf "`%s" (AtomPool.value a)
164    
165    let print_const ppf = function    let print_const ppf = function
166      | Integer i -> Format.fprintf ppf "%s" (Big_int.string_of_big_int i)      | Integer i -> Format.fprintf ppf "%s" (Big_int.string_of_big_int i)
# Line 245  Line 237 
237      Format.fprintf ppf "@[(%a -> %a)@]" print t1 print t2      Format.fprintf ppf "@[(%a -> %a)@]" print t1 print t2
238    and print_record ppf (l,o,t) =    and print_record ppf (l,o,t) =
239      Format.fprintf ppf "@[{ %s =%s %a }@]"      Format.fprintf ppf "@[{ %s =%s %a }@]"
240        (label_name l) (if o then "?" else "") print t        (LabelPool.value l) (if o then "?" else "") print t
241    
242    
243    let end_print ppf =    let end_print ppf =
# Line 431  Line 423 
423    | Record of (label * t) list    | Record of (label * t) list
424    | Fun of (node * node) list    | Fun of (node * node) list
425    
 let rec gen_atom i l =  
   if SortedList.mem l i then gen_atom (succ i) l  else i  
   
426  let rec sample_rec memo d =  let rec sample_rec memo d =
427    if (Assumptions.mem d memo) || (is_empty d) then raise Not_found    if (Assumptions.mem d memo) || (is_empty d) then raise Not_found
428    else    else
429      try Int (Intervals.sample d.ints) with Not_found ->      try Int (Intervals.sample d.ints) with Not_found ->
430      try Atom (Atoms.sample (gen_atom 0) d.atoms) with Not_found ->      try Atom (Atoms.sample (fun _ -> AtomPool.dummy_min) d.atoms) with
431            Not_found ->
432    (* Here: could create a fresh atom ... *)
433      try Char (Chars.sample d.chars) with Not_found ->      try Char (Chars.sample d.chars) with Not_found ->
434      try sample_rec_arrow d.arrow with Not_found ->      try sample_rec_arrow d.arrow with Not_found ->
435    
# Line 506  Line 497 
497    
498    let rec print ppf = function    let rec print ppf = function
499      | Int i -> Format.fprintf ppf "%s" (Big_int.string_of_big_int i)      | Int i -> Format.fprintf ppf "%s" (Big_int.string_of_big_int i)
500      | Atom a -> Format.fprintf ppf "`%s" (atom_name a)      | Atom a ->
501            if a = LabelPool.dummy_min then
502              Format.fprintf ppf "(almost any atom)"
503            else
504              Format.fprintf ppf "`%s" (AtomPool.value a)
505      | Char c -> Chars.Unichar.print ppf c      | Char c -> Chars.Unichar.print ppf c
506      | Pair (x1,x2) -> Format.fprintf ppf "(%a,%a)" print x1 print x2      | Pair (x1,x2) -> Format.fprintf ppf "(%a,%a)" print x1 print x2
507      | Record r ->      | Record r ->
# Line 514  Line 509 
509            (print_sep            (print_sep
510               (fun ppf (l,x) ->               (fun ppf (l,x) ->
511                  Format.fprintf ppf "%s = %a"                  Format.fprintf ppf "%s = %a"
512                  (label_name l)                  (LabelPool.value l)
513                  print x                  print x
514               )               )
515               " ; "               " ; "
Legend:
Removed from v.77  
changed lines
  Added in v.78
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5