1#! /bin/sh
2# -*- tcl -*- \
3exec tclsh "$0" ${1+"$@"}
4
5# TMC - Trival Magic Compiler
6# === = =====================
7
8# Use cases
9# ---------
10 
11# (-)	Compilation of one or more files in magic(5) syntax into a
12#	single recognizer performing all the checks and mappings
13#	encoded in them.
14# 
15# Command syntax
16# --------------
17# 
18# Ad 1)	tmc procname magic-file ?magic-file...?
19#
20#	Compile all magic files into a recognizer, put it into the
21#	named procedure, and write the result to stdout.
22# 
23# Ad 2)	tmc -merge tclfile procname magic-file ?magic-file...?
24#
25#	Same as (1), but does not write to stdout. Instead the part of
26#	the 'tclfile' delineated by marker lines containing "BEGIN
27#	GENERATED CODE" and "END GENERATED CODE" is replaced with the
28#	generated code.
29
30package require Tcl 8.4
31lappend auto_path [file dirname [file normalize [info script]]] ; # This directory
32lappend auto_path [file dirname [lindex $auto_path end]]        ; # and the one above
33#puts *\t[join $auto_path \n*\t]
34package require fileutil::magic::cfront
35
36# ### ### ### ######### ######### #########
37## Internal data and status
38
39namespace eval ::tmc {
40
41    # Path to where the output goes to. An empty string signals that
42    # the output is written to stdout. Otherwise it goes to the
43    # specified file, which has to exist, and is merged into it.
44    #
45    # Specified through the optional option '-merge'.
46
47    variable output ""
48
49    # Name of the procedure to generate from the input files.
50
51    variable proc ""
52
53    # List of the input files to process.
54
55    variable magic {}
56}
57
58# ### ### ### ######### ######### #########
59## External data and status
60#
61## Only the file merge mode uses external data, which is explicitly
62## specified via the command line. It is a template the generated
63## recognizer is merged into, completely replacing an existing
64## recognizer.
65
66# ### ### ### ######### ######### #########
67## Option processing.
68## Validate command line.
69## Full command line syntax.
70##
71# tmc ?-merge iofile? procname magic ?magic...?
72##
73
74proc ::tmc::processCmdline {} {
75    global argv
76
77    variable output
78    variable magic
79    variable proc
80
81    set output ""
82    set magic  {}
83    set proc   ""
84
85    # Process the options, perform basic validation.
86
87    while {[llength $argv]} {
88	set opt [lindex $argv 0]
89	if {![string match "-*" $opt]} break
90	if {$opt eq "-merge"} {
91	    if {[llength $argv] < 2} Usage
92	    set output [lindex $argv 1]
93	    set argv   [lrange $argv 2 end]
94	} else {
95	    Usage
96	}
97    }
98
99    # Additional validation, and extraction of the non-option
100    # arguments.
101
102    if {[llength $argv] != 2} Usage
103
104    set proc  [lindex $argv 0]
105    set magic [lrange $argv 1 end]
106
107    # Final validation across the whole configuration.
108
109    if {$proc eq ""} {
110	ArgError "Illegal empty proc name"
111    }
112    foreach m $magic {
113	CheckInput $m {Magic file}
114    }
115    if {$output ne ""} {
116	CheckTheMerge
117    }
118    return
119}
120
121# ### ### ### ######### ######### #########
122## Option processing.
123## Helpers: Generation of error messages.
124## I.  General usage/help message.
125## II. Specific messages.
126#
127# Both write their messages to stderr and then
128# exit the application with status 1.
129##
130
131proc ::tmc::Usage {} {
132    global argv0
133    puts stderr "$argv0 wrong#args, expected:\
134	    ?-merge iofile? procname magic magic..."
135    exit 1
136}
137
138proc ::tmc::ArgError {text} {
139    global argv0
140    puts stderr "$argv0: $text"
141    exit 1
142}
143
144proc in {list item} {
145    expr {([lsearch -exact $list $item] >= 0)}
146}
147
148# ### ### ### ######### ######### #########
149## Check existence and permissions of an input/output file or
150## directory.
151
152proc ::tmc::CheckInput {f label} {
153    if {![file exists $f]} {
154	ArgError "Unable to find $label \"$f\""
155    } elseif {![file readable $f]} {
156	ArgError "$label \"$f\" not readable (permission denied)"
157    }
158    return
159}
160
161proc ::tmc::CheckTheMerge {} {
162    variable output
163
164    if {$output eq ""} {
165	ArgError "No merge file specified"
166    }
167    if {![file exists $output]} {
168	ArgError "Merge file \"$output\" not found"
169    } elseif {![file isfile $output]} {
170	ArgError "Merge file \"$output\" is no such (is a directory)"
171    } elseif {![file readable $output]} {
172	ArgError "Merge file \"$output\" not readable (permission denied)"
173    } elseif {![file writable $output]} {
174	ArgError "Merge file \"$output\" not writable (permission denied)"
175    }
176    return
177}
178
179# ### ### ### ######### ######### #########
180## Helper commands. File reading and writing.
181
182proc ::tmc::Get {f} {
183    return [read [set in [open $f r]]][close $in]
184}
185
186proc ::tmc::Write {f data} {
187    puts -nonewline [set out [open $f w]] $data
188    close $out
189    return
190}
191
192# ### ### ### ######### ######### #########
193## Configuation phase, validate command line.
194
195::tmc::processCmdline
196
197# ### ### ### ######### ######### #########
198## Helper command implementing the file merge functionality.
199
200proc ::tmc::Merge {f script} {
201    set out {}
202    set skip 0
203    foreach l [split [Get $f] \n] {
204	if {$skip == 0} {
205	    lappend out $l
206	    if {[string match {*BEGIN GENERATED CODE*} $l]} {
207		set skip 1
208		lappend out $script
209	    }
210	} elseif {$skip == 1} {
211	    if {[string match {*END GENERATED CODE*} $l]} {
212		lappend out $l
213		set skip 2
214	    }
215	} else {
216	    # Skip == 2
217	    lappend out $l
218	}
219    }
220    Write $f [join $out \n]
221    return
222}
223
224# ### ### ### ######### ######### #########
225## Invoking the functionality.
226
227if {[catch {
228    # Read and process all input files.
229    # Generate a single tcl procedure from them.
230    # Write the result either to stdout, or merge
231    # into the specified output file.
232
233    set tcl [eval [linsert $tmc::magic 0 \
234	    fileutil::magic::cfront::procdef \
235	    $tmc::proc]]
236
237    if {$tmc::output eq ""} {
238	puts stdout $tcl
239    } else {
240	::tmc::Merge $tmc::output \n${tcl}\n
241    }
242} msg]} {
243    puts $::errorInfo
244    ::tmc::ArgError $msg
245}
246
247# ### ### ### ######### ######### #########
248exit
249