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