1# -*- tcl -*- 2# 3# Copyright (c) 2005 by Andreas Kupries <andreas_kupries@users.sourceforge.net> 4# Parser Generator / Frontend - Read serialized PEG container. 5 6# ### ### ### ######### ######### ######### 7## Requisites 8 9package require grammar::peg 10 11namespace eval ::page::parse::pegser {} 12 13# ### ### ### ######### ######### ######### 14## API 15 16proc ::page::parse::pegser {serial t} { 17 18 ::grammar::peg gr deserialize $serial 19 20 $t set root start [pegser::treeOf $t root [gr start] fixup] 21 22 array set definitions {} 23 foreach sym [gr nonterminals] { 24 set def [$t insert root end] 25 26 $t set $def users {} 27 $t set $def symbol $sym 28 $t set $def label $sym 29 $t set $def mode [gr nonterminal mode $sym] 30 pegser::treeOf $t $def [gr nonterminal rule $sym] fixup 31 32 set definitions($sym) $def 33 } 34 35 array set undefined {} 36 array set users {} 37 foreach {n sym} $fixup { 38 if {[info exists definitions($sym)]} { 39 set def $definitions($sym) 40 $t set $n def $def 41 lappend users($def) $n 42 } else { 43 lappend undefined($sym) $n 44 } 45 } 46 47 foreach def [array names users] { 48 $t set $def users $users($def) 49 } 50 51 $t set root definitions [array get definitions] 52 $t set root undefined [array get undefined] 53 $t set root symbol <StartExpression> 54 $t set root name <Serialization> 55 56 return 57} 58 59# ### ### ### ######### ######### ######### 60## Internal. Helpers 61 62proc ::page::parse::pegser::treeOf {t root pe fv} { 63 upvar 1 $fv fixup 64 65 set n [$t insert $root end] 66 set op [lindex $pe 0] 67 $t set $n op $op 68 69 if {$op eq "t"} { 70 $t set $n char [lindex $pe 1] 71 72 } elseif {$op eq ".."} { 73 $t set $n begin [lindex $pe 1] 74 $t set $n end [lindex $pe 2] 75 76 } elseif {$op eq "n"} { 77 78 set sym [lindex $pe 1] 79 $t set $n sym $sym 80 $t set $n def "" 81 82 lappend fixup $n $sym 83 } else { 84 foreach sub [lrange $pe 1 end] { 85 treeOf $t $n $sub fixup 86 } 87 } 88 return $n 89} 90 91# ### ### ### ######### ######### ######### 92## Internal. Strings. 93 94namespace eval ::page::parse::pegser {} 95 96# ### ### ### ######### ######### ######### 97## Ready 98 99package provide page::parse::pegser 0.1 100