From 812c611bdc8532b7cd25d9368a8356be3eb1d34a Mon Sep 17 00:00:00 2001 From: Regis-Gianas Date: Thu, 30 Oct 2014 22:13:21 +0100 Subject: Xml_datatype.gxml: New type for semi-structured documents. Xml_parser, Xml_printer: Use it. --- lib/xml_parser.ml | 93 +++++++++++++++++++++++++++---------------------------- 1 file changed, 46 insertions(+), 47 deletions(-) (limited to 'lib/xml_parser.ml') diff --git a/lib/xml_parser.ml b/lib/xml_parser.ml index b9990c75a..f3283c659 100644 --- a/lib/xml_parser.ml +++ b/lib/xml_parser.ml @@ -19,10 +19,9 @@ *) open Printf +open Xml_datatype -type xml = Xml_datatype.xml = - | Element of (string * (string * string) list * xml list) - | PCData of string +type xml = Xml_datatype.xml type error_pos = { eline : int; @@ -81,8 +80,8 @@ let is_blank s = !i = len let _raises e f = - xml_error := e; - file_not_found := f + xml_error := e; + file_not_found := f let make source = let source = match source with @@ -101,14 +100,14 @@ let make source = let check_eof p v = p.check_eof <- v let pop s = - try - Stack.pop s.stack - with - Stack.Empty -> - Xml_lexer.token s.source + try + Stack.pop s.stack + with + Stack.Empty -> + Xml_lexer.token s.source let push t s = - Stack.push t s.stack + Stack.push t s.stack let canonicalize l = let has_elt = List.exists (function Element _ -> true | _ -> false) l in @@ -116,19 +115,19 @@ let canonicalize l = else l let rec read_node s = - match pop s with - | Xml_lexer.PCData s -> PCData s - | Xml_lexer.Tag (tag, attr, true) -> Element (tag, attr, []) - | Xml_lexer.Tag (tag, attr, false) -> + match pop s with + | Xml_lexer.PCData s -> PCData s + | Xml_lexer.Tag (tag, attr, true) -> Element (tag, attr, []) + | Xml_lexer.Tag (tag, attr, false) -> let elements = read_elems tag s in Element (tag, attr, canonicalize elements) - | t -> - push t s; - raise NoMoreData + | t -> + push t s; + raise NoMoreData and - read_elems tag s = - let elems = ref [] in - (try + read_elems tag s = + let elems = ref [] in + (try while true do let node = read_node s in match node, !elems with @@ -137,11 +136,11 @@ and | _, l -> elems := node :: l done - with - NoMoreData -> ()); - match pop s with - | Xml_lexer.Endtag s when s = tag -> List.rev !elems - | t -> raise (Internal_error (EndOfTagExpected tag)) + with + NoMoreData -> ()); + match pop s with + | Xml_lexer.Endtag s when s = tag -> List.rev !elems + | t -> raise (Internal_error (EndOfTagExpected tag)) let rec read_xml s = let node = read_node s in @@ -152,14 +151,14 @@ let rec read_xml s = else raise (Xml_lexer.Error Xml_lexer.ENodeExpected) let convert = function - | Xml_lexer.EUnterminatedComment -> UnterminatedComment - | Xml_lexer.EUnterminatedString -> UnterminatedString - | Xml_lexer.EIdentExpected -> IdentExpected - | Xml_lexer.ECloseExpected -> CloseExpected - | Xml_lexer.ENodeExpected -> NodeExpected - | Xml_lexer.EAttributeNameExpected -> AttributeNameExpected - | Xml_lexer.EAttributeValueExpected -> AttributeValueExpected - | Xml_lexer.EUnterminatedEntity -> UnterminatedEntity + | Xml_lexer.EUnterminatedComment -> UnterminatedComment + | Xml_lexer.EUnterminatedString -> UnterminatedString + | Xml_lexer.EIdentExpected -> IdentExpected + | Xml_lexer.ECloseExpected -> CloseExpected + | Xml_lexer.ENodeExpected -> NodeExpected + | Xml_lexer.EAttributeNameExpected -> AttributeNameExpected + | Xml_lexer.EAttributeValueExpected -> AttributeValueExpected + | Xml_lexer.EUnterminatedEntity -> UnterminatedEntity let error_of_exn xparser = function | NoMoreData when pop xparser = Xml_lexer.Eof -> Empty @@ -171,15 +170,15 @@ let error_of_exn xparser = function raise e let do_parse xparser = - try - Xml_lexer.init xparser.source; - let x = read_xml xparser in - if xparser.check_eof && pop xparser <> Xml_lexer.Eof then raise (Internal_error EOFExpected); - Xml_lexer.close (); - x - with any -> - Xml_lexer.close (); - raise (!xml_error (error_of_exn xparser any) xparser.source) + try + Xml_lexer.init xparser.source; + let x = read_xml xparser in + if xparser.check_eof && pop xparser <> Xml_lexer.Eof then raise (Internal_error EOFExpected); + Xml_lexer.close (); + x + with any -> + Xml_lexer.close (); + raise (!xml_error (error_of_exn xparser any) xparser.source) let parse p = do_parse p @@ -194,17 +193,17 @@ let error_msg = function | AttributeValueExpected -> "Attribute value expected" | EndOfTagExpected tag -> sprintf "End of tag expected : '%s'" tag | EOFExpected -> "End of file expected" - | Empty -> "Empty" + | Empty -> "Empty" let error (msg,pos) = if pos.emin = pos.emax then sprintf "%s line %d character %d" (error_msg msg) pos.eline (pos.emin - pos.eline_start) else sprintf "%s line %d characters %d-%d" (error_msg msg) pos.eline (pos.emin - pos.eline_start) (pos.emax - pos.eline_start) - + let line e = e.eline -let range e = +let range e = e.emin - e.eline_start , e.emax - e.eline_start let abs_range e = @@ -219,7 +218,7 @@ let pos source = emax = max; } -let () = _raises (fun x p -> +let () = _raises (fun x p -> (* local cast : Xml.error_msg -> error_msg *) Error (x, pos p)) (fun f -> File_not_found f) -- cgit v1.2.3