/[svn]/cduce/trunk/runtime/load_xml.ml
ViewVC logotype

Diff of /cduce/trunk/runtime/load_xml.ml

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

revision 541 by abate, Tue Jul 10 17:42:07 2007 UTC revision 542 by abate, Tue Jul 10 17:43:11 2007 UTC
# Line 48  Line 48 
48    
49    
50  let attrib att =  let attrib att =
51    let att = List.map (fun (l,v) -> LabelPool.mk (U.mk l), string v nil) att in    (* TODO: better error message *)
52    LabelMap.from_list (fun _ _ -> assert false) att    let att = List.map (fun (n,v) -> LabelPool.mk n, string_utf8 v) att in
53      LabelMap.from_list (fun _ _ -> failwith "Invalid XML document: uniqueness of attributes") att
54    
55  let elem tag att child =  let elem (tag_ns,tag) att child =
56    Xml (Atom (Atoms.mk Atoms.Ns.empty (U.mk tag)), Record (attrib att), child)    Xml (Atom (Atoms.mk tag_ns tag), Record (attrib att), child)
57    
58  (*  (*
59  class warner = object method warn w =  print_endline ("PXP WARNING: " ^ w) end  class warner = object method warn w =  print_endline ("PXP WARNING: " ^ w) end
# Line 60  Line 61 
61    
62  type token =  type token =
63    | Element of Value.t    | Element of Value.t
64    | Start of string * (string * string) list    | Start of Ns.qname * (Ns.qname * Utf8.t) list * Ns.table
65    | String of string    | String of string
66    
67  let stack = ref []  let stack = ref []
68    let ns_table = ref Ns.empty_table
69    
70  let rec create_elt accu = function  let rec create_elt accu = function
71    | String s :: st -> create_elt (string s accu) st    | String s :: st -> create_elt (string s accu) st
72    | Element x :: st -> create_elt (Pair (x,accu)) st    | Element x :: st -> create_elt (Pair (x,accu)) st
73    | Start (name,att) :: st -> stack := Element (elem name att accu) :: st    | Start (name,att,table) :: st ->
74          stack := Element (elem name att accu) :: st;
75          ns_table := table
76    | [] -> assert false    | [] -> assert false
77    
   
   
78  let start_element_handler name att =  let start_element_handler name att =
79    if not (only_ws txt.buffer txt.pos) then    if not (only_ws txt.buffer txt.pos) then
80      stack := String (String.sub txt.buffer 0 txt.pos) :: !stack;      stack := String (String.sub txt.buffer 0 txt.pos) :: !stack;
81    txt.pos <- 0;    txt.pos <- 0;
82    stack := Start (name,att) :: !stack  
83      let (table,name,att) = Ns.process_start_tag !ns_table name att in
84      stack := Start (name,att,!ns_table) :: !stack;
85      ns_table := table
86    
87  let end_element_handler _ =  let end_element_handler _ =
88    let accu =    let accu =
# Line 171  Line 176 
176      | Nethtml.Data data ->      | Nethtml.Data data ->
177          if (only_ws data (String.length data)) then q else string data q          if (only_ws data (String.length data)) then q else string data q
178      | Nethtml.Element (tag, att, child) ->      | Nethtml.Element (tag, att, child) ->
179          Pair (elem tag att (val_of_docs child), q)          let att = List.map (fun (n,v) -> ((Ns.empty, U.mk n), U.mk v)) att in
180            Pair (elem (Ns.empty,U.mk tag) att (val_of_docs child), q)
181    and val_of_docs = function    and val_of_docs = function
182      | [] -> nil      | [] -> nil
183      | h::t -> val_of_doc (val_of_docs t) h      | h::t -> val_of_doc (val_of_docs t) h
Legend:
Removed from v.541  
changed lines
  Added in v.542
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5