Commit 034d095a authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-05-24 16:14:54 by cvscast] Optimize runtime representation of XML elements

Original author: cvscast
Date: 2003-05-24 16:14:54+00:00
parent 04187132
......@@ -55,7 +55,8 @@ let rec eval env e0 =
*)
| Typed.RecordLitt r -> Record (LabelMap.map (eval env) r)
| Typed.Pair (e1,e2) -> Pair (eval env e1, eval env e2)
| Typed.Xml (e1,e2) -> Xml (eval env e1, eval env e2)
| Typed.Xml (e1, { Typed.exp_descr = Typed.Pair (e2,e3) }) ->
Xml (eval env e1, eval env e2, eval env e3)
| Typed.Cst c -> const c
| Typed.Match (arg,brs) -> eval_branches env brs (eval env arg)
| Typed.Map (false,arg,brs) -> eval_map env brs (eval env arg)
......@@ -95,6 +96,7 @@ let rec eval env e0 =
| Typed.Dot (e, l) -> eval_dot l (eval env e)
| Typed.RemoveField (e, l) -> eval_remove_field l (eval env e)
| Typed.Op (o,_) -> failwith ("Unknown operator " ^ o)
| _ -> assert false
and eval_apply f arg = match f with
......@@ -157,10 +159,9 @@ and eval_xtrans env brs = function
(match eval_branches env brs x with
| Absent ->
let x = match x with
| Xml (tag, Pair (attr, child)) ->
| Xml (tag, attr, child) ->
let child = eval_xtrans env brs child in
Xml (tag, Pair (attr, child))
| Xml (_,_) -> assert false
Xml (tag, attr, child)
| x -> x in
let y = eval_xtrans env brs y in
Pair (x,y)
......
......@@ -47,7 +47,7 @@ let attrib att =
LabelMap.from_list (fun _ _ -> assert false) att
let elem tag att child =
Xml (Atom (Atoms.mk (U.mk tag)), Pair (Record (attrib att), child))
Xml (Atom (Atoms.mk (U.mk tag)), Record (attrib att), child)
(*
class warner = object method warn w = print_endline ("PXP WARNING: " ^ w) end
......
......@@ -42,7 +42,7 @@ let string_of_xml ~utf8 v=
in
let rec print_elt = function
| Xml (Atom tag, Pair (Record attrs, content)) ->
| Xml (Atom tag, Record attrs, content) ->
let tag = Atoms.value tag in
let attrs = LabelMap.mapi_to_list
(fun n v ->
......
......@@ -3,6 +3,7 @@
(* Possible simple optimizations:
- in make_result_prod, see if buffer can be simply overwritten
(precompute this ...)
- optimize for Xml elements (don't build the Pair (attr,content))
*)
(*
......@@ -154,7 +155,7 @@ let rec run_dispatcher d v =
and run_disp_kind actions v =
match v with
| Pair (v1,v2) -> run_disp_prod v v1 v2 actions.prod
| Xml (v1,v2) -> run_disp_prod v v1 v2 actions.xml
| 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_string_latin1 i j s q actions
| String_utf8 (i,j,s,q) -> run_disp_string_utf8 i j s q actions
......@@ -186,7 +187,7 @@ and run_disp_prod2 v1 r1 v v2 = function
let r2 = !cursor in
let code2 = run_dispatcher d2 v2 in
make_result_prod v1 r1 v2 r2 v b2.(code2)
and run_disp_record other v fields = function
| None -> assert false
| Some (RecLabel (l,d)) ->
......
......@@ -3,7 +3,7 @@ open Encodings
type t =
| Pair of t * t
| Xml of t * t
| Xml of t * t * t
| Record of t label_map
| Atom of Atoms.v
| Integer of Intervals.v
......@@ -94,7 +94,7 @@ let rec print ppf v =
else if is_seq v then Format.fprintf ppf "[ @[<hv>%a@]]" print_seq v
else match v with
| Pair (x,y) -> Format.fprintf ppf "(%a,%a)" print x print y
| Xml (x,y) -> print_xml ppf (x,y)
| Xml (x,y,z) -> print_xml ppf x y z
| Record l -> Format.fprintf ppf "{%a }" print_record (LabelMap.get l)
| Atom a -> Atoms.print_v ppf a
| Integer i -> Intervals.print_v ppf i
......@@ -140,13 +140,11 @@ and print_seq ppf = function
print_seq ppf y
| _ -> ()
and print_xml ppf = function
| (tag, Pair (attr,content)) ->
Format.fprintf ppf "@[<hv2><%a%a>[@ %a@]]"
print_tag tag
print_attr attr
print_seq content
| _ -> assert false
and print_xml ppf tag attr content =
Format.fprintf ppf "@[<hv2><%a%a>[@ %a@]]"
print_tag tag
print_attr attr
print_seq content
and print_tag ppf = function
| Atom tag -> Utf8.print ppf (Atoms.value tag)
| tag -> Format.fprintf ppf "(%a)" print tag
......@@ -182,9 +180,13 @@ let rec compare x y =
if (x == y) then 0
else
match (x,y) with
| Pair (x1,x2), Pair (y1,y2) | Xml (x1,x2), Xml (y1,y2) ->
| Pair (x1,x2), Pair (y1,y2) ->
let c = compare x1 y1 in if c <> 0 then c
else compare x2 y2
| Xml (x1,x2,x3), Xml (y1,y2,y3) ->
let c = compare x1 y1 in if c <> 0 then c
else let c = compare x1 y2 in if c <> 0 then c
else compare x3 y3
| Record rx, Record ry -> LabelMap.compare compare rx ry
| Atom x, Atom y -> Atoms.vcompare x y
| Integer x, Integer y -> Intervals.vcompare x y
......
......@@ -4,7 +4,7 @@ open Encodings
type t =
(* Canonical representation *)
| Pair of t * t
| Xml of t * t
| Xml of t * t * t
| Record of t label_map
| Atom of Atoms.v
| Integer of Intervals.v
......
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