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