blob: 7389604ed6b343ead10c03acb87fc5c70045c317 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
#!/usr/bin/env tclsh
# -*- tcl -*-
package require Tcl 8.5
# activate commands below for execution from within the pt directory
set self [file normalize [info script]]
set selfdir [file dirname $self]
lappend auto_path $selfdir [file dirname $selfdir]
# When debugging package loading trouble, show the search paths
#puts [join $auto_path \n]
# # ## ### ##### ######## ############# #####################
package require pt::pgen 1.0.3
package require pt::util
package require fileutil
package require try
namespace eval ::pt::app {
namespace export generate help
namespace ensemble create
}
# # ## ### ##### ######## ############# #####################
proc main {} {
global argv argv0 errorInfo
if {![llength $argv]} { lappend argv help }
if {[catch {
set status [::pt::app {*}$argv]
} msg]} {
set elines [split $errorInfo \n]
if {[llength $elines] == 3} {
if {[string match *unknown* $msg]} {
#puts stderr "$argv0 $msg"
::pt::app help
exit 1
} elseif {[string match {*wrong # args*} $msg]} {
#puts $msg
# Extracting the command name from the error message,
# because there a prefix will have been expanded to
# the actual command. <lindex argv 0> OTOH would be a
# possible prefix, without a properly matching topic.
puts stderr Usage:
::pt::app help [lindex $msg 5 1]
exit 1
}
}
set prefix {INTERNAL ERROR :: }
puts ${prefix}[join $elines \n$prefix]
exit 1
}
exit $status
}
# # ## ### ##### ######## ############# #####################
proc ::pt::app::helpHelp {} {
return {
@ help ?TOPIC?
Provides general help, or specific to the given topic.
}
}
proc ::pt::app::help {{topic {}}} {
global argv0
if {[llength [info level 0]] == 1} {
puts stderr "Usage: $argv0 command ...\n\nKnown commands:\n"
foreach topic [Topics] {
::pt::app help $topic
}
} elseif {$topic ni [Topics]} {
puts stderr "$argv0: Unknown help topic '$topic'"
puts stderr "\tUse one of [linsert [join [Topics] {, }] end-1 or]"
puts stderr ""
} else {
puts stderr \t[join [split [string map [list @ $argv0] [string trim [::pt::app::${topic}Help]]] \n] \n\t]
puts stderr ""
}
return 0
}
proc ::pt::app::Topics {} {
namespace eval ::TEMP { namespace import ::pt::app::* }
set commands [info commands ::TEMP::*]
namespace delete ::TEMP
set res {}
foreach c $commands {
lappend res [regsub ^::TEMP:: $c {}]
}
proc ::pt::app::Topics {} [list return $res]
return $res
}
# # ## ### ##### ######## ############# #####################
proc ::pt::app::generateHelp {} {
return {
@ generate PFORMAT ?-option value...? PFILE INFORMAT GFILE
Generate data in format PFORMAT and write it to PFILE. Read
the grammar to be processed from GFILE (assuming the format
GFORMAT). Use any options to configure the generator. The are
dependent on PFORMAT.
}
}
proc ::pt::app::generate {args} {
# args = parserformat ?...? parserfile grammarformat grammarfile
if {[llength $args] < 4} {
# Just enough that the help code can extract the method name
return -code error "wrong # args, should be \"@ generate ...\""
}
set args [lassign $args parserformat]
lassign [lrange $args end-2 end] \
parserfile grammarformat grammarfile
set args [Template [lrange $args 0 end-3]]
lappend args -file $grammarfile
puts "Reading $grammarformat $grammarfile ..."
set grammar [fileutil::cat $grammarfile]
puts "Generating a $parserformat parser ..."
try {
set parser [::pt::pgen $grammarformat $grammar $parserformat {*}$args]
} trap {PT RDE SYNTAX} {e o} {
puts [pt::util error2readable $e $grammar]
return 1
}
puts "Saving to $parserfile ..."
fileutil::writeFile $parserfile $parser
puts OK
return 0
}
# Lift template specifications from file paths to the file's contents.
proc ::pt::app::Template {optiondict} {
set res {}
foreach {option value} $optiondict {
if {$option eq "-template"} {
set value [fileutil::cat $value]
}
lappend res $option $value
}
return $res
}
# # ## ### ##### ######## ############# #####################
main
exit
|
