1# -*- tcl -*- 2# 3# Copyright (c) 2005 by Andreas Kupries <andreas_kupries@users.sourceforge.net> 4# Parser Generator / Backend - PEG as Tcl script. 5 6# ### ### ### ######### ######### ######### 7## Requisites 8 9package require page::util::peg 10 11namespace eval ::page::gen::peg::cpkg { 12 # Get various utilities. 13 14 namespace import ::page::util::peg::* 15} 16 17# ### ### ### ######### ######### ######### 18## API 19 20proc ::page::gen::peg::cpkg {t chan} { 21 cpkg::printWarnings [cpkg::getWarnings $t] 22 23 set grname [$t get root name] 24 25 cpkg::Header $chan $grname 26 27 set gstart [$t get root start] 28 if {$gstart ne ""} { 29 set gstart [cpkg::peOf $t $gstart] 30 } else { 31 puts stderr "No start expression." 32 } 33 34 cpkg::Start $chan $gstart 35 36 set temp {} 37 set max -1 38 39 foreach {sym def} [$t get root definitions] { 40 set eroot [lindex [$t children $def] 0] 41 set l [string length [list $sym]] 42 if {$l > $max} {set max $l} 43 lappend temp \ 44 [list $sym [$t get $def mode] [cpkg::peOf $t $eroot] $l] 45 } 46 47 foreach e [lsort -dict -index 0 $temp] { 48 foreach {sym mode rule l} $e break 49 cpkg::Rule $chan $sym $mode $rule [expr {$max - $l}] 50 } 51 52 cpkg::Trailer $chan $grname 53 return 54} 55 56# ### ### ### ######### ######### ######### 57## Internal. Helpers 58 59proc ::page::gen::peg::cpkg::Header {chan grname} { 60 variable header 61 variable headerb 62 63 set stem [namespace tail $grname] 64 puts $chan [string map \ 65 [list \ 66 @@ [list $grname] \ 67 @stem@ [list $stem] \ 68 "\n\t" "\n" 69 ] \ 70 $header\n$headerb] 71} 72 73proc ::page::gen::peg::cpkg::Start {chan pe} { 74 puts $chan " Start [printTclExpr $pe]\n" 75 return 76} 77 78proc ::page::gen::peg::cpkg::Rule {chan sym mode pe off} { 79 variable ms 80 set off [string repeat " " $off] 81 puts $chan " Define $ms($mode) $sym$off [printTclExpr $pe]" 82 return 83} 84 85proc ::page::gen::peg::cpkg::Trailer {chan grname} { 86 variable trailer 87 variable trailerb 88 puts $chan [string map \ 89 [list \ 90 @@ [list $grname] \ 91 "\n\t" "\n" 92 ] \ 93 $trailer\n$trailerb] 94} 95 96# ### ### ### ######### ######### ######### 97## Internal. Strings. 98 99namespace eval ::page::gen::peg::cpkg { 100 variable ms ; array set ms { 101 value {value } 102 discard {discard} 103 match {match } 104 leaf {leaf } 105 } 106 variable header {# -*- tcl -*- 107 ## Parsing Expression Grammar '@@'. 108 109 # ### ### ### ######### ######### ######### 110 ## Package description 111 112 ## It provides a single command returning the handle of a 113 ## grammar container in which the grammar '@@' 114 ## is stored. The container is usable by a PEG interpreter 115 ## or other packages taking PE grammars. 116 117 # ### ### ### ######### ######### ######### 118 ## Requisites. 119 ## - PEG container type 120 121 package require grammar::peg 122 123 namespace eval ::@@ {} 124 125 # ### ### ### ######### ######### ######### 126 ## API 127 128 proc ::@@ {} { 129 return $@stem@::gr 130 } 131 132 # ### ### ### ######### ######### ######### 133 # ### ### ### ######### ######### ######### 134 ## Data and helpers. 135 136 namespace eval ::@@ { 137 # Grammar container 138 variable gr [::grammar::peg gr] 139 } 140 141 proc ::@@::Start {pe} { 142 variable gr 143 $gr start $pe 144 return 145 } 146 147 proc ::@@::Define {mode sym pe} { 148 variable gr 149 $gr nonterminal add $sym $pe 150 $gr nonterminal mode $sym $mode 151 return 152 } 153 154 # ### ### ### ######### ######### ######### 155 ## Initialization = Grammar definition 156 } 157 variable headerb "namespace eval ::@@ \{" 158 159 variable trailer "\}" 160 variable trailerb { 161 # ### ### ### ######### ######### ######### 162 ## Package Management - Ready 163 164 package provide @@ 0.1 165 } 166} 167 168# ### ### ### ######### ######### ######### 169## Ready 170 171package provide page::gen::peg::cpkg 0.1 172