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