1# peg_to_json.tcl -- 2# 3# Conversion from PEG to JSON (Java Script Object Notation). 4# 5# Copyright (c) 2009 Andreas Kupries <andreas_kupries@sourceforge.net> 6# 7# See the file "license.terms" for information on usage and redistribution 8# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9# 10# RCS: @(#) $Id: pt_peg_to_json.tcl,v 1.1 2010/03/26 05:07:24 andreas_kupries Exp $ 11 12# This package takes the canonical serialization of a parsing 13# expression grammar and produces text in JSON format, Java Script 14# data transfer format. 15 16# ### ### ### ######### ######### ######### 17## Requisites 18 19package require Tcl 8.5 20package require pt::peg ; # Verification that the 21 # input is proper. 22package require json::write 23 24# ### ### ### ######### ######### ######### 25## 26 27namespace eval ::pt::peg::to::json { 28 namespace export \ 29 reset configure convert 30 31 namespace ensemble create 32} 33 34# ### ### ### ######### ######### ######### 35## API. 36 37proc ::pt::peg::to::json::reset {} { 38 variable indented 0 39 variable aligned 0 40 variable name a_pe_grammar 41 variable file unknown 42 variable user unknown 43 return 44} 45 46proc ::pt::peg::to::json::configure {args} { 47 variable indented 48 variable aligned 49 variable name 50 variable file 51 variable user 52 53 if {[llength $args] == 0} { 54 return [list \ 55 -file $file \ 56 -name $name \ 57 -user $user \ 58 -indented $indented \ 59 -aligned $aligned] 60 } elseif {[llength $args] == 1} { 61 lassign $args option 62 set variable [string range $option 1 end] 63 if {[info exists $variable]} { 64 return [set $variable] 65 } else { 66 return -code error "Expected one of -aligned, or -indented, got \"$option\"" 67 } 68 } elseif {[llength $args] % 2 == 0} { 69 foreach {option value} $args { 70 set variable [string range $option 1 end] 71 if {![info exists $variable]} { 72 return -code error "Expected one of -aligned, or -indented, got \"$option\"" 73 } 74 } 75 foreach {option value} $args { 76 set variable [string range $option 1 end] 77 switch -exact -- $variable { 78 indented - aligned { 79 if {![::string is boolean -strict $value]} { 80 return -code error "Expected boolean, got \"$value\"" 81 } 82 } 83 name - 84 file - 85 user { } 86 } 87 set $variable $value 88 } 89 } else { 90 return -code error {wrong#args, expected option value ...} 91 } 92} 93 94proc ::pt::peg::to::json::convert {serial} { 95 variable indented 96 variable aligned 97 98 ::pt::peg verify-as-canonical $serial 99 100 json::write indented $indented 101 json::write aligned $aligned 102 103 # Unpack the serialization, known as canonical 104 array set peg $serial 105 array set peg $peg(pt::grammar::peg) 106 unset peg(pt::grammar::peg) 107 108 # Assemble the rules object 109 set rules {} 110 foreach {symbol def} $peg(rules) { 111 lassign $def _ is _ mode 112 lappend rules $symbol \ 113 [json::write object \ 114 is [json::write string $is] \ 115 mode [json::write string $mode]] 116 } 117 118 # Assemble the final result 119 return [json::write object pt::grammar::peg \ 120 [json::write object \ 121 rules [json::write object {*}$rules] \ 122 start [json::write string $peg(start)]]] 123 124 # ### ### ### ######### ######### ######### 125} 126 127# ### ### ### ######### ######### ######### 128## Configuration 129 130namespace eval ::pt::peg::to::json { 131 132 # Combinations of the format specific entries 133 # I A | 134 # - - + --------------------- 135 # 0 0 | Ultracompact (no whitespace, single line) 136 # 1 0 | Indented 137 # 0 1 | Not possible, per the implications above. 138 # 1 1 | Indented + Tabular aligned keys 139 # - - + --------------------- 140 141 variable indented 0 142 variable aligned 0 143} 144 145# ### ### ### ######### ######### ######### 146## Ready 147 148package provide pt::peg::to::json 1 149return 150