Commit 9b9bfb6c authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2004-12-26 19:49:35 by afrisch] Empty log message

Original author: afrisch
Date: 2004-12-26 19:49:35+00:00
parent d31d436c
......@@ -58,7 +58,6 @@ and run_disp_kind pt fail actions = function
actions.basic
| Absent ->
run_disp_basic pt fail (fun t -> Types.Record.has_absent t) actions.basic
| Delayed _ -> assert false
| v ->
run_disp_kind pt fail actions (normalize v)
......
......@@ -149,12 +149,13 @@ let make_result_string_utf8 i j s q r1 r2 (code,r) =
let rec run_disp_basic v f = function
| [(_,r)] -> make_result_basic v r
| (t,r)::rem -> if f t then make_result_basic v r else run_disp_basic v f rem
| _ -> assert false
| _ ->
Format.fprintf Format.std_formatter "ERR: %a@." Value.print v;
assert false
let rec run_dispatcher d v =
(*
Format.fprintf Format.std_formatter "Matching (%a) with:@\n" Value.print v;
Patterns.Compile.print_dispatcher Format.std_formatter d;
(* Format.fprintf Format.std_formatter "Matching (%a) with:@." Value.print v; *)
(* Patterns.Compile.print_dispatcher Format.std_formatter d;
*)
match actions d with
| AIgnore r -> make_result_basic v r
......@@ -166,11 +167,11 @@ and run_disp_kind actions v =
| Xml (v1,v2,v3) -> run_disp_prod v v1 (Pair (v2,v3)) actions.xml
| Record r -> run_disp_record false v (LabelMap.get r) actions.record
| String_latin1 (i,j,s,q) ->
(* run_disp_kind actions (Value.normalize v) *)
run_disp_string_latin1 i j s q actions
(* run_disp_kind actions (Value.normalize v) *)
run_disp_string_latin1 i j s q actions
| String_utf8 (i,j,s,q) ->
(* run_disp_kind actions (Value.normalize v) *)
run_disp_string_utf8 i j s q actions
(* run_disp_kind actions (Value.normalize v) *)
run_disp_string_utf8 i j s q actions
| Atom a -> make_result_basic v (Atoms.get_map a actions.atoms)
| Char c -> make_result_basic v (Chars.get_map c actions.chars)
| Integer i ->
......@@ -185,8 +186,6 @@ and run_disp_kind actions v =
| Absent ->
run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
| Concat (_,_) as v -> run_disp_kind actions (Value.normalize v)
| Delayed _ -> assert false
and run_disp_prod v v1 v2 = function
| Impossible -> assert false
......@@ -272,13 +271,16 @@ and run_disp_string_latin1_2 r1 i j s q = function
let code2 = run_disp_string_latin1_loop i j s q d2 in
make_result_string_latin1 i j s q r1 r2 b2.(code2)
and run_disp_string_latin1_loop i j s q d =
let i = succ i in
if i == j then run_dispatcher d q else
match actions d with
| AIgnore r -> make_result_basic Absent r
| AKind k -> run_disp_string_latin1 (succ i) j s q k
| AIgnore r -> make_result_basic (Value.String_latin1 (i,j,s,q)) r
| AKind k -> run_disp_string_latin1 i j s q k
and run_disp_string_utf8 i j s q actions =
if Utf8.equal_index i j then run_disp_kind actions q
else match actions.prod with
if Utf8.equal_index i j then run_disp_kind actions q
else
match actions.prod with
| Impossible -> assert false
| TailCall d1 -> run_disp_string_utf8_char d1 (Chars.V.mk_int (Utf8.get s i))
| Ignore d2 -> run_disp_string_utf8_2 !cursor i j s q d2
......@@ -300,9 +302,11 @@ and run_disp_string_utf8_2 r1 i j s q = function
let code2 = run_disp_string_utf8_loop i j s q d2 in
make_result_string_utf8 i j s q r1 r2 b2.(code2)
and run_disp_string_utf8_loop i j s q d =
let i = Utf8.advance s i in
if Utf8.equal_index i j then run_dispatcher d q else
match actions d with
| AIgnore r -> make_result_basic Absent r
| AKind k -> run_disp_string_utf8 (Utf8.advance s i) j s q k
| AIgnore r -> make_result_basic (Value.String_utf8 (i,j,s,q)) r
| AKind k -> run_disp_string_utf8 i j s q k
let run_dispatcher d v =
let code = run_dispatcher d v in
......@@ -446,7 +450,6 @@ and run_disp_kind actions v =
| Absent ->
run_disp_basic v (fun t -> Types.Record.has_absent t) actions.basic
| Concat (_,_) as v -> run_disp_kind actions (Value.normalize v)
| Delayed _ -> assert false
and run_disp_prod v v1 v2 = function
......
......@@ -16,8 +16,6 @@ type t =
| Concat of t * t
| Absent
| Delayed of t ref
(*
The only representation of the empty sequence is nil.
In particular, in String_latin1 and String_utf8, the string cannot be empty.
......@@ -268,8 +266,6 @@ let rec print ppf v =
Format.fprintf ppf "<abstract=%s>" s
| Absent ->
Format.fprintf ppf "<[absent]>"
| Delayed x ->
Format.fprintf ppf "<[delayed]>"
and print_quoted_str ppf = function
| Pair (Char c, q) ->
Chars.V.print_in_string ppf c;
......@@ -378,9 +374,6 @@ let dump_xml ppf v =
| Absent ->
Format.fprintf ppf "@[<hv1>";
Format.fprintf ppf "<absent />@]"
| Delayed _ ->
Format.fprintf ppf "@[<hv1>";
Format.fprintf ppf "<delayed />@]"
in
Format.fprintf ppf "@[<hv1>";
Format.fprintf ppf "<value>@,%a@,</value>@]" aux v
......@@ -408,8 +401,10 @@ let rec compare x y =
| Abstract (s1,v1), Abstract (s2,v2) ->
let c = Types.Abstract.T.compare s1 s2 in if c <> 0 then c
else raise (CDuceExn (string_latin1 "comparing abstract values"))
| Absent,_ | _,Absent
| Delayed _, _ | _, Delayed _ -> assert false
| Absent,_ | _,Absent ->
Format.fprintf Format.std_formatter
"ERR: Compare %a %a@." print x print y;
assert false
| Concat (_,_) as x, y -> eval_lazy_concat x; compare x y
| x, (Concat (_,_) as y) -> eval_lazy_concat y; compare x y
| String_latin1 (ix,jx,sx,qx), String_latin1 (iy,jy,sy,qy) ->
......
......@@ -21,9 +21,6 @@ type t =
(* Special value for absent record fields, and failed pattern matching *)
| Absent
(* Only in evaluation environment *)
| Delayed of t ref
module ValueSet: Set.S with type elt = t
exception CDuceExn of t
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment