~ubuntu-branches/ubuntu/hardy/pxp/hardy

« back to all changes in this revision

Viewing changes to examples/pullparser/pull.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stefano Zacchiroli
  • Date: 2005-03-29 11:06:39 UTC
  • mfrom: (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050329110639-5p39hz1d4aq3r2ec
Tags: 1.1.95-6
* Rebuilt against ocaml 3.08.3
* No longer built with wlex support (since wlex is no longer supported
  upstream and corresponding package has been removed from the debian
  archive)

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(* $Id: pull.ml 662 2004-05-25 20:57:28Z gerd $
 
2
 * ----------------------------------------------------------------------
 
3
 *
 
4
 *)
 
5
 
 
6
(**********************************************************************)
 
7
(* Examples for pull parsing                                          *)
 
8
(**********************************************************************)
 
9
 
 
10
open Pxp_yacc
 
11
open Pxp_lexer_types
 
12
open Pxp_types
 
13
open Printf
 
14
 
 
15
 
 
16
(* dump_event: dumps a single parsing event *)
 
17
 
 
18
let dump_event =
 
19
  function
 
20
      E_start_doc(v,sa,dtd) ->
 
21
        printf "E_start_doc version=%s standalone=%b\n" v sa
 
22
    | E_end_doc ->
 
23
        printf "E_end_doc\n"
 
24
    | E_start_tag(name,attlist,_) ->
 
25
        printf "E_start_tag %s %s\n" name 
 
26
          (String.concat " " (List.map (fun (n,v) -> n ^ "=" ^ v) attlist))
 
27
    | E_end_tag(name,_) ->
 
28
        printf "E_end_tag %s\n" name
 
29
    | E_char_data data ->
 
30
        printf "E_char_data %s\n" data
 
31
    | E_pinstr(target,data) ->
 
32
        printf "E_pinstr %s %s\n" target data
 
33
    | E_comment data ->
 
34
        printf "E_comment %s\n" data
 
35
    | E_position(ent,line,col) ->
 
36
        printf "E_position %s line=%d col=%d\n" ent line col
 
37
    | E_error e ->
 
38
        printf "E_error %s\n" (Printexc.to_string e)
 
39
    | E_end_of_stream ->
 
40
        printf "E_end_of_stream\n"
 
41
;;
 
42
 
 
43
 
 
44
(* parse: prints the events while parsing the passed string *)
 
45
 
 
46
let parse s =
 
47
  let config = default_config in
 
48
  let mgr = create_entity_manager config (from_string s) in
 
49
  let next_event = 
 
50
    create_pull_parser config (`Entry_content[]) mgr in
 
51
  let event = ref (Some E_end_of_stream) in
 
52
  while !event <> None do
 
53
    event := next_event();
 
54
    match !event with
 
55
        Some e -> dump_event e
 
56
      | None -> ()
 
57
  done
 
58
;;
 
59
 
 
60
 
 
61
(* Stream parsers:
 
62
 * parse_list 
 
63
 *   "<list><cons><int>34</int><cons><int>67</int><nil/></cons></cons></list>"
 
64
 * = [34; 67]
 
65
 *)
 
66
 
 
67
let parse_list s =
 
68
 
 
69
  let rec parse_whole_list stream =
 
70
    match stream with parser
 
71
        [< 'E_start_tag("list",_,_);
 
72
           l = parse_sub_list;
 
73
           'E_end_tag("list",_);
 
74
           'E_end_of_stream;
 
75
        >] ->
 
76
          l
 
77
 
 
78
  and parse_sub_list stream =
 
79
    match stream with parser
 
80
        [< 'E_start_tag("cons",_,_); 
 
81
           head = parse_object;
 
82
           tail = parse_sub_list;
 
83
           'E_end_tag("cons",_)
 
84
        >] ->
 
85
          head :: tail
 
86
          
 
87
      | [< 'E_start_tag("nil",_,_); 'E_end_tag("nil",_) >] ->
 
88
          []
 
89
 
 
90
  and parse_object stream =
 
91
    match stream with parser
 
92
        [< 'E_start_tag("int",_,_);
 
93
           number = parse_text;
 
94
           'E_end_tag("int",_)
 
95
        >] ->
 
96
          int_of_string number
 
97
 
 
98
  and parse_text stream =
 
99
    match stream with parser
 
100
        [< 'E_char_data data;
 
101
           rest = parse_text
 
102
        >] ->
 
103
          data ^ rest
 
104
      | [< >] ->
 
105
          ""
 
106
  in
 
107
  let config = 
 
108
    { default_config with
 
109
        store_element_positions = false;
 
110
          (* don't produce E_position events *)
 
111
    }
 
112
  in
 
113
  let mgr = create_entity_manager config (from_string s) in
 
114
  let next_event = 
 
115
    create_pull_parser config (`Entry_content[]) mgr in
 
116
  let next_event_or_error n =
 
117
    let e = next_event n in
 
118
    match e with
 
119
        Some(E_error exn) -> raise exn
 
120
      | _ -> e
 
121
  in
 
122
  let stream =
 
123
    Stream.from next_event_or_error in
 
124
  parse_whole_list stream
 
125
;;
 
126
 
 
127