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