1# -*- tcl -*-
2# -- $Id: reader_peg.tcl,v 1.1 2005/09/28 04:51:22 andreas_kupries Exp $ ---
3#
4# PAGE plugin - reader - PEG ~ Parsing Expression Grammar
5#
6
7# ### ### ### ######### ######### #########
8## Imported API
9
10# -----------------+--
11# page_read        | Access to the input stream.
12# page_read_done   |
13# page_eof         |
14# -----------------+--
15# page_info        | Reporting to the user.
16# page_warning     |
17# page_error       |
18# -----------------+--
19# page_log_error   | Reporting of internals.
20# page_log_warning |
21# page_log_info    |
22# -----------------+--
23
24# ### ### ### ######### ######### #########
25## Exported API
26
27# -----------------+--
28# page_rfeature    | Query for special plugin features page might wish to use.
29# page_rtime       | Activate collection of timing statistics.
30# page_rgettime    | Return the collected timing statistics.
31# page_rlabel      | User readable label for the plugin.
32# page_rhelp       | Doctools help text for plugin.
33# page_roptions    | Options understood by plugin.
34# page_rconfigure  | Option (re)configuration.
35# page_rdata       | External access to processed input stream.
36# page_rrun        | Process input stream per plugin configuration and hardwiring.
37# -----------------+--
38
39# ### ### ### ######### ######### #########
40## Requisites
41
42package require page::util::norm::peg ; # Normalize AST generated by reader of PEG grammars
43package require page::parse::peg      ; # Mengine based parser for PE grammars.
44package require struct::tree          ; # Data structure.
45package require grammar::me::util     ; # AST conversion
46
47global usec
48global timed
49set    timed 0
50
51global cline
52global ccol
53
54# ### ### ### ######### ######### #########
55## Implementation of exported API
56
57proc page_rlabel {} {
58    return {Parsing Expression Grammar}
59}
60
61proc page_rfeature {key} {
62    return [string eq $key timeable]
63}
64
65proc page_rtime {} {
66    global timed
67    set    timed 1
68    return
69}
70
71proc page_rgettime {} {
72    global  usec
73    return $usec
74}
75
76proc page_rhelp {} {
77    return {}
78}
79
80proc page_roptions {} {
81    return {}
82}
83
84proc page_rconfigure {option value} {
85    return -code error "Cannot set value of unknown option \"$option\""
86}
87
88## proc page_rdata {} {}
89## Created in 'Initialize'
90
91proc page_rrun {} {
92    global timed usec cline ccol
93    page_log_info "reader/peg/run/parse"
94
95    set ast {}
96    set err {}
97
98    # Location of the next character to be read.
99    set cline 1
100    set ccol  0
101
102    if {$timed} {
103	set usec [lindex [time {
104	    set ok [::page::parse::peg::parse ::Next err ast]
105	}] 0] ; #{}
106    } else {
107	set ok [::page::parse::peg::parse ::Next err ast]
108    }
109    page_read_done
110    page_log_info "reader/peg/run/check-for-errors"
111
112    if {!$ok} {
113	foreach {olc   messages} $err     break
114	foreach {offset linecol} $olc     break
115	foreach {line       col} $linecol break
116
117	set olc [string map {{ } _} \
118		[format %5d $line]]@[string map {{ } _} \
119		[format %3d $col]]/([format %5d $offset])
120
121	foreach m $messages {
122	    page_log_error "reader/peg/run: $olc: $m"
123	    page_error $m $linecol
124	}
125
126	page_log_info "reader/peg/run/failed"
127	return {}
128    }
129
130    page_log_info "reader/peg/run/ast-conversion"
131
132    struct::tree                        ::tree
133    ::grammar::me::util::ast2etree $ast ::grammar::me::tcl ::tree
134    ::page::util::norm::peg             ::tree
135
136    set ast [::tree serialize]
137    ::tree destroy
138
139    page_log_info "reader/peg/run/ok"
140    return $ast
141}
142
143# ### ### ### ######### ######### #########
144## Internal helper code.
145
146proc Next {} {
147    global cline ccol
148
149    if {[page_eof]} {return {}}
150
151    set ch [page_read 1]
152
153    if {$ch eq ""} {return {}}
154
155    set tok [list $ch {} $cline $ccol]
156
157    if {$ch eq "\n"} {
158	incr cline ; set ccol 0
159    } else {
160	incr ccol
161    }
162
163    return $tok
164}
165
166# ### ### ### ######### ######### #########
167## Initialization
168
169package provide page::reader::peg 0.1
170