Preliminary support for markup backend (and support for html5 in load_xml).

backend/native/cduce_markup.empty.ml

+let use () = ()
\ No newline at end of file

backend/native/cduce_markup.mli

+val use : unit -> unit
\ No newline at end of file

backend/native/cduce_markup.real.ml

+open Markup
+open Cduce_core
+
+let ends_with s pat =
+  let ls = String.length s in
+  let lpat = String.length pat in
+  ls >= lpat && pat = String.sub s (ls-lpat) lpat
+
+let markup_load_xml otag ctag text s =
+  let stream, close =
+    if Url.is_url s then (string (Url.load_url s), ignore) else file s
+  in
+  let resolver = ref (fun _ -> None) in
+  let () = if ends_with s ".xhtml" then resolver := xhtml_entity in
+  let parser =
+    parse_xml
+      ~entity:(fun s -> match !resolver s with None -> Some "" | x -> x)
+      ~report:(fun location e ->
+        Cduce_loc.raise_generic
+          (Format.sprintf "load_xml: '%s': %s" s (Error.to_string ~location e)))
+      ~context:`Document stream
+  in
+  iter (fun signal -> match signal with
+    `Start_element ((_, tag), atts) ->
+      if tag = "xhtml" then resolver := xhtml_entity;
+      otag tag (List.map (fun ((_, tag),v) -> (tag, v)) atts);
+    |`End_element -> ctag ""
+    |`Text ls -> List.iter text ls
+    | _ -> ()
+  ) (signals parser);
+  close ()
+
+  let markup_load_html otag ctag text s =
+    let stream, close =
+      if Url.is_url s then (string (Url.load_url s), ignore) else file s
+    in
+    let parser =
+      parse_html
+        ~report:(fun _ _ -> ())
+        ~context:`Document stream
+    in
+    iter (fun signal -> match signal with
+      `Start_element ((_, tag), atts) ->
+        otag tag (List.map (fun ((_, tag),v) -> (tag, v)) atts);
+      |`End_element -> ctag ""
+      |`Text ls -> List.iter text ls
+      | _ -> ()
+    ) (signals parser);
+    close ()
+  
+
+let use () =
+  let open Load_xml in 
+  xml_parser := (markup_load_xml start_element_handler end_element_handler text_handler);
+  html_loader := (mk_load_xml (markup_load_html start_element_handler end_element_handler text_handler) ~ns:true )
+
+let  () =
+  Cduce_config.register ~priority:2 
+  "markup" "Markup.ml XML and HTML parser"
+  use
\ No newline at end of file

backend/native/dune

@@ -20,6 +20,11 @@
    from
    (expat -> cduce_expat.real.ml)
    (-> cduce_expat.empty.ml))
