Tcl Library Source Code

Check-in [88105b2ae2]
Login
Core Home Blog Docs Downloads Tickets Timeline Branches Tags Wiki

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

Overview
Comment:pt::util - Expansion of error details for readability added, plus fusion of terminals and char-sets into single char-set.
Timelines: family | ancestors | descendants | both | pt-work
Files: files | file ages | folders
SHA1: 88105b2ae2fa3e355a249f87335b8a6c0c26dc80
User & Date: aku 2014-06-27 06:03:47
Context
2014-06-27
06:04
pt::pgen test cases for error handling updated and tweaked. Pass for all Tcl backends. Fail for the generated C backend. To be fixed. check-in: cbd7732a08 user: aku tags: pt-work
06:03
pt::util - Expansion of error details for readability added, plus fusion of terminals and char-sets into single char-set. check-in: 88105b2ae2 user: aku tags: pt-work
06:02
pt::rdengine (tcl) - Tweaks to the err msg code for clarity. check-in: 0d84367247 user: aku tags: pt-work
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/pt/pt_util.tcl. 

1
2
3
4
5
6
7
8
9

10
11
12
13
14
15
16


17
18
19
20
21
22
23

# -*- tcl -*-
# Copyright (c) 2014 Andreas Kupries <[email protected]>

# Utility commands for parser syntax errors.

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5 ; # Required runtime.


# # ## ### ##### ######## ############# #####################
##

namespace eval ::pt::util {
    namespace export error2readable error2position error2text
    namespace ensemble create


}

# # ## ### ##### ######## #############
## Public API

proc ::pt::util::error2readable {error text} {
    lassign $error _ location msgs










>







>
>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

# -*- tcl -*-
# Copyright (c) 2014 Andreas Kupries <[email protected]>

# Utility commands for parser syntax errors.

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.5 ; # Required runtime.
package require char

# # ## ### ##### ######## ############# #####################
##

namespace eval ::pt::util {
    namespace export error2readable error2position error2text
    namespace ensemble create

    namespace import ::char::quote
}

# # ## ### ##### ######## #############
## Public API

proc ::pt::util::error2readable {error text} {
    lassign $error _ location msgs
︙︙
79
80
81
82
83
84
85





86



87

88
89
90
91









92
93
94
95
96
97
98


99

100


101



102

103



104
105
106
107
108
109
110

    set line   [llength $lines]
    set col    [string length [lindex $lines end]]

    return [list $line $col]
}

proc ::pt::util::Readables {msgs} {





    # TODO: WIBNI to fuse to multiple 't'-tags into a single 'cl'-tag.



    # TODO: WIBNI to fuse multiple 'cl'-tags into one.


    set r {}
    foreach pe $msgs {
	lappend r [Readable $pe]









    }
    return [lsort -dict $r]
}

proc ::pt::util::Readable {pe} {
    set details [lassign $pe tag]
    switch -exact -- $tag {


	t        { set m "The character '$details'" }

	n        { set m "The symbol $details" }


	..       { set m "A character in range '[join $details '-']'" }



	str      { set m "A string \"$details\"" }

	cl       { set m "A characters in set \[$details\]" }



	alpha    { set m "A unicode alphabetical character" }
	alnum    { set m "A unicode alphanumerical character" }
	ascii    { set m "An ascii character" }
	digit    { set m "A unicode digit character" }
	graph    { set m "A unicode printing character, but not space" }
	lower    { set m "A unicode lower-case alphabetical character" }
	print    { set m "A unicode printing character, including space" }








>
>
>
>
>
|
>
>
>
|
>
|
|
<
|
>
>
>
>
>
>
>
>
>







>
>
|
>

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








82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142

    set line   [llength $lines]
    set col    [string length [lindex $lines end]]

    return [list $line $col]
}

proc ::pt::util::Readables {msgs} {
    set cl {}
    set r {}
    foreach pe $msgs {
	switch -exact -- [lindex $pe 0] {
	    t {
		# Fuse to multiple 't'-tags into a single 'cl'-tag.
		lappend cl [lindex $pe 1]
	    }
	    cl {
		# Fuse multiple 'cl'-tags into one.
		foreach c [split $details] { lappend cl $c }
	    }
	    default {

		lappend r [Readable $pe]
	    }
	}
    }
    if {[set n [llength $cl]]} {
	if {$n > 1} {
	    lappend r [Readable [list cl [join [lsort -dict $cl] {}]]]
	} else {
	    lappend r [Readable [list t [lindex $cl 0]]]
	}
    }
    return [lsort -dict $r]
}

proc ::pt::util::Readable {pe} {
    set details [lassign $pe tag]
    switch -exact -- $tag {
	t        {
	    set details [quote string {*}$details]
	    set m "The character '$details'"
	}
	n        { set m "The symbol $details" }
	..       {
	    set details [quote string {*}$details]
	    set m "A character in range '[join $details '-']'"
	}
	str      {
	    set details [join [quote string {*}[split $details {}]] {}]
	    set m "A string \"$details\""
	}
	cl       {
	    set details [join [quote string {*}[split $details {}]] {}]
	    set m "A character in set \{$details\}"
	}
	alpha    { set m "A unicode alphabetical character" }
	alnum    { set m "A unicode alphanumerical character" }
	ascii    { set m "An ascii character" }
	digit    { set m "A unicode digit character" }
	graph    { set m "A unicode printing character, but not space" }
	lower    { set m "A unicode lower-case alphabetical character" }
	print    { set m "A unicode printing character, including space" }
︙︙

This page was generated in about 0.011s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19