1# -*- tcl -*-
2#
3# Copyright (c) 2009 by Andreas Kupries <andreas_kupries@users.sourceforge.net>
4# Grammars / Parsing Expression Grammars / Parser Generator
5
6# ### ### ### ######### ######### #########
7## Package description
8
9# A package exporting a parser generator command.
10
11# ### ### ### ######### ######### #########
12## Requisites
13
14package require Tcl 8.5
15package require fileutil
16package require pt::peg::from::json    ; # Frontends: json, and PEG text form
17package require pt::peg::from::peg     ; #
18package require pt::peg::to::container ; # Backends: json, peg, container code,
19package require pt::peg::to::json      ; #           param assembler,
20package require pt::peg::to::peg       ; #
21package require pt::peg::to::param     ; # PARAM assembly, raw
22package require pt::peg::to::tclparam  ; # PARAM assembly, embedded into Tcl
23package require pt::peg::to::cparam    ; # PARAM assembly, embedded into C
24package require pt::tclparam::configuration::snit  ; # PARAM/Tcl, snit::type
25package require pt::tclparam::configuration::tcloo ; # PARAM/Tcl, TclOO class
26package require pt::cparam::configuration::critcl  ; # PARAM/C, in critcl
27
28# ### ### ### ######### ######### #########
29## Implementation
30
31namespace eval ::pt::pgen {
32    namespace export json peg serial
33    namespace ensemble create
34}
35
36# # ## ### ##### ######## #############
37## Public API - Processing the input.
38
39proc ::pt::pgen::serial {input args} {
40    #lappend args -file $inputfile
41    return [Write {*}$args $input]
42}
43
44proc ::pt::pgen::json {input args} {
45    #lappend args -file $inputfile
46    return [Write {*}$args [pt::peg::from::json convert $input]]
47}
48
49proc ::pt::pgen::peg {input args} {
50    #lappend args -file $inputfile
51    return [Write {*}$args [pt::peg::from::peg convert $input]]
52}
53
54# # ## ### ##### ######## #############
55## Internals - Generating the parser.
56
57namespace eval ::pt::pgen::Write {
58    namespace export json peg container param snit oo critcl c
59    namespace ensemble create
60}
61
62proc ::pt::pgen::Write::json {args} {
63    # args = (option value)... grammar
64    pt::peg::to::json configure {*}[lrange $args 0 end-1]
65    return [pt::peg::to::json convert [lindex $args end]]
66}
67
68proc ::pt::pgen::Write::peg {args} {
69    # args = (option value)... grammar
70    pt::peg::to::peg configure {*}[lrange $args 0 end-1]
71    return [pt::peg::to::peg convert [lindex $args end]]
72}
73
74proc ::pt::pgen::Write::container {args} {
75    # args = (option value)... grammar
76    pt::peg::to::container configure {*}[lrange $args 0 end-1]
77    return [pt::peg::to::container convert [lindex $args end]]
78}
79
80proc ::pt::pgen::Write::param {args} {
81    # args = (option value)... grammar
82    pt::peg::to::param configure {*}[lrange $args 0 end-1]
83    return [pt::peg::to::param convert [lindex $args end]]
84}
85
86proc ::pt::pgen::Write::snit {args} {
87    # args = (option value)... grammar
88    pt::peg::to::tclparam configure {*}[Package [Class [lrange $args 0 end-1]]]
89
90    pt::tclparam::configuration::snit def \
91	$class $package \
92	{pt::peg::to::tclparam configure}
93
94    return [pt::peg::to::tclparam convert [lindex $args end]]
95}
96
97proc ::pt::pgen::Write::oo {args} {
98    # args = (option value)... grammar
99    pt::peg::to::tclparam configure {*}[Package [Class [lrange $args 0 end-1]]]
100
101    pt::tclparam::configuration::tcloo def \
102	$class $package \
103	{pt::peg::to::tclparam configure}
104
105    return [pt::peg::to::tclparam convert [lindex $args end]]
106}
107
108proc ::pt::pgen::Write::critcl {args} {
109    # args = (option value)... grammar
110    # Class   -> touches/defines variable 'class'
111    # Package -> touches/defines variable 'package'
112    pt::peg::to::cparam configure {*}[Package [Class [lrange $args 0 end-1]]]
113
114    pt::cparam::configuration::critcl def \
115	$class $package \
116	{pt::peg::to::cparam configure}
117
118    return [pt::peg::to::cparam convert [lindex $args end]]
119}
120
121proc ::pt::pgen::Write::c {args} {
122    # args = (option value)... grammar
123    pt::peg::to::cparam configure {*}[lrange $args 0 end-1]
124    return [pt::peg::to::cparam convert [lindex $args end]]
125}
126
127# ### ### ### ######### ######### #########
128## Internals: Special option handling handling.
129
130proc ::pt::pgen::Write::Class {optiondict} {
131    upvar 1 class class
132    set class CLASS
133    set res {}
134    foreach {option value} $optiondict {
135	if {$option eq "-class"} {
136	    set class $value
137	    continue
138	}
139	lappend res $option $value
140    }
141    return $res
142}
143
144proc ::pt::pgen::Write::Package {optiondict} {
145    upvar 1 package package
146    set package PACKAGE
147    set res {}
148    foreach {option value} $optiondict {
149	if {$option eq "-package"} {
150	    set package $value
151	    continue
152	}
153	lappend res $option $value
154    }
155    return $res
156}
157
158# ### ### ### ######### ######### #########
159## Package Management
160
161package provide pt::pgen 1
162