+  (select
+   cduce_markup.ml
+   from
+   (markup -> cduce_markup.real.ml)
+   (-> cduce_markup.empty.ml))
   ;Trickery to only include threads library when netstring is present
   (select
    fake_cduce_netclient.ml

cduce.opam

@@ -38,7 +38,8 @@ depends: [
   ("ocurl" { >= "0.9.1" } |
    "ocamlnet" { >= "4.1.8"})
   ("ocaml-expat" {>= "1.1.0" } |
-   "pxp" {>= "1.2.9"})
+   "pxp" {>= "1.2.9"} |
+   "markup" {>= "1.0.0-1"})
 ]
 depopts: [
   "ocaml-compiler-libs" {>= "v0.9.0"}

cduce.opam.template

@@ -8,7 +8,8 @@ depends: [
   ("ocurl" { >= "0.9.1" } |
    "ocamlnet" { >= "4.1.8"})
   ("ocaml-expat" {>= "1.1.0" } |
-   "pxp" {>= "1.2.9"})
+   "pxp" {>= "1.2.9"} |
+   "markup" {>= "1.0.0-1"})
 ]
 depopts: [
   "ocaml-compiler-libs" {>= "v0.9.0"}

lang/runtime/load_xml.ml

@@ -70,7 +70,7 @@ let rec create_elt accu = function
       ns_table := old_table
   | Empty -> assert false
 
-let start_element_handler name att =
+let start_element_handler name att =  
   if not (only_ws txt.buffer txt.pos) then
     stack := String (Bytes.sub_string txt.buffer 0 txt.pos, !stack);
   txt.pos <- 0;
@@ -94,11 +94,11 @@ let text_handler = add_string txt
 let xml_parser = ref (fun s -> failwith "No XML parser available")
 
 
-let load_xml ?(ns=false) s =
+let mk_load_xml parser ?(ns=false)  s =
   try
     H.clear subst_ns;
     keep_ns := ns;
-    !xml_parser s;
+    parser s;
     match !stack with
       | Element (x,Empty) -> stack := Empty; x
       | _ -> Value.failwith' "No XML stream to parse"
@@ -108,6 +108,8 @@ let load_xml ?(ns=false) s =
 	("Unknown namespace prefix: " ^ (U.get_str n))
       | e -> raise e
 
+let load_xml ?(ns=false) s = mk_load_xml !xml_parser ~ns s
+
 let load_xml_subst ?(ns=false) s subst =
   H.clear subst_ns;
   List.iter (fun (k,v) -> H.replace subst_ns k v) subst;

lang/runtime/load_xml.mli

@@ -14,6 +14,8 @@ val only_ws : bytes -> int -> bool
 
 val load_xml : ?ns:bool -> string -> Value.t
 
+val mk_load_xml : (string -> unit) -> ?ns:bool -> string -> Value.t
+
 val load_xml_subst : ?ns:bool -> string -> (Ns.Uri.t * Ns.Uri.t) list -> Value.t
 
 val html_loader : (string -> Value.t) ref

types/misc/ns.ml

@@ -28,6 +28,9 @@ let xml_ns_str = "http://www.w3.org/XML/1998/namespace"
 
 let xml_ns = Uri.mk (U.mk xml_ns_str)
 
+let xmlns_ns_str = "http://www.w3.org/2000/xmlns/"
+let xmlns_ns = Uri.mk (U.mk xmlns_ns_str)
+
 let xsd_ns = Uri.mk (U.mk "http://www.w3.org/2001/XMLSchema")
 
 let xsi_ns = Uri.mk (U.mk "http://www.w3.org/2001/XMLSchema-instance")
@@ -41,7 +44,10 @@ type table = Uri.t Table.t
 
 let mktbl = List.fold_left (fun table (pr, ns) -> Table.add (U.mk pr) ns table)
 
-let empty_table = mktbl Table.empty [ ("", empty); ("xml", xml_ns) ]
+let empty_table = mktbl Table.empty [ ("", empty); ("xml", xml_ns);
+         ("xmlns", xmlns_ns);
+         (xmlns_ns_str, xmlns_ns)
+         ]
 
 let def_table = mktbl empty_table [ ("xsd", xsd_ns); ("xsi", xsi_ns) ]
 
@@ -128,7 +134,7 @@ module Printer = struct
       p.prefixes <- (pr, ns) :: p.prefixes
 
   let register_ns p ns =
-    if ns == xml_ns then ()
+    if ns == xml_ns || ns == xmlns_ns then ()
     else
       match get_prefix p ns with
       | { contents = Hint l } as r ->
@@ -144,6 +150,7 @@ module Printer = struct
   let tag p (ns, l) =
     let l = U.get_str l in
     if ns == xml_ns then "xml:" ^ l
+    else if ns == xmlns_ns then "xmlns:" ^ l
     else
       match !(get_prefix p ns) with
       | Set pr ->
@@ -154,6 +161,7 @@ module Printer = struct
   let attr p (ns, l) =
     let l = U.get_str l in
     if ns == xml_ns then "xml:" ^ l
+    else if ns == xmlns_ns then "xmlns:" ^ l 
     else if ns == empty then l
     else
       match !(get_prefix p ns) with