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