Tcl Library Source Code

Check-in [8a87e457e2]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Start fixing the pt::rde::oo code. Apparently I abandoned it in a very unfinished state. :( Basic generation now working. Runtime incomplete, missing all the si:* super-instruction methods.
Timelines: family | ancestors | descendants | both | pt-rde-oo-fixup
Files: files | file ages | folders
SHA1: 8a87e457e2b119c6b616c25eea7c3710466daaa3
User & Date: andreask 2013-12-17 19:13:56
Context
2013-12-17
19:43
Reworked the input system, now matches pt::rde (snit). Implemented the super instructions, was able to copy/paste the snit code over. Closed-Leaf check-in: b8b6220b66 user: andreask tags: pt-rde-oo-fixup
19:13
Start fixing the pt::rde::oo code. Apparently I abandoned it in a very unfinished state. :( Basic generation now working. Runtime incomplete, missing all the si:* super-instruction methods. check-in: 8a87e457e2 user: andreask tags: pt-rde-oo-fixup
2013-12-16
20:47
Integrated work on a first C parser for JSON. json 1.3, tcllibc 0.3.11. See ticket [6efa4f571a]. check-in: df814df3ab user: andreask tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/pt/pkgIndex.tcl.

44
45
46
47
48
49
50

51
52
53
54
55
56
57
58
59
60
61
# Import core functionality: Conversion from a specific format to PEG.
package ifneeded pt::peg::from::json      1 [list source [file join $dir pt_peg_from_json.tcl]]
package ifneeded pt::peg::from::peg       1 [list source [file join $dir pt_peg_from_peg.tcl]]

# PARAM runtime.
package ifneeded pt::rde      1.0.2 [list source [file join $dir pt_rdengine.tcl]]


# PEG grammar specification, as CONTAINER
package ifneeded pt::peg::container::peg 1 [list source [file join $dir pt_peg_container_peg.tcl]]

# */PARAM support (canned configurations).
package ifneeded pt::cparam::configuration::critcl  1.0.1 [list source [file join $dir pt_cparam_config_critcl.tcl]]
package ifneeded pt::tclparam::configuration::snit  1.0.1 [list source [file join $dir pt_tclparam_config_snit.tcl]]
package ifneeded pt::tclparam::configuration::tcloo 1.0.2 [list source [file join $dir pt_tclparam_config_tcloo.tcl]]

# Parser generator core.
package ifneeded pt::pgen 1.0.1 [list source [file join $dir pt_pgen.tcl]]






>







|



44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
# Import core functionality: Conversion from a specific format to PEG.
package ifneeded pt::peg::from::json      1 [list source [file join $dir pt_peg_from_json.tcl]]
package ifneeded pt::peg::from::peg       1 [list source [file join $dir pt_peg_from_peg.tcl]]

# PARAM runtime.
package ifneeded pt::rde      1.0.2 [list source [file join $dir pt_rdengine.tcl]]
package ifneeded pt::rde::oo  1.0.2 [list source [file join $dir pt_rdengine_oo.tcl]]

# PEG grammar specification, as CONTAINER
package ifneeded pt::peg::container::peg 1 [list source [file join $dir pt_peg_container_peg.tcl]]

# */PARAM support (canned configurations).
package ifneeded pt::cparam::configuration::critcl  1.0.1 [list source [file join $dir pt_cparam_config_critcl.tcl]]
package ifneeded pt::tclparam::configuration::snit  1.0.1 [list source [file join $dir pt_tclparam_config_snit.tcl]]
package ifneeded pt::tclparam::configuration::tcloo 1.0.3 [list source [file join $dir pt_tclparam_config_tcloo.tcl]]

# Parser generator core.
package ifneeded pt::pgen 1.0.1 [list source [file join $dir pt_pgen.tcl]]

Changes to modules/pt/pt_rdengine_oo.tcl.

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46


47
48
49
50
51
52
53
..
56
57
58
59
60
61
62





63
64
65
66
67
68
69
...
493
494
495
496
497
498
499

500
501



502
503





504

505
506
507
508
509
510
511
...
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
...
547
548
549
550
551
552
553
554
555
oo::class create ::pt::rde::oo {

    # # ## ### ##### ######## ############# #####################
    ## API - Lifecycle

    constructor {} {
	set selfns [info object namespace]

	set mystackloc  [struct::stack ${selfns}::LOC]  ; # LS
	set mystackerr  [struct::stack ${selfns}::ERR]  ; # ES
	set mystackast  [struct::stack ${selfns}::AST]  ; # ARS/AS
	set mystackmark [struct::stack ${selfns}::MARK] ; # s.a.

	my reset
	return
    }

    method reset {chan} {
	set mychan    $chan      ; # IN


	set myline    1          ; #
	set mycolumn  0          ; #
	set mycurrent {}         ; # CC
	set myloc     -1         ; # CL
	set myok      0          ; # ST
	set msvalue   {}         ; # SV
	set myerror   {}         ; # ER
................................................................................

	$mystackloc  clear
	$mystackerr  clear
	$mystackast  clear
	$mystackmark clear
	return
    }






    method complete {} {
	if {$myok} {
	    set n [$mystackast size]
	    if {$n > 1} {
		set  pos [$mystackloc peek]
		incr pos
................................................................................
	return
    }

    # # ## ### ##### ######## ############# #####################
    ## Internals

    method ReadChar {} {

	upvar 1 mychan mychan myline myline mycolumn mycolumn




	if {[eof $mychan]} {return {}}






	set ch [read $mychan 1]

	if {$ch eq ""} {return {}}

	set token [list $ch $myline $mycolumn]

	if {$ch eq "\n"} {
	    incr myline
	    set  mycolumn 0
................................................................................
    }

    # # ## ### ##### ######## ############# #####################
    ## Data structures.
    ## Mainly the architectural state of the instance's PARAM.

    variable \
	mychan myline mycolumn \
	mycurrent myloc mystackloc \
	myok mysvalue myerror mystackerr \
	mytoken mysymbol \
	mystackast mystackmark

    # Parser Input (channel, location (line, column)) ...........
    # Token, current parsing location, stack of locations .......
................................................................................

    # # ## ### ##### ######## ############# #####################
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide pt::rde 1.0.2
return






|






|





>
>







 







>
>
>
>
>







 







>
|

>
>
>
|
|
>
>
>
>
>
|
>







 







|







 







|

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
..
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
...
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
...
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
...
564
565
566
567
568
569
570
571
572
oo::class create ::pt::rde::oo {

    # # ## ### ##### ######## ############# #####################
    ## API - Lifecycle

    constructor {} {
	set selfns [self namespace]

	set mystackloc  [struct::stack ${selfns}::LOC]  ; # LS
	set mystackerr  [struct::stack ${selfns}::ERR]  ; # ES
	set mystackast  [struct::stack ${selfns}::AST]  ; # ARS/AS
	set mystackmark [struct::stack ${selfns}::MARK] ; # s.a.

	my reset {}
	return
    }

    method reset {chan} {
	set mychan    $chan      ; # IN
	set mytext    {}         ; # IN, alt.
	set myat      0          ; # mytext index
	set myline    1          ; #
	set mycolumn  0          ; #
	set mycurrent {}         ; # CC
	set myloc     -1         ; # CL
	set myok      0          ; # ST
	set msvalue   {}         ; # SV
	set myerror   {}         ; # ER
................................................................................

	$mystackloc  clear
	$mystackerr  clear
	$mystackast  clear
	$mystackmark clear
	return
    }

    method data {string} {
	append mytext $string
	return
    }

    method complete {} {
	if {$myok} {
	    set n [$mystackast size]
	    if {$n > 1} {
		set  pos [$mystackloc peek]
		incr pos
................................................................................
	return
    }

    # # ## ### ##### ######## ############# #####################
    ## Internals

    method ReadChar {} {
	upvar 1 mychan mychan mytext mytext myat myat \
	    myline myline mycolumn mycolumn

	if {$mychan eq {}} {
	    # Read from string
	    if {$myat == [string length $mytext]} {
		return {}
	    }
	    set ch [string index $mytext $myat]
	    incr myat
	} else {
	    # Read from channel
	    if {[eof $mychan]} {return {}}
	    set ch [read $mychan 1]
	}
	if {$ch eq ""} {return {}}

	set token [list $ch $myline $mycolumn]

	if {$ch eq "\n"} {
	    incr myline
	    set  mycolumn 0
................................................................................
    }

    # # ## ### ##### ######## ############# #####################
    ## Data structures.
    ## Mainly the architectural state of the instance's PARAM.

    variable \
	mychan mytext myat myline mycolumn \
	mycurrent myloc mystackloc \
	myok mysvalue myerror mystackerr \
	mytoken mysymbol \
	mystackast mystackmark

    # Parser Input (channel, location (line, column)) ...........
    # Token, current parsing location, stack of locations .......
................................................................................

    # # ## ### ##### ######## ############# #####################
}

# # ## ### ##### ######## ############# #####################
## Ready

package provide pt::rde::oo 1.0.2
return

Changes to modules/pt/pt_tclparam_config_tcloo.man.

1
2
3
4
5
6
7
8
9
10
11
12
[comment {-*- text -*- doctools manpage}]
[manpage_begin pt::tclparam::configuration::tcloo n 1.0.1]
[include include/module.inc]
[titledesc {Tcl/PARAM, Canned configuration, Tcloo}]
[require pt::tclparam::configuration::tcloo [opt 1.0.1]]
[description]
[include include/ref_intro.inc]

This package is an adjunct to [package pt::peg::to::tclparam], to make
the use of this highly configurable package easier by providing a
canned configuration. When applied this configuration causes the
package [package pt::peg::to::tclparam] to generate
|


|







1
2
3
4
5
6
7
8
9
10
11
12
[comment {-*- text -*- doctools manpage}]
[manpage_begin pt::tclparam::configuration::tcloo n 1.0.3]
[include include/module.inc]
[titledesc {Tcl/PARAM, Canned configuration, Tcloo}]
[require pt::tclparam::configuration::tcloo [opt 1.0.3]]
[description]
[include include/ref_intro.inc]

This package is an adjunct to [package pt::peg::to::tclparam], to make
the use of this highly configurable package easier by providing a
canned configuration. When applied this configuration causes the
package [package pt::peg::to::tclparam] to generate

Changes to modules/pt/pt_tclparam_config_tcloo.tcl.

82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
113
114
115
116
117
118
119
120
121
	    method parse {channel} {
		my reset $channel
		my MAIN ; # Entrypoint for the generated code.
		return [my complete]
	    }

	    method parset {text} {
		my reset
		my data $text
		my MAIN ; # Entrypoint for the generated code.
		return [my complete]
	    }

	    # # ## ### ###### ######## #############
	    ## BEGIN of GENERATED CODE. DO NOT EDIT.
................................................................................
# # ## ### ##### ######## #############

namespace eval ::pt::tclparam::configuration::tcloo {}

# # ## ### ##### ######## ############# #####################
## Ready

package provide pt::tclparam::configuration::tcloo 1.0.2
return






|







 







|

82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
113
114
115
116
117
118
119
120
121
	    method parse {channel} {
		my reset $channel
		my MAIN ; # Entrypoint for the generated code.
		return [my complete]
	    }

	    method parset {text} {
		my reset {}
		my data $text
		my MAIN ; # Entrypoint for the generated code.
		return [my complete]
	    }

	    # # ## ### ###### ######## #############
	    ## BEGIN of GENERATED CODE. DO NOT EDIT.
................................................................................
# # ## ### ##### ######## #############

namespace eval ::pt::tclparam::configuration::tcloo {}

# # ## ### ##### ######## ############# #####################
## Ready

package provide pt::tclparam::configuration::tcloo 1.0.3
return