Commit 792c7bed authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2002-11-06 07:46:53 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-06 07:47:30+00:00
parent 0db6894c
# Source directories # Source directories
DIRS = parser typing types runtime driver DIRS = misc parser typing types runtime driver
CLEAN_DIRS = $(DIRS) tools tests CLEAN_DIRS = $(DIRS) tools tests
# Objects to build # Objects to build
MISC = misc/pool.cmo
PARSER = parser/lexer.cmo parser/location.cmo parser/ast.cmo parser/parser.cmo PARSER = parser/lexer.cmo parser/location.cmo parser/ast.cmo parser/parser.cmo
TYPING = typing/typed.cmo typing/typer.cmo TYPING = typing/typed.cmo typing/typer.cmo
...@@ -27,7 +29,7 @@ DRIVER = driver/cduce.cmo ...@@ -27,7 +29,7 @@ DRIVER = driver/cduce.cmo
TOPLEVEL = toplevel/toploop.cmo TOPLEVEL = toplevel/toploop.cmo
OBJECTS = $(TYPES) $(PARSER) $(TYPING) $(RUNTIME) OBJECTS = $(MISC) $(TYPES) $(PARSER) $(TYPING) $(RUNTIME)
XOBJECTS = $(OBJECTS:.cmo=.cmx) XOBJECTS = $(OBJECTS:.cmo=.cmx)
XDRIVER = $(DRIVER:.cmo=.cmx) XDRIVER = $(DRIVER:.cmo=.cmx)
......
misc/pool.cmo: misc/pool.cmi
misc/pool.cmx: misc/pool.cmi
parser/ast.cmo: parser/location.cmi types/patterns.cmi types/types.cmi parser/ast.cmo: parser/location.cmi types/patterns.cmi types/types.cmi
parser/ast.cmx: parser/location.cmx types/patterns.cmx types/types.cmx parser/ast.cmx: parser/location.cmx types/patterns.cmx types/types.cmx
parser/location.cmo: parser/location.cmi parser/location.cmo: parser/location.cmi
...@@ -47,19 +49,27 @@ types/sortedMap.cmx: types/sortedMap.cmi ...@@ -47,19 +49,27 @@ types/sortedMap.cmx: types/sortedMap.cmi
types/type_bool.cmo: types/boolean.cmi types/recursive.cmo types/type_bool.cmo: types/boolean.cmi types/recursive.cmo
types/type_bool.cmx: types/boolean.cmx types/recursive.cmx types/type_bool.cmx: types/boolean.cmx types/recursive.cmx
types/types.cmo: types/atoms.cmi types/boolean.cmi types/chars.cmi \ types/types.cmo: types/atoms.cmi types/boolean.cmi types/chars.cmi \
types/intervals.cmi types/recursive.cmo types/recursive_noshare.cmo \ types/intervals.cmi misc/pool.cmi types/recursive.cmo \
types/sortedList.cmi types/sortedMap.cmi types/types.cmi types/recursive_noshare.cmo types/sortedList.cmi types/sortedMap.cmi \
types/types.cmi
types/types.cmx: types/atoms.cmx types/boolean.cmx types/chars.cmx \ types/types.cmx: types/atoms.cmx types/boolean.cmx types/chars.cmx \
types/intervals.cmx types/recursive.cmx types/recursive_noshare.cmx \ types/intervals.cmx misc/pool.cmx types/recursive.cmx \
types/sortedList.cmx types/sortedMap.cmx types/types.cmi types/recursive_noshare.cmx types/sortedList.cmx types/sortedMap.cmx \
runtime/eval.cmo: runtime/load_xml.cmi runtime/run_dispatch.cmi \ types/types.cmi
typing/typed.cmo types/types.cmi runtime/value.cmi runtime/eval.cmi runtime/eval.cmo: runtime/load_xml.cmi runtime/print_xml.cmo \
runtime/eval.cmx: runtime/load_xml.cmx runtime/run_dispatch.cmx \ runtime/run_dispatch.cmi typing/typed.cmo types/types.cmi \
typing/typed.cmx types/types.cmx runtime/value.cmx runtime/eval.cmi runtime/value.cmi runtime/eval.cmi
runtime/eval.cmx: runtime/load_xml.cmx runtime/print_xml.cmx \
runtime/run_dispatch.cmx typing/typed.cmx types/types.cmx \
runtime/value.cmx runtime/eval.cmi
runtime/load_xml.cmo: types/sortedMap.cmi types/types.cmi runtime/value.cmi \ runtime/load_xml.cmo: types/sortedMap.cmi types/types.cmi runtime/value.cmi \
runtime/load_xml.cmi runtime/load_xml.cmi
runtime/load_xml.cmx: types/sortedMap.cmx types/types.cmx runtime/value.cmx \ runtime/load_xml.cmx: types/sortedMap.cmx types/types.cmx runtime/value.cmx \
runtime/load_xml.cmi runtime/load_xml.cmi
runtime/print_xml.cmo: types/chars.cmi types/sequence.cmi types/types.cmi \
runtime/value.cmi
runtime/print_xml.cmx: types/chars.cmx types/sequence.cmx types/types.cmx \
runtime/value.cmx
runtime/run_dispatch.cmo: types/patterns.cmi types/types.cmi \ runtime/run_dispatch.cmo: types/patterns.cmi types/types.cmi \
runtime/value.cmi runtime/run_dispatch.cmi runtime/value.cmi runtime/run_dispatch.cmi
runtime/run_dispatch.cmx: types/patterns.cmx types/types.cmx \ runtime/run_dispatch.cmx: types/patterns.cmx types/types.cmx \
...@@ -82,7 +92,7 @@ types/sequence.cmi: types/types.cmi ...@@ -82,7 +92,7 @@ types/sequence.cmi: types/types.cmi
types/sortedMap.cmi: types/sortedList.cmi types/sortedMap.cmi: types/sortedList.cmi
types/syntax.cmi: types/patterns.cmi types/types.cmi types/syntax.cmi: types/patterns.cmi types/types.cmi
types/types.cmi: types/atoms.cmi types/chars.cmi types/intervals.cmi \ types/types.cmi: types/atoms.cmi types/chars.cmi types/intervals.cmi \
types/sortedMap.cmi misc/pool.cmi
runtime/eval.cmi: typing/typed.cmo runtime/value.cmi runtime/eval.cmi: typing/typed.cmo runtime/value.cmi
runtime/load_xml.cmi: runtime/value.cmi runtime/load_xml.cmi: runtime/value.cmi
runtime/run_dispatch.cmi: types/patterns.cmi runtime/value.cmi runtime/run_dispatch.cmi: types/patterns.cmi runtime/value.cmi
......
...@@ -34,12 +34,12 @@ let rec print_exn ppf = function ...@@ -34,12 +34,12 @@ let rec print_exn ppf = function
Value.print v Value.print v
| Typer.WrongLabel (t,l) -> | Typer.WrongLabel (t,l) ->
Format.fprintf ppf "Wrong record selection: the label %s@\n" Format.fprintf ppf "Wrong record selection: the label %s@\n"
(Types.label_name l); (Types.LabelPool.value l);
Format.fprintf ppf "applied to an expression of type %a@\n" Format.fprintf ppf "applied to an expression of type %a@\n"
print_norm t print_norm t
| Typer.MultipleLabel l -> | Typer.MultipleLabel l ->
Format.fprintf ppf "Multiple occurences for the record label %s@\n" Format.fprintf ppf "Multiple occurences for the record label %s@\n"
(Types.label_name l); (Types.LabelPool.value l);
| Typer.ShouldHave (t,msg) -> | Typer.ShouldHave (t,msg) ->
Format.fprintf ppf "This expression should have type %a@\n%s@\n" Format.fprintf ppf "This expression should have type %a@\n%s@\n"
print_norm t print_norm t
...@@ -94,7 +94,7 @@ let debug = function ...@@ -94,7 +94,7 @@ let debug = function
| `Any -> Format.fprintf ppf "Any" | `Any -> Format.fprintf ppf "Any"
| `Label l -> | `Label l ->
let (pr,ab) = Types.Record.normal' t l in let (pr,ab) = Types.Record.normal' t l in
Format.fprintf ppf "Label (%s,@[" (Types.label_name l); Format.fprintf ppf "Label (%s,@[" (Types.LabelPool.value l);
List.iter (fun (d,n) -> List.iter (fun (d,n) ->
Format.fprintf ppf "%a => @[%a@];@\n" Format.fprintf ppf "%a => @[%a@];@\n"
Types.Print.print_descr d Types.Print.print_descr d
......
...@@ -91,7 +91,8 @@ EXTEND ...@@ -91,7 +91,8 @@ EXTEND
[ e1 = expr; op = ["*" | "/"]; e2 = expr -> mk loc (Op (op,[e1;e2])) [ e1 = expr; op = ["*" | "/"]; e2 = expr -> mk loc (Op (op,[e1;e2]))
] ]
| |
[ e = expr; "."; l = [LIDENT | UIDENT] -> mk loc (Dot (e,Types.label l)) [ e = expr; "."; l = [LIDENT | UIDENT] ->
mk loc (Dot (e,Types.LabelPool.mk l))
] ]
| |
...@@ -254,7 +255,7 @@ EXTEND ...@@ -254,7 +255,7 @@ EXTEND
[ [ r = LIST0 [ l = [LIDENT | UIDENT]; [ [ r = LIST0 [ l = [LIDENT | UIDENT];
o = ["=?" -> true | "=" -> false]; o = ["=?" -> true | "=" -> false];
x = pat -> x = pat ->
mk loc (Record (Types.label l,o,x)) mk loc (Record (Types.LabelPool.mk l,o,x))
] SEP ";" -> ] SEP ";" ->
match r with match r with
| [] -> mk loc (Internal Types.Record.any) | [] -> mk loc (Internal Types.Record.any)
...@@ -271,7 +272,7 @@ EXTEND ...@@ -271,7 +272,7 @@ EXTEND
const: const:
[ [
[ i = INT -> Types.Integer (Big_int.big_int_of_string i) [ i = INT -> Types.Integer (Big_int.big_int_of_string i)
| "`"; a = [LIDENT | UIDENT] -> Types.Atom (Types.mk_atom a) | "`"; a = [LIDENT | UIDENT] -> Types.Atom (Types.AtomPool.mk a)
| c = char -> Types.Char c ] | c = char -> Types.Char c ]
]; ];
...@@ -279,7 +280,7 @@ EXTEND ...@@ -279,7 +280,7 @@ EXTEND
[ [
[ LIDENT "_" -> mk loc (Internal (Types.atom (Atoms.any))) ] [ LIDENT "_" -> mk loc (Internal (Types.atom (Atoms.any))) ]
| [ a = [LIDENT | UIDENT] -> | [ a = [LIDENT | UIDENT] ->
mk loc (Internal (Types.atom (Atoms.atom (Types.mk_atom a)))) ] mk loc (Internal (Types.atom (Atoms.atom (Types.AtomPool.mk a)))) ]
| [ t = pat -> t ] | [ t = pat -> t ]
]; ];
...@@ -288,7 +289,8 @@ EXTEND ...@@ -288,7 +289,8 @@ EXTEND
expr_record_spec: expr_record_spec:
[ [ r = LIST1 [ [ r = LIST1
[ l = [LIDENT | UIDENT]; "="; x = expr -> (Types.label l,x) ] [ l = [LIDENT | UIDENT]; "="; x = expr ->
(Types.LabelPool.mk l,x) ]
SEP ";" -> SEP ";" ->
mk loc (RecordLitt r) mk loc (RecordLitt r)
] ]; ] ];
...@@ -296,7 +298,7 @@ EXTEND ...@@ -296,7 +298,7 @@ EXTEND
expr_tag_spec: expr_tag_spec:
[ [
[ a = [LIDENT | UIDENT] -> [ a = [LIDENT | UIDENT] ->
mk loc (Cst (Types.Atom (Types.mk_atom a))) ] mk loc (Cst (Types.Atom (Types.AtomPool.mk a))) ]
| [ e = expr LEVEL "no_appl" -> e ] | [ e = expr LEVEL "no_appl" -> e ]
]; ];
......
...@@ -8,8 +8,9 @@ let global_env = ref Env.empty ...@@ -8,8 +8,9 @@ let global_env = ref Env.empty
let enter_global x v = global_env := Env.add x v !global_env let enter_global x v = global_env := Env.add x v !global_env
let exn_int_of = CDuceExn (Pair (Atom (Types.mk_atom "Invalid_argument"), let exn_int_of = CDuceExn (Pair (
string "int_of")) Atom (Types.AtomPool.mk "Invalid_argument"),
string "int_of"))
......
...@@ -31,12 +31,12 @@ let run s = ...@@ -31,12 +31,12 @@ let run s =
| None -> () in | None -> () in
let rec parse_elt name att = let rec parse_elt name att =
let att = List.map (fun (l,v) -> Types.label l, string v nil) att in let att = List.map (fun (l,v) -> Types.LabelPool.mk l, string v nil) att in
let att = SortedMap.from_list (fun _ _ -> assert false) att in let att = SortedMap.from_list (fun _ _ -> assert false) att in
let child = parse_seq () in let child = parse_seq () in
let elt = Pair let elt = Pair
(Atom (Types.mk_atom name), (Atom (Types.AtomPool.mk name),
Pair (Record att, child) Pair (Record att, child)
) in ) in
(match !curr with (match !curr with
......
...@@ -4,8 +4,9 @@ open Pxp_aux ...@@ -4,8 +4,9 @@ open Pxp_aux
open Pxp_types open Pxp_types
open Value open Value
let exn_print_xml = CDuceExn (Pair (Atom (Types.mk_atom "Invalid_argument"), let exn_print_xml = CDuceExn (Pair (
string "print_xml")) Atom (Types.AtomPool.mk "Invalid_argument"),
string "print_xml"))
let to_enc = `Enc_iso88591 let to_enc = `Enc_iso88591
...@@ -38,11 +39,11 @@ let string_of_xml v= ...@@ -38,11 +39,11 @@ let string_of_xml v=
let rec print_elt = function let rec print_elt = function
| Pair (Atom tag, Pair (Record attrs, content)) -> | Pair (Atom tag, Pair (Record attrs, content)) ->
let tag = Types.atom_name tag in let tag = Types.AtomPool.value tag in
element_start tag element_start tag
(List.map (fun (n,v) -> (List.map (fun (n,v) ->
if not (is_str v) then raise exn_print_xml; if not (is_str v) then raise exn_print_xml;
(Types.label_name n,get_string v)) attrs); (Types.LabelPool.value n,get_string v)) attrs);
print_content content; print_content content;
element_end tag element_end tag
| Char x -> | Char x ->
......
...@@ -53,7 +53,7 @@ let rec print ppf v = ...@@ -53,7 +53,7 @@ let rec print ppf v =
else match v with else match v with
| Pair (x,y) -> Format.fprintf ppf "(%a,%a)" print x print y | Pair (x,y) -> Format.fprintf ppf "(%a,%a)" print x print y
| Record l -> Format.fprintf ppf "{%a }" print_record l | Record l -> Format.fprintf ppf "{%a }" print_record l
| Atom a -> Format.fprintf ppf "`%s" (Types.atom_name a) | Atom a -> Format.fprintf ppf "`%s" (Types.AtomPool.value a)
| 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)
| Char c -> Chars.Unichar.print ppf c | Char c -> Chars.Unichar.print ppf c
| Abstraction _ -> Format.fprintf ppf "<fun>" | Abstraction _ -> Format.fprintf ppf "<fun>"
...@@ -89,7 +89,7 @@ and print_str ppf = function ...@@ -89,7 +89,7 @@ and print_str ppf = function
and print_xml ppf = function and print_xml ppf = function
| Pair(Atom tag, Pair (Record attr,content)) -> | Pair(Atom tag, Pair (Record attr,content)) ->
Format.fprintf ppf "@[<hv2><%s%a>[@ %a@]]" Format.fprintf ppf "@[<hv2><%s%a>[@ %a@]]"
(Types.atom_name tag) (Types.AtomPool.value tag)
print_record attr print_record attr
print_seq content print_seq content
| _ -> assert false | _ -> assert false
...@@ -100,7 +100,7 @@ and print_record ppf = function ...@@ -100,7 +100,7 @@ and print_record ppf = function
| f :: rem -> Format.fprintf ppf " %a;%a" print_field f print_record rem | f :: rem -> Format.fprintf ppf " %a;%a" print_field f print_record rem
and print_field ppf (l,v) = and print_field ppf (l,v) =
Format.fprintf ppf "%s=%a" (Types.label_name l) print v Format.fprintf ppf "%s=%a" (Types.LabelPool.value l) print v
let normalize = function let normalize = function
......
...@@ -701,16 +701,15 @@ struct ...@@ -701,16 +701,15 @@ struct
return disp pl aux_final return disp pl aux_final
let dummy_label = Types.label "" let dummy_label = Types.LabelPool.dummy_max
let collect_first_label pl = let collect_first_label pl =
let f = ref true and m = ref dummy_label in let f = ref true and m = ref dummy_label in
let aux = function let aux = function
| (res, _, `Label (l, _, _)) -> | (res, _, `Label (l, _, _)) -> if (l < !m) then m:= l;
if (!f) then (f := false; m := l) else if (l < !m) then m:= l;
| _ -> () in | _ -> () in
Array.iter (List.iter aux) pl; Array.iter (List.iter aux) pl;
if !f then None else Some !m if !m = dummy_label then None else Some !m
let map_record f = let map_record f =
let rec aux = function let rec aux = function
...@@ -738,7 +737,7 @@ struct ...@@ -738,7 +737,7 @@ struct
| `Success -> Format.fprintf ppf "Success" | `Success -> Format.fprintf ppf "Success"
| `Fail -> Format.fprintf ppf "Fail" | `Fail -> Format.fprintf ppf "Fail"
| `Label (l,pr,ab) -> | `Label (l,pr,ab) ->
Format.fprintf ppf "Label (%s,pr=%a,ab=%a)" (Types.label_name l) Format.fprintf ppf "Label (%s,pr=%a,ab=%a)" (Types.LabelPool.value l)
print_normal_record_pr pr print_normal_record_pr pr
print_normal_record ab print_normal_record ab
| _ -> assert false | _ -> assert false
...@@ -756,7 +755,7 @@ struct ...@@ -756,7 +755,7 @@ struct
List.iter (fun (x,s) -> Format.fprintf ppf "%s," x) res; List.iter (fun (x,s) -> Format.fprintf ppf "%s," x) res;
Format.fprintf ppf "Catch:"; Format.fprintf ppf "Catch:";
List.iter (fun (l,r) -> List.iter (fun (l,r) ->
Format.fprintf ppf "%s[" (Types.label_name l); Format.fprintf ppf "%s[" (Types.LabelPool.value l);
List.iter (fun (x,i) -> List.iter (fun (x,i) ->
Format.fprintf ppf "%s->%i" x i) r; Format.fprintf ppf "%s->%i" x i) r;
Format.fprintf ppf "]" Format.fprintf ppf "]"
...@@ -852,14 +851,14 @@ struct ...@@ -852,14 +851,14 @@ struct
| `Const c -> Types.Print.print_const ppf c | `Const c -> Types.Print.print_const ppf c
| `Left (-1) -> Format.fprintf ppf "v1" | `Left (-1) -> Format.fprintf ppf "v1"
| `Right (-1) -> Format.fprintf ppf "v2" | `Right (-1) -> Format.fprintf ppf "v2"
| `Field (l,-1) -> Format.fprintf ppf "v%s" (Types.label_name l) | `Field (l,-1) -> Format.fprintf ppf "v%s" (Types.LabelPool.value l)
| `Left i -> Format.fprintf ppf "l%i" i | `Left i -> Format.fprintf ppf "l%i" i
| `Right j -> Format.fprintf ppf "r%i" j | `Right j -> Format.fprintf ppf "r%i" j
| `Recompose (i,j) -> | `Recompose (i,j) ->
Format.fprintf ppf "(%a,%a)" Format.fprintf ppf "(%a,%a)"
print_source (`Left i) print_source (`Left i)
print_source (`Right j) print_source (`Right j)
| `Field (l,i) -> Format.fprintf ppf "%s%i" (Types.label_name l) i | `Field (l,i) -> Format.fprintf ppf "%s%i" (Types.LabelPool.value l) i
let print_result ppf = let print_result ppf =
Array.iteri Array.iteri
...@@ -936,7 +935,7 @@ struct ...@@ -936,7 +935,7 @@ struct
| `Result r -> print_ret ppf r | `Result r -> print_ret ppf r
| `Absent -> Format.fprintf ppf "Jump to Absent" | `Absent -> Format.fprintf ppf "Jump to Absent"
| `Label (l, present, absent) -> | `Label (l, present, absent) ->
let l = Types.label_name l in let l = Types.LabelPool.value l in
Format.fprintf ppf "check label %s:@\n" l; Format.fprintf ppf "check label %s:@\n" l;
Format.fprintf ppf "Present => @[%a@]@\n" (print_present l) present; Format.fprintf ppf "Present => @[%a@]@\n" (print_present l) present;
match absent with match absent with
......
let nil_atom = Types.mk_atom "nil" let nil_atom = Types.AtomPool.mk "nil"
let nil_type = Types.atom (Atoms.atom nil_atom) let nil_type = Types.atom (Atoms.atom nil_atom)
let decompose t = let decompose t =
......
...@@ -5,27 +5,18 @@ open Printf ...@@ -5,27 +5,18 @@ open Printf
let map_sort f l = let map_sort f l =
SortedList.from_list (List.map f l) SortedList.from_list (List.map f l)
type label = int module HashedString =
type atom = int struct
type t = string
let counter_label = ref 0 let hash = Hashtbl.hash
let label_table = Hashtbl.create 63 let equal = (=)
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
let mk_atom = label module LabelPool = Pool.Make(HashedString)
module AtomPool = Pool.Make(HashedString)
let atom_name = label_name type label = LabelPool.t
type atom = AtomPool.t
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
...@@ -168,7 +159,8 @@ let cons d = ...@@ -168,7 +159,8 @@ let cons d =
module Print = module Print =
struct struct
let print_atom ppf a = Format.fprintf ppf "`%s" (atom_name a) let print_atom ppf a =
Format.fprintf ppf "`%s" (AtomPool.value a)
let print_const ppf = function let print_const ppf = function
| 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)
...@@ -245,7 +237,7 @@ struct ...@@ -245,7 +237,7 @@ struct
Format.fprintf ppf "@[(%a -> %a)@]" print t1 print t2 Format.fprintf ppf "@[(%a -> %a)@]" print t1 print t2
and print_record ppf (l,o,t) = and print_record ppf (l,o,t) =
Format.fprintf ppf "@[{ %s =%s %a }@]" Format.fprintf ppf "@[{ %s =%s %a }@]"
(label_name l) (if o then "?" else "") print t (LabelPool.value l) (if o then "?" else "") print t
let end_print ppf = let end_print ppf =
...@@ -431,14 +423,13 @@ type t = ...@@ -431,14 +423,13 @@ type t =
| Record of (label * t) list | Record of (label * t) list
| Fun of (node * node) list | Fun of (node * node) list
let rec gen_atom i l =
if SortedList.mem l i then gen_atom (succ i) l else i
let rec sample_rec memo d = let rec sample_rec memo d =
if (Assumptions.mem d memo) || (is_empty d) then raise Not_found if (Assumptions.mem d memo) || (is_empty d) then raise Not_found
else else
try Int (Intervals.sample d.ints) with Not_found -> try Int (Intervals.sample d.ints) with Not_found ->
try Atom (Atoms.sample (gen_atom 0) d.atoms) with Not_found -> try Atom (Atoms.sample (fun _ -> AtomPool.dummy_min) d.atoms) with
Not_found ->
(* Here: could create a fresh atom ... *)
try Char (Chars.sample d.chars) with Not_found -> try Char (Chars.sample d.chars) with Not_found ->
try sample_rec_arrow d.arrow with Not_found -> try sample_rec_arrow d.arrow with Not_found ->
...@@ -506,7 +497,11 @@ let get x = sample_rec Assumptions.empty x ...@@ -506,7 +497,11 @@ let get x = sample_rec Assumptions.empty x
let rec print ppf = function let rec print ppf = function
| 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)
| Atom a -> Format.fprintf ppf "`%s" (atom_name a) | Atom a ->
if a = LabelPool.dummy_min then
Format.fprintf ppf "(almost any atom)"
else
Format.fprintf ppf "`%s" (AtomPool.value a)
| Char c -> Chars.Unichar.print ppf c | Char c -> Chars.Unichar.print ppf c
| Pair (x1,x2) -> Format.fprintf ppf "(%a,%a)" print x1 print x2 | Pair (x1,x2) -> Format.fprintf ppf "(%a,%a)" print x1 print x2
| Record r -> | Record r ->
...@@ -514,7 +509,7 @@ let get x = sample_rec Assumptions.empty x ...@@ -514,7 +509,7 @@ let get x = sample_rec Assumptions.empty x
(print_sep (print_sep
(fun ppf (l,x) -> (fun ppf (l,x) ->
Format.fprintf ppf "%s = %a" Format.fprintf ppf "%s = %a"
(label_name l) (LabelPool.value l)
print x print x
) )
" ; " " ; "
......
type label = int module LabelPool : Pool.T with type value = string
type atom = int module AtomPool : Pool.T with type value = string
type label = LabelPool.t
type atom = AtomPool.t
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
(** Algebra **) (** Algebra **)
...@@ -59,14 +61,6 @@ sig ...@@ -59,14 +61,6 @@ sig
val solve: v -> node val solve: v -> node
end end
(** Labels and atom names **)
val mk_atom : string -> atom
val atom_name : atom -> string
val label : string -> label
val label_name : label -> string
(** Normalization **) (** Normalization **)
module Product : sig module Product : sig
......
...@@ -154,9 +154,8 @@ module Regexp = struct ...@@ -154,9 +154,8 @@ module Regexp = struct
v v
let atom_nil = Types.mk_atom "nil"
let constant_nil v t