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