Check-in [0b62f38ede]
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:Merge changes: complete type checking of Boolean args to 'jumpTrue', 'jumpFalse', 'not', 'land', and 'lor'
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: 0b62f38ede187e85158fe3ab2cd872f1a7c52e266a91dd6f99e143d18691e0dd
User & Date: kbk 2018-03-27 01:36:33
Context
2018-04-10
02:46
Reform buildVector and clearVector to use preallocated space in the LLVM callframe check-in: a7ae4fde24 user: kbk tags: trunk
2018-03-27
01:44
merge trunk check-in: 6b733cc796 user: kbk tags: kbk-nre
01:40
merge trunk check-in: c0e88e91be user: kbk tags: inline
01:36
Merge changes: complete type checking of Boolean args to 'jumpTrue', 'jumpFalse', 'not', 'land', and 'lor' check-in: 0b62f38ede user: kbk tags: trunk
01:32
Fix a problem where adding and dropping references to/from FAIL IMPURE values would dereference a null pointer in the FAIL case. Closed-Leaf check-in: 0bd0c41f0a user: kbk tags: kbk-domain-check
2018-03-15
22:09
Correct broken Markdown formatting in NRE notes check-in: 86584bbbc5 user: kbk tags: trunk
Changes

Changes to codegen/build.tcl.

43
44
45
46
47
48
49















50
51
52
53
54
55
56
...
115
116
117
118
119
120
121






















































122
123
124
125
126
127
128
...
185
186
187
188
189
190
191
















































192
193
194
195
196
197
198
....
4235
4236
4237
4238
4239
4240
4241




























4242
4243
4244
4245
4246
4247
4248
....
4342
4343
4344
4345
4346
4347
4348
















































4349



































4350
4351
4352
4353
4354
4355
4356
....
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
....
5098
5099
5100
5101
5102
5103
5104

















5105
5106
5107
5108
5109
5110
5111
....
5671
5672
5673
5674
5675
5676
5677




















5678
5679
5680
5681
5682
5683
5684
....
6170
6171
6172
6173
6174
6175
6176


















6177
6178
6179
6180
6181
6182
6183
    # Results:
    #	A boolean (int1) LLVM value reference.

    method isNumericInt {NUMERIC {name ""}} {
	my eq [my extract $NUMERIC NUMERIC.kind] \
	    [Const ${::LLVM::NUMERIC.type.int} int1] $name
    }
















    # Builder:packInt32 --
    #
    #	Generate code to convert an int32 to an INT.
    #
    # Parameters:
    #	value -	The 32-bit integer LLVM value reference.
................................................................................
    #	The NUMERIC LLVM value reference.

    method packNumericDouble {value {name ""}} {
	my insert [my insert [my undef NUMERIC] \
		[Const ${::LLVM::NUMERIC.type.double} int1] NUMERIC.kind] \
	    $value NUMERIC.double $name
    }























































    # Builder:int.32 --
    #
    #	Generate code to extract the int32 from an INT. Caller MUST guarantee
    #	that the size was tested for first.
    #
    # Parameters:
................................................................................
    #
    # Results:
    #	A DOUBLE LLVM value reference.

    method numeric.double {NUMERIC {name ""}} {
	my extract $NUMERIC NUMERIC.double $name
    }

















































    # Builder:NumToDbl --
    #
    #	Generate code to convert a NUMERIC to a DOUBLE. The value inside the
    #	NUMERIC might be INT or DOUBLE; this handles both cases.
    #
    # Parameters:
................................................................................

    method instanceOf.NUMERIC(STRING) {value {name ""}} {
	my call ${tcl.isNumeric} [list $value [Const false bool]] $name
    }
    method instanceOf.IMPURE_NUMERIC(STRING) {value {name ""}} {
	my call ${tcl.isNumeric} [list $value [Const false bool]] $name
    }





























    # Builder:int --
    #
    #	Generate code to create an integer "literal".
    #
    # Parameters:
    #	value -	The Tcl integer that we are converting to an LLVM INT.
................................................................................
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	An LLVM INT value reference containing a boolean value.

    method isBoolean(STRING) {value {name ""}} {
















































	my call ${tcl.booleanTest} [list $value] $name



































    }

    # Builder:land(INT,INT) --
    #
    #	Generate code to compute the logical and of two INTs.  Quadcode
    #	implementation ('land').
    #
................................................................................
		set idx -1
		foreach value $values type $types {
		    if {[lindex $type 0] eq "IMPURE"} {
			set value [my stringify($type) $value]
		    } else {
			switch -exact -- $type {
			    "INT" - "INT BOOLEAN" - "ZEROONE" - "DOUBLE" -
			    "ENTIER" - "NUMERIC" {
				set value [my stringify($type) $value]
			    }
			}
		    }
		    my store $value [my gep $vlist [incr idx]]
		}
	    } else {
................................................................................
    method narrowToType.IMPURE_BOOLEAN(IMPURE\040ZEROONE\040BOOLEAN) {value {name ""}} {
	my addReference(STRING) [my impure.string $value]
	if {$name ne "" && [string match {[0-9]*} [GetValueName $value]]} {
	    SetValueName $value $name
	}
	return $value
    }


















    # Builder:narrowToType.IMPURE_ZEROONE(IMPURE ZEROONE BOOLEAN) --
    #
    #	Generate code to extract IMPURE ZEROONE from IMPURE ZEROONE BOOLEAN.
    #	The extracton does nothing except bump the reference count, the two
    #	types have the same internal representation
    #
................................................................................
    #
    # Results:
    #	A NUMERIC LLVM value reference.

    method not(NUMERIC) {value errVar {name ""}} {
	my call ${tcl.not.numeric} [list $value] $name
    }





















    # Builder:not(STRING) --
    #
    #	Generate code to create the logical not of a STRING. Quadcode
    #	implementation ('not').
    #
    # Parameters:
................................................................................
    #
    # Results:
    #	A STRING LLVM value reference.

    method stringify(IMPURE\040INT) {value {name ""}} {
	my stringifyImpure $value $name
    }



















    # Builder:stringify(NUMERIC) --
    #
    #	Generate a STRING representation of a NUMERIC. WARNING: caller is
    #	entirely responsible for reference count management; this method does
    #	not handle that. This method is used by the type promotion code.
    #






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







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







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
...
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
...
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
....
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
....
4487
4488
4489
4490
4491
4492
4493
4494
4495
4496
4497
4498
4499
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
....
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
....
5326
5327
5328
5329
5330
5331
5332
5333
5334
5335
5336
5337
5338
5339
5340
5341
5342
5343
5344
5345
5346
5347
5348
5349
5350
5351
5352
5353
5354
5355
5356
....
5916
5917
5918
5919
5920
5921
5922
5923
5924
5925
5926
5927
5928
5929
5930
5931
5932
5933
5934
5935
5936
5937
5938
5939
5940
5941
5942
5943
5944
5945
5946
5947
5948
5949
....
6435
6436
6437
6438
6439
6440
6441
6442
6443
6444
6445
6446
6447
6448
6449
6450
6451
6452
6453
6454
6455
6456
6457
6458
6459
6460
6461
6462
6463
6464
6465
6466
    # Results:
    #	A boolean (int1) LLVM value reference.

    method isNumericInt {NUMERIC {name ""}} {
	my eq [my extract $NUMERIC NUMERIC.kind] \
	    [Const ${::LLVM::NUMERIC.type.int} int1] $name
    }

    # Builder: getNumericBooleanKind
    #
    #	Generate code to return the kind of a NUMERIC BOOLEAN
    #
    # Parameters:
    #	nb - The NUMERIC BOOLEAN vlaue reference
    #	name (optional) - A name to give to the result
    #
    # Results:
    #	An int(3) LLVM value reference: 0 = INT, 1 = DOUBLE 2 = BOOLEAN

    method getNumericBooleanKind {nb {name ""}} {
	my extract $nb NUMERIC_BOOLEAN.kind
    }

    # Builder:packInt32 --
    #
    #	Generate code to convert an int32 to an INT.
    #
    # Parameters:
    #	value -	The 32-bit integer LLVM value reference.
................................................................................
    #	The NUMERIC LLVM value reference.

    method packNumericDouble {value {name ""}} {
	my insert [my insert [my undef NUMERIC] \
		[Const ${::LLVM::NUMERIC.type.double} int1] NUMERIC.kind] \
	    $value NUMERIC.double $name
    }

    # Builder:packNumericOrBooleanInt --
    #
    #	Generate code to convert an integer to a NUMERIC BOOLEAN
    #
    # Parameters:
    #	value - The integer LLVM value reference
    #   name (optional) - A name to give to the result value
    #
    # Results:
    #	The NUMERIC BOOLEAN LLVM value reference

    method packNumericOrBooleanInt {value {name ""}} {
	my insert [my insert [my undef "NUMERIC_BOOLEAN"] \
		       [Const ${::LLVM::NUMERIC_BOOLEAN.type.int} int3] \
		       NUMERIC_BOOLEAN.kind] \
	    $value NUMERIC_BOOLEAN.int $name
    }

    # Builder:packNumericOrBooleanDouble --
    #
    #	Generate code to convert a double to a NUMERIC BOOLEAN
    #
    # Parameters:
    #	value - The DOUBLE LLVM value reference
    #	name (optional) - A name to give to the result value
    #
    # Results:
    #	The NUMERIC BOOLEAN LLVM value reference

    method packNumericOrBooleanDouble {value {name ""}} {
	my insert [my insert [my undef "NUMERIC_BOOLEAN"] \
		       [Const ${::LLVM::NUMERIC_BOOLEAN.type.double} int3] \
		       NUMERIC_BOOLEAN.kind] \
	    $value NUMERIC_BOOLEAN.double $name
    }

    # Builder:packNumericOrBooleanBoolean --
    #
    #	Generate code to convert a Boolean to a NUMERIC BOOLEAN
    #
    # Parameters:
    #	value - The bool LLVM value reference
    #	name (optional) - A name to give to the result value
    #
    # Results:
    #	The NUMERIC BOOLEAN LLVM value reference

    method packNumericOrBooleanBoolean {value {name ""}} {
	my insert [my insert [my undef "NUMERIC_BOOLEAN"] \
		       [Const ${::LLVM::NUMERIC_BOOLEAN.type.bool} int3] \
		       NUMERIC_BOOLEAN.kind] \
	    $value NUMERIC_BOOLEAN.bool $name
    }

    # Builder:int.32 --
    #
    #	Generate code to extract the int32 from an INT. Caller MUST guarantee
    #	that the size was tested for first.
    #
    # Parameters:
................................................................................
    #
    # Results:
    #	A DOUBLE LLVM value reference.

    method numeric.double {NUMERIC {name ""}} {
	my extract $NUMERIC NUMERIC.double $name
    }

    # Builder:numericOrBoolean.int --
    #
    #	Generate code to extract the INT from a NUMERIC BOOLEAN. Caller MUST
    #	guarantee that the kind was tested for first.
    #
    # Parameters:
    #	nb - LLVM NUMERIC BOOLEAN value reference
    #	name (optional) - A name to give to the result
    #
    # Results:
    #	An INT LLVM value reference

    method numericOrBoolean.int {nb {name ""}} {
	my extract $nb NUMERIC_BOOLEAN.int $name
    }

    # Builder:numericOrBoolean.double --
    #
    #	Generate code to extract the DOUBLE from a NUMERIC BOOLEAN. Caller MUST
    #	guarantee that the kind was tested for first.
    #
    # Parameters:
    #	nb - LLVM NUMERIC BOOLEAN value reference
    #	name (optional) - A name to give to the result
    #
    # Results:
    #	A DOUBLE LLVM value reference

    method numericOrBoolean.double {nb {name ""}} {
	my extract $nb NUMERIC_BOOLEAN.double $name
    }

    # Builder:numericOrBoolean.bool --
    #
    #	Generate code to extract the BOOLEAN from a NUMERIC BOOLEAN. Caller MUST
    #	guarantee that the kind was tested for first.
    #
    # Parameters:
    #	nb - LLVM NUMERIC BOOLEAN value reference
    #	name (optional) - A name to give to the result
    #
    # Results:
    #	An int1 LLVM value reference

    method numericOrBoolean.bool {nb {name ""}} {
	my extract $nb NUMERIC_BOOLEAN.bool $name
    }

    # Builder:NumToDbl --
    #
    #	Generate code to convert a NUMERIC to a DOUBLE. The value inside the
    #	NUMERIC might be INT or DOUBLE; this handles both cases.
    #
    # Parameters:
................................................................................

    method instanceOf.NUMERIC(STRING) {value {name ""}} {
	my call ${tcl.isNumeric} [list $value [Const false bool]] $name
    }
    method instanceOf.IMPURE_NUMERIC(STRING) {value {name ""}} {
	my call ${tcl.isNumeric} [list $value [Const false bool]] $name
    }

    # Builder:instanceOf.NUMERIC_OR_BOOLEAN --
    #
    #	Generate code to check if the given STRING contains something that
    #	can be parsed to get either a NUMERIC or a BOOLEAN (suitable, in
    #	other words, for a conditional. Quadcode implementation ('jumpFalse',
    #	'jumpTrue', 'land', 'lor', 'not')

    method instanceOf.NUMERIC_OR_BOOLEAN(STRING) {value {name ""}} {
	my call ${tcl.isNumericOrBoolean} [list $value] $name
    }
    method instanceOf.IMPURE_NUMERIC_OR_BOOLEAN(STRING) {value {name ""}} {
	my call ${tcl.isNumericOrBoolean} [list $value] $name
    }

    # Builder:instanceOf.ZEROONE_BOOLEAN --
    #
    #	Generate code to check if the given STRING contains something that
    #	can be parsed to get a ZEROONE or a BOOLEAN (suitable, in
    #	other words, for a conditional. Quadcode implementation ('jumpFalse',
    #	'jumpTrue', 'land', 'lor', 'not')

    method instanceOf.ZEROONE_BOOLEAN(STRING) {value {name ""}} {
	my call ${tcl.isZeroOneBoolean} [list $value [Const false bool]] $name
    }
    method instanceOf.IMPURE_ZEROONE_BOOLEAN(STRING) {value {name ""}} {
	my call ${tcl.isZeroOneBoolean} [list $value [Const false bool]] $name
    }

    # Builder:int --
    #
    #	Generate code to create an integer "literal".
    #
    # Parameters:
    #	value -	The Tcl integer that we are converting to an LLVM INT.
................................................................................
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	An LLVM INT value reference containing a boolean value.

    method isBoolean(STRING) {value {name ""}} {
	my call ${tcl.isBoolean} [list $value [Const false bool]] $name
    }

    # Builder:isTrue(INT BOOLEAN) --
    #
    #	Tests whether a given value will cause 'jumpTrue' to jump;
    #	Quadcode implementation('jumpTrue', 'jumpFalse')
    #
    # Parameters:
    #	value - The value to test, as an LLVM value reference.
    #	name (optional) - A name to give to the result value.
    #
    # Results:
    #	An LLVM ZEROONE value reference.

    method isTrue(INT\040BOOLEAN) {value {name ""}} {
	my eq $value [Const 0 int64]
    }

    # Builder:isTrue(DOUBLE) --
    #
    #	Tests whether a given value will cause 'jumpTrue' to jump;
    #	Quadcode implementation('jumpTrue', 'jumpFalse')
    #
    # Parameters:
    #	value - The value to test, as an LLVM value reference.
    #	name (optional) - A name to give to the result value.
    #
    # Results:
    #	An LLVM ZEROONE value reference.

    method isTrue(DOUBLE) {value {name ""}} {
	my eq $value [Const 0.0 double]
    }

    # Builder:isTrue(NUMERIC) --
    #
    #	Tests whether a given value will cause 'jumpTrue' to jump;
    #	Quadcode implementation('jumpTrue', 'jumpFalse')
    #
    # Parameters:
    #	value - The value to test, as an LLVM value reference.
    #	name (optional) - A name to give to the result value.
    #
    # Results:
    #	An LLVM ZEROONE value reference.

    method isTrue(NUMERIC) {value name} {
	my call ${tcl.isTrue.numeric} [list $value] $name
    }

    # Builder:isTrue(NUMERIC BOOLEAN) --
    #
    #	Tests whether a given value will cause 'jumpTrue' to jump;
    #	Quadcode implementation('jumpTrue', 'jumpFalse')
    #
    # Parameters:
    #	value - The value to test, as an LLVM value reference.
    #	name (optional) - A name to give to the result value.
    #
    # Results:
    #	An LLVM ZEROONE value reference.

    method isTrue(NUMERIC\040BOOLEAN) {value name} {
	my call ${tcl.isTrue.numericOrBoolean} [list $value] $name
    }

    # Builder:isTrue(ZEROONE BOOLEAN) --
    #
    #	Tests whether a given value will cause 'jumpTrue' to jump;
    #	Quadcode implementation('jumpTrue', 'jumpFalse')
    #
    # Parameters:
    #	value - The value to test, as an LLVM value reference.
    #	name (optional) - A name to give to the result value.
    #
    # Results:
    #	An LLVM ZEROONE value reference.

    method isTrue(ZEROONE) {value name} {
	return $value
    }
    method isTrue(ZEROONE\040BOOLEAN) {value name} {
	return $value
    }

    # Builder:land(INT,INT) --
    #
    #	Generate code to compute the logical and of two INTs.  Quadcode
    #	implementation ('land').
    #
................................................................................
		set idx -1
		foreach value $values type $types {
		    if {[lindex $type 0] eq "IMPURE"} {
			set value [my stringify($type) $value]
		    } else {
			switch -exact -- $type {
			    "INT" - "INT BOOLEAN" - "ZEROONE" - "DOUBLE" -
			    "ENTIER" - "NUMERIC" - "NUMERIC BOOLEAN" {
				set value [my stringify($type) $value]
			    }
			}
		    }
		    my store $value [my gep $vlist [incr idx]]
		}
	    } else {
................................................................................
    method narrowToType.IMPURE_BOOLEAN(IMPURE\040ZEROONE\040BOOLEAN) {value {name ""}} {
	my addReference(STRING) [my impure.string $value]
	if {$name ne "" && [string match {[0-9]*} [GetValueName $value]]} {
	    SetValueName $value $name
	}
	return $value
    }

    # Builder:narrowToType.IMPURE_NUMERIC_BOOLEAN(STRING) --
    #
    #	Generate code to extract IMPURE NUMERIC BOOLEAN from a STRING.
    #
    # Parameters:
    #	value - The STRING to parse
    #	name (optional) - A name to give to the result
    #
    # Results:
    #	An IMPURE NUMERIC BOOLEAN value reference.

    method narrowToType.IMPURE_NUMERIC_BOOLEAN(STRING) {value {name ""}} {
	set nbval [my Call ${tcl.extractNumericOrBoolean} $value]
	my addReference(STRING) $value
	return [my impure NUMERIC_BOOLEAN $value $nbval $name]
    }

    # Builder:narrowToType.IMPURE_ZEROONE(IMPURE ZEROONE BOOLEAN) --
    #
    #	Generate code to extract IMPURE ZEROONE from IMPURE ZEROONE BOOLEAN.
    #	The extracton does nothing except bump the reference count, the two
    #	types have the same internal representation
    #
................................................................................
    #
    # Results:
    #	A NUMERIC LLVM value reference.

    method not(NUMERIC) {value errVar {name ""}} {
	my call ${tcl.not.numeric} [list $value] $name
    }

    # Builder:not(NUMERIC BOOLEAN) --
    #
    #	Generate code to create the logical not of a NUMERIC BOOLEAN. Quadcode
    #	implementation ('not').
    #
    # Parameters:
    #	value -	The NUMERIC LLVM value reference for the operand.
    #	errVar -
    #		Location to write the Tcl return code into, as an LLVM int*
    #		reference. (unused)
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	A NUMERIC LLVM value reference.

    method not(NUMERIC\040BOOLEAN) {value errVar {name ""}} {
	my call ${tcl.not.numericOrBoolean} [list $value] $name
    }

    # Builder:not(STRING) --
    #
    #	Generate code to create the logical not of a STRING. Quadcode
    #	implementation ('not').
    #
    # Parameters:
................................................................................
    #
    # Results:
    #	A STRING LLVM value reference.

    method stringify(IMPURE\040INT) {value {name ""}} {
	my stringifyImpure $value $name
    }

    # Builder:stringify(NUMERIC BOOLEAN) --
    #
    #	Generate a STRING representation of a NUMERIC. WARNING: caller is
    #	entirely responsible for reference count management; this method does
    #	not handle that. This method is used by the type promotion code.
    #
    # Parameters:
    #	value -	The NUMERIC LLVM value reference for the operand.
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	A STRING LLVM value reference.

    method stringify(NUMERIC\040BOOLEAN) {value {name ""}} {
	my call ${tcl.stringify.numericOrBoolean} [list $value] $name
    }

    # Builder:stringify(NUMERIC) --
    #
    #	Generate a STRING representation of a NUMERIC. WARNING: caller is
    #	entirely responsible for reference count management; this method does
    #	not handle that. This method is used by the type promotion code.
    #

Changes to codegen/compile.tcl.

479
480
481
482
483
484
485

486
487
488
489
490
491
492
...
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
...
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
			    [$b maybe [$b frame.value $res]]
		    }
		    my StoreResult $tgt $res
		}
		"bitor" - "bitxor" - "bitand" - "lshift" - "rshift" -
		"add" - "sub" - "mult" - "uminus" - "uplus" - "land" - "lor" -
		"isBoolean" - "eq" - "neq" - "lt" - "gt" - "le" - "ge" -

		"streq" - "bitnot" - "strcase" - "strclass" - "strcmp" -
		"strfind" - "strlen" - "strmap" - "strmatch" - "strrfind" -
		"strtrim" - "resolveCmd" - "arrayExists" - "directExists" -
		"arrayElementExists" - "directArrayExists" -
		"initArrayIfNotExists" - "extractScalar" - "extractArray" -
		"arraySet" - "arrayUnset" - "arrayGet" {
		    set srcs [lassign $l opcode tgt]
................................................................................
		"directLappendList" - "directUnset" -
		"directArrayGet" - "directArraySet" - "directArrayAppend" -
		"directArrayLappend" - "directArrayLappendList" -
		"directArrayUnset" - "directIsArray" - "directMakeArray" -
		"regexp" - "listAppend" - "listConcat" - "listLength" -
		"listRange" - "listIn" - "listNotIn" - "dictIterStart" -
		"dictAppend" - "dictIncr" - "dictLappend" - "dictSize" -
		"div" - "expon" - "mod" - "not" - "verifyList" -
		"dictGetOrNexist" - "dictSetOrUnset" {
		    set srcs [lassign $l opcode tgt]
		    set name [my LocalVarName $tgt]
		    append opcode ( [my ValueTypes {*}$srcs] )
		    set srcs [lmap s $srcs {my LoadOrLiteral $s}]
		    set res [$b $opcode {*}$srcs $errorCode $name]
		    if {"FAIL" in [my ValueTypes $tgt]} {
................................................................................
			$b br $block($tgt)
		    }
		}
		"jumpTrue" {
		    lassign $l opcode tgt src
		    set name [my LocalVarName $src]
		    set tgt [lindex $tgt 1]
		    set neq neq([my ValueTypes $src],INT)
		    set test [$b $neq [my LoadOrLiteral $src] $0 test_$name]
		    $b condBr $test $block($tgt) $ipath($pc)
		}
		"jumpFalse" {
		    lassign $l opcode tgt src
		    set name [my LocalVarName $src]
		    set tgt [lindex $tgt 1]
		    set neq neq([my ValueTypes $src],INT)
		    set test [$b $neq [my LoadOrLiteral $src] $0 test_$name]
		    $b condBr $test $ipath($pc) $block($tgt)
		}
		"jump" {
		    $b br $block([lindex $l 1 1])
		}
		"return" {
		    lassign $l opcode -> frame src






>







 







|







 







|
|






|
|







479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
...
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
...
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
			    [$b maybe [$b frame.value $res]]
		    }
		    my StoreResult $tgt $res
		}
		"bitor" - "bitxor" - "bitand" - "lshift" - "rshift" -
		"add" - "sub" - "mult" - "uminus" - "uplus" - "land" - "lor" -
		"isBoolean" - "eq" - "neq" - "lt" - "gt" - "le" - "ge" -
		"not" -
		"streq" - "bitnot" - "strcase" - "strclass" - "strcmp" -
		"strfind" - "strlen" - "strmap" - "strmatch" - "strrfind" -
		"strtrim" - "resolveCmd" - "arrayExists" - "directExists" -
		"arrayElementExists" - "directArrayExists" -
		"initArrayIfNotExists" - "extractScalar" - "extractArray" -
		"arraySet" - "arrayUnset" - "arrayGet" {
		    set srcs [lassign $l opcode tgt]
................................................................................
		"directLappendList" - "directUnset" -
		"directArrayGet" - "directArraySet" - "directArrayAppend" -
		"directArrayLappend" - "directArrayLappendList" -
		"directArrayUnset" - "directIsArray" - "directMakeArray" -
		"regexp" - "listAppend" - "listConcat" - "listLength" -
		"listRange" - "listIn" - "listNotIn" - "dictIterStart" -
		"dictAppend" - "dictIncr" - "dictLappend" - "dictSize" -
		"div" - "expon" - "mod" - "verifyList" -
		"dictGetOrNexist" - "dictSetOrUnset" {
		    set srcs [lassign $l opcode tgt]
		    set name [my LocalVarName $tgt]
		    append opcode ( [my ValueTypes {*}$srcs] )
		    set srcs [lmap s $srcs {my LoadOrLiteral $s}]
		    set res [$b $opcode {*}$srcs $errorCode $name]
		    if {"FAIL" in [my ValueTypes $tgt]} {
................................................................................
			$b br $block($tgt)
		    }
		}
		"jumpTrue" {
		    lassign $l opcode tgt src
		    set name [my LocalVarName $src]
		    set tgt [lindex $tgt 1]
		    set mth isTrue([my ValueTypes $src])
		    set test [$b $mth [my LoadOrLiteral $src] test_$name]
		    $b condBr $test $block($tgt) $ipath($pc)
		}
		"jumpFalse" {
		    lassign $l opcode tgt src
		    set name [my LocalVarName $src]
		    set tgt [lindex $tgt 1]
		    set mth isTrue([my ValueTypes $src])
		    set test [$b $mth [my LoadOrLiteral $src] test_$name]
		    $b condBr $test $ipath($pc) $block($tgt)
		}
		"jump" {
		    $b br $block([lindex $l 1 1])
		}
		"return" {
		    lassign $l opcode -> frame src

Changes to codegen/mathlib.tcl.

23
24
25
26
27
28
29

30
31

32



33
34

35
36
37
38
39
40
41
...
654
655
656
657
658
659
660























661
662
663
664
665
666
667
....
1189
1190
1191
1192
1193
1194
1195
1196









1197

1198

1199





















1200
1201
1202
1203
1204
1205
1206
....
1253
1254
1255
1256
1257
1258
1259

1260
1261
1262
1263
1264
1265
1266
....
1277
1278
1279
1280
1281
1282
1283
1284




















1285























1286







1287
1288
1289
1290
1291
1292
1293
1294
....
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
....
1330
1331
1332
1333
1334
1335
1336




































1337
1338
1339
1340
1341
1342
1343
....
1355
1356
1357
1358
1359
1360
1361



































1362
1363
1364
1365
1366
1367
1368
....
1383
1384
1385
1386
1387
1388
1389










































1390
1391
1392
1393
1394
1395
1396
    variable tcl.div tcl.div.32 tcl.div.64 tcl.div.double tcl.mod
    variable tcl.shr tcl.and tcl.or tcl.xor
    variable tcl.eq tcl.ne tcl.lt tcl.le tcl.gt tcl.ge
    variable tcl.not tcl.neg tcl_div
    variable tcl.land tcl.land.double tcl.lor tcl.lor.double
    variable tcl.add.numeric tcl.sub.numeric tcl.mult.numeric tcl.div.numeric
    variable tcl.pow.numeric tcl.land.numeric tcl.lor.numeric tcl.not.numeric

    variable tcl.neg.numeric tcl.eq.numeric tcl.ne.numeric tcl.lt.numeric
    variable tcl.le.numeric tcl.gt.numeric tcl.ge.numeric

    variable tcl.isNumeric tcl.isDouble tcl.isInteger



    variable tcl.extractNumeric tcl.extractDouble tcl.extractInteger
    variable tcl.stringify.double tcl.stringify.int tcl.stringify.numeric

    variable tcl.cmp.strstr tcl.cmp.strnum

    # Builder:GrowingBinaryFunction --
    #
    #	Generate a function that implements a (normal) mathematical operator
    #	that can increase the width of its result relative to the width of its
    #	input values. Only called from @supportFunctions method.
................................................................................
	build {
	    my condBr [my isNumericInt $value] $intNot $dblNot
	label intNot "int.not"
	    my ret [my not(INT) [my numeric.int $value] [my null int]]
	label dblNot "double.not"
	    my ret [my not(DOUBLE) [my numeric.double $value] [my null int]]
	}
























	##### Function tcl.neg.numeric #####
	#
	# Type signature: x:NUMERIC -> NUMERIC
	#
	# Quadcode implementation ('neg').
	#
................................................................................
	    my condBr [my isNumericInt $value] $int $double
	label int "op.int"
	    my ret [my Call tcl.stringify.int [my numeric.int $value]]
	label double "op.double"
	    my ret [my Call tcl.stringify.double [my numeric.double $value]]
	}

	return









    }

 

    method @numericConverterFunctions {api} {





















	##### Function tcl.impl.isDouble #####
	##### Closure Build:isDouble #####
	#
	# Type signature: objPtr:STRING -> int1
	#
	# Test if a STRING is actually already a wrapped double.

................................................................................
	    set b2 [$api Tcl_GetString $value]
	    SetValueName $b2 "bytes"
	    my br $get
	label get:
	    set bytes [my phi [list $b1 $b2] [list $entry $generate] "bytes"]
	    my ret [my eq [my dereference $bytes 0] [Const 0 int8]]
	}


	##### Function tcl.isNumeric #####
	#
	# Type signature: value:STRING -> ZEROONE
	#
	# Tests if a STRING can be parsed as a NUMERIC. Part of the
	# implementation of quadcode "instanceOf".
................................................................................
	    my condBr [my isInteger $value] $yes $checkEmptyOK
	label checkEmptyOK:
	    my condBr $emptyOK $checkEmpty $checkDouble
	label checkEmpty:
	    my condBr [my Call tcl.impl.strempty $value] $yes $checkDouble
	label checkDouble:
	    set d [my GetDouble $value]
	    my condBr [my extract $d 0] $yes $checkInt




















	label checkInt:























	    set i [my GetWide $value]







	    my ret [my extract $i 0]
	label yes:
	    my ret [Const true bool]
	}

	##### Function tcl.isDouble #####
	#
	# Type signature: value:STRING -> ZEROONE
................................................................................
	params value emptyOK
	build {
	    nonnull $value
	    my condBr [my isDouble $value] $yes $checkEmptyOK
	label checkEmptyOK:
	    my condBr $emptyOK $checkEmpty $checkDouble
	label checkEmpty:
	    my condBr [my Call tcl.impl.strempty $value] $yes $checkDouble
	label checkDouble:
	    set d [my GetDouble $value]
	    my ret [my extract $d 0]
	label yes:
	    my ret [Const true bool]
	}

................................................................................
	    my condBr [my Call tcl.impl.strempty $value] $yes $checkInt
	label checkInt:
	    set i [my GetWide $value]
	    my ret [my extract $i 0]
	label yes:
	    my ret [Const true bool]
	}





































	##### Function tcl.extractNumeric #####
	#
	# Type signature: value:STRING -> NUMERIC
	#
	# Parse a STRING as a NUMERIC; the value is known to be parseable.
	# Part of the implementation of quadcode "narrowToType".
................................................................................
	    my condBr [my isDouble $value] $returnDouble $extractInt
	label returnDouble:
	    my ret [my packNumericDouble [my extract $d 1]]
	label extractInt:
	    set i [my GetWide $value]
	    my ret [my packNumericInt [my packInt64 [my extract $i 1]]]
	}




































	##### Function tcl.extractDouble #####
	#
	# Type signature: value:STRING -> DOUBLE
	#
	# Parse a STRING as a DOUBLE; the value is known to be parseable.
	# Part of the implementation of quadcode "narrowToType".
................................................................................

	set f [$m local "tcl.extractInteger" INT<-STRING]
	params value
	build {
	    nonnull $value
	    my ret [my packInt64 [my extract [my GetWide $value] 1]]
	}











































	##### Function tcl.cmp.strstr #####
	#
	# Type signature: value1Ptr:STRING * value2Ptr:STRING -> int
	#
	# Returns the relationship between the two string arguments where
	# numeric comparisons are preferred; -1 if 'value1Ptr' precedes in






>


>
|
>
>
>
|
|
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







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

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>







 







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







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
...
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
....
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
....
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
....
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
....
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
....
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
....
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
....
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
    variable tcl.div tcl.div.32 tcl.div.64 tcl.div.double tcl.mod
    variable tcl.shr tcl.and tcl.or tcl.xor
    variable tcl.eq tcl.ne tcl.lt tcl.le tcl.gt tcl.ge
    variable tcl.not tcl.neg tcl_div
    variable tcl.land tcl.land.double tcl.lor tcl.lor.double
    variable tcl.add.numeric tcl.sub.numeric tcl.mult.numeric tcl.div.numeric
    variable tcl.pow.numeric tcl.land.numeric tcl.lor.numeric tcl.not.numeric
    variable tcl.not.numericOrBoolean
    variable tcl.neg.numeric tcl.eq.numeric tcl.ne.numeric tcl.lt.numeric
    variable tcl.le.numeric tcl.gt.numeric tcl.ge.numeric
    variable tcl.isBoolean tcl.isInteger tcl.isDouble
    variable tcl.isNumeric tcl.isNumericOrBoolean
    variable tcl.isTrue.numerc tcl.isTrue.numericOrBoolean
    variable tcl.isZeroOneBoolean
    variable tcl.extractNumeric tcl.extractNumericOrBoolean
    variable tcl.extractDouble tcl.extractInteger
    variable tcl.stringify.double tcl.stringify.int
    variable tcl.stringify.numeric
    variable tcl.cmp.strstr tcl.cmp.strnum

    # Builder:GrowingBinaryFunction --
    #
    #	Generate a function that implements a (normal) mathematical operator
    #	that can increase the width of its result relative to the width of its
    #	input values. Only called from @supportFunctions method.
................................................................................
	build {
	    my condBr [my isNumericInt $value] $intNot $dblNot
	label intNot "int.not"
	    my ret [my not(INT) [my numeric.int $value] [my null int]]
	label dblNot "double.not"
	    my ret [my not(DOUBLE) [my numeric.double $value] [my null int]]
	}

	##### Function tcl.not.numericOrBoolean #####
	#
	# Type signature: x:NUMERIC\040BOOLEAN -> ZEROONE
	#
	# Quadcode implementation ('not')
	#
	# Logical negation of 'x'.

	set f [$m local "tcl.not.numericOrBoolean" "ZEROONE<-NUMERIC BOOLEAN" \
		   readonly]
	params value
	build {
	    my switch [my getNumericBooleanKind $value] \
		$boolNot 0 $intNot 1 $dblNot
	label intNot "int.not"
	    my ret [my not(INT) [my numericOrBoolean.int $value] [my null int]]
	label dblNot "double.not"
	    my ret [my not(DOUBLE) [my numericOrBoolean.double $value] \
			[my null int]]
	label boolNot "bool.not"
	    my ret [my not [my numericOrBoolean.bool $value]]
	}

	##### Function tcl.neg.numeric #####
	#
	# Type signature: x:NUMERIC -> NUMERIC
	#
	# Quadcode implementation ('neg').
	#
................................................................................
	    my condBr [my isNumericInt $value] $int $double
	label int "op.int"
	    my ret [my Call tcl.stringify.int [my numeric.int $value]]
	label double "op.double"
	    my ret [my Call tcl.stringify.double [my numeric.double $value]]
	}

	##### tcl.stringify.numericOrBoolean #####
	#
	# Type signature: value:NUMERIC BOOLEAN -> STRING
	#
	# Convert 'value' to a zero-refcount string (Tcl_Obj)
	#
	# Notes:
	#	It is puzzling why this needs to happen; somewhere
	#	someone wants one of these stringified and doesn't
	#	have the string rep already?

	# TODO - Fill this in if it's actually needed?
    }
 
    method @numericConverterFunctions {api} {

	##### Function tcl.impl.isBoolean #####
	##### Closure Build:isBoolean #####
	#
	# Type signature objPtr:STRING -> int1
	#
	# Tests if a STRING is already a wrapped Boolean word
	# (true/false, yes/no, on/off)

	set f [$m local "tcl.impl.isBoolean" int1<-STRING readonly]
	params objPtr
	build {
	    nonnull $objPtr
	    set boolType [$api tclBooleanType]
	    set type [my dereference $objPtr 0 Tcl_Obj.typePtr]
	    my ret [my and [my nonnull $type] [my eq $boolType $type]]
	}
	my closure isBoolean {STRING {name ""}} {
	    my call ${tcl.impl.isBoolean} [list $STRING] $name
	}

	##### Function tcl.impl.isDouble #####
	##### Closure Build:isDouble #####
	#
	# Type signature: objPtr:STRING -> int1
	#
	# Test if a STRING is actually already a wrapped double.

................................................................................
	    set b2 [$api Tcl_GetString $value]
	    SetValueName $b2 "bytes"
	    my br $get
	label get:
	    set bytes [my phi [list $b1 $b2] [list $entry $generate] "bytes"]
	    my ret [my eq [my dereference $bytes 0] [Const 0 int8]]
	}


	##### Function tcl.isNumeric #####
	#
	# Type signature: value:STRING -> ZEROONE
	#
	# Tests if a STRING can be parsed as a NUMERIC. Part of the
	# implementation of quadcode "instanceOf".
................................................................................
	    my condBr [my isInteger $value] $yes $checkEmptyOK
	label checkEmptyOK:
	    my condBr $emptyOK $checkEmpty $checkDouble
	label checkEmpty:
	    my condBr [my Call tcl.impl.strempty $value] $yes $checkDouble
	label checkDouble:
	    set d [my GetDouble $value]
	    my ret [my extract $d 0]
	label yes:
	    my ret [Const true bool]
	}

	##### Function: tcl.isNumericOrBoolean #####
	#
	# Type signature: value:STRING -> ZEROONE
	#
	# Tests if a STRING can be parsed as either a NUMERIC or BOOLEAN
	# (and hence might be an argument to commands like 'if'). Part of
	# the implementation of quadcode 'instanceOf'.

	set f [$m local "tcl.isNumericOrBoolean" ZEROONE<-STRING]
	params value
	build {
	    nonnull $value
	    my condBr [my nonnull [my dereference $value 0 Tcl_Obj.typePtr]] \
		$checkTypes $getDouble
	label checkTypes:
	    my condBr [my isDouble $value] $yes $checkIntType
	label checkIntType:
	    my condBr [my isInteger $value] $yes $checkBooleanType
	label checkBooleanType:
	    my condBr [my isBoolean $value] $yes $getDouble
	label getDouble:
	    set d [my GetDouble $value]
	    my condBr [my extract $d 0] $yes $getBool
	label getBool:
	    set b [my GetBoolean $value]
	    my ret [my extract $b 0]
	label yes:
	    my ret [Const true bool]
	}

	##### Function tcl.isBoolean #####
	#
	# Type signature: value:STRING->ZEROONE
	#
	# Tests if a STRING can be parsed as a BOOLEAN. Part of the
	# implementation of quadcodes 'instanceOf' and 'isBoolean'.

	set f [$m local "tcl.isBoolean" ZEROONE<-STRING,ZEROONE]
	params value emptyOK
	build {
	    nonnull $value
	    my condBr [my isBoolean $value] $yes $checkEmptyOK
	label checkEmptyOK:
	    my condBr $emptyOK $checkEmpty $getBoolean     
        label checkEmpty:
	    my condBr [my Call ${tcl.impl.strempty} $value] $yes $getBoolean
	label getBoolean:
	    set bv [my GetBoolean $value]
	    my ret [my extract $bv 0]
	label yes:
	    my ret [Const true bool]
	}

	##### Function tcl.isDouble #####
	#
	# Type signature: value:STRING -> ZEROONE
................................................................................
	params value emptyOK
	build {
	    nonnull $value
	    my condBr [my isDouble $value] $yes $checkEmptyOK
	label checkEmptyOK:
	    my condBr $emptyOK $checkEmpty $checkDouble
	label checkEmpty:
	    my condBr [my Call ${tcl.impl.strempty} $value] $yes $checkDouble
	label checkDouble:
	    set d [my GetDouble $value]
	    my ret [my extract $d 0]
	label yes:
	    my ret [Const true bool]
	}

................................................................................
	    my condBr [my Call tcl.impl.strempty $value] $yes $checkInt
	label checkInt:
	    set i [my GetWide $value]
	    my ret [my extract $i 0]
	label yes:
	    my ret [Const true bool]
	}

	##### Function tcl.isZeroOneBoolean #####
	#
	# Type signature: value:STRING -> ZEROONE
	#
	# Tests if a STRING can be parsed as a ZEROONE BOOLEAN. Part of the
	# implementation of quadcode "instanceOf"

	set f [$m local "tcl.isZeroOneBoolean" ZEROONE<-STRING,ZEROONE]
	params value emptyOK
	build {
	    nonnull $value
	    my br $checkInt
	label checkInt:
	    my condBr [my isInteger $value] $checkZeroOne $checkEmptyOK
	label checkZeroOne:
	    set gw [my GetWide $value]
	    my condBr [my extract $gw 0] $testZeroOne $no
        label testZeroOne:
	    set val [my extract $gw 1]
	    my switch $val $no 0 $yes 1 $yes
	label checkEmptyOK:
	    my condBr $emptyOK $checkEmpty $tryGetBoolean
	label checkEmpty:
	    my condBr [my Call tcl.impl.strempty $value] $yes $tryGetBoolean
	label tryGetBoolean:
	    set i [my GetBoolean $value]
	    my condBr [my extract $i 0] $yes $tryGetInt
	label tryGetInt:
	    set i [my GetWide $value]
	    my condBr [my extract $i 0] $no $checkZeroOne
	label yes:
	    my ret [Const true bool]
	label no:
	    my ret [Const false bool]
	}

	##### Function tcl.extractNumeric #####
	#
	# Type signature: value:STRING -> NUMERIC
	#
	# Parse a STRING as a NUMERIC; the value is known to be parseable.
	# Part of the implementation of quadcode "narrowToType".
................................................................................
	    my condBr [my isDouble $value] $returnDouble $extractInt
	label returnDouble:
	    my ret [my packNumericDouble [my extract $d 1]]
	label extractInt:
	    set i [my GetWide $value]
	    my ret [my packNumericInt [my packInt64 [my extract $i 1]]]
	}

	##### Function: tcl.extractNumericOrBoolean #####
	#
	# Type signature: value:STRING -> NUMERIC BOOLEAN
	#
	# Parse a STRING as a NUMERIC or Boolean; the value is known to
	# be parsable. Part of the implementation of quadcode 'narrowToType'.

	set f [$m local "tcl.extractNumericOrBoolean" "NUMERIC BOOLEAN<-STRING"]
	params value
	build {
	    nonnull $value
	    my br $testType
	label testType:
	    set type [my dereference $value 0 Tcl_Obj.typePtr]
	    my condBr [my nonnull $type] $testIsInt $testIsBoolean
        label testIsInt:
	    my condBr [my isInteger $value] $returnInt $testIsDouble
	label returnInt:
	    set i [my GetWide $value]
	    my ret [my packNumericOrBooleanInt [my packInt64 [my extract $i 1]]]
	label testIsDouble:
	    my condBr [my isDouble $value] $returnDouble $testIsBoolean
	label returnDouble:
	    set d [my GetDouble $value]
	    my ret [my packNumericOrBooleanDouble [my extract $d 1]]
	label testIsBoolean:
	    set b [my GetBoolean $value]
	    my condBr [my extract $b 0] $returnBoolean $getDouble
	label returnBoolean:
	    my ret [my packNumericOrBooleanBoolean [my extract $b 1]]
	label getDouble:
	    set i [my GetDouble $value]
	    my br $testType
	}
			
	##### Function tcl.extractDouble #####
	#
	# Type signature: value:STRING -> DOUBLE
	#
	# Parse a STRING as a DOUBLE; the value is known to be parseable.
	# Part of the implementation of quadcode "narrowToType".
................................................................................

	set f [$m local "tcl.extractInteger" INT<-STRING]
	params value
	build {
	    nonnull $value
	    my ret [my packInt64 [my extract [my GetWide $value] 1]]
	}

	##### Function: tcl.isTrue.numeric #####
	#
	# Type signature: value:STRING->ZEROONE
	#
	# Determines whether a given NUMERIC value represents a value
	# that will cause 'jumpTrue' to jump. Part of the implementation
	# of quadcodes 'jumpTrue' and 'jumpFalse'

	set f [$m local "tcl.isTrue.numeric" ZEROONE<-NUMERIC]
	params value
	build {
	    my condBr [my isNumericInt $value] $doInteger $doDouble
	label doInteger:
	    my ret [my neq(INT,INT) [my numeric.int $value] [my int 0]]
	label doDouble:
	    my ret [my neq(DOUBLE,DOUBLE) \
			[my numericOrBoolean.double $value] [Const 0.0 double]]
	}

	##### Function: tcl.isTrue.numericOrBoolean #####
	#
	# Type signature: value:STRING->ZEROONE
	#
	# Determines whether a given NUMERIC BOOLEAN value represents a value
	# that will cause 'jumpTrue' to jump. Part of the implementation
	# of quadcodes 'jumpTrue' and 'jumpFalse'

	set f [$m local "tcl.isTrue.numericOrBoolean" \
		   {ZEROONE<-NUMERIC BOOLEAN}]
	params value
	build {
	    my switch [my getNumericBooleanKind $value] \
		$doBoolean 0 $doInteger 1 $doDouble
	label doBoolean:
	    my ret [my numericOrBoolean.bool $value]
	label doInteger:
	    my ret [my neq(INT,INT) [my numericOrBoolean.int $value] [my int 0]]
	label doDouble:
	    my ret [my neq(DOUBLE,DOUBLE) \
			[my numericOrBoolean.double $value] [Const 0.0 double]]
	}
	
	##### Function tcl.cmp.strstr #####
	#
	# Type signature: value1Ptr:STRING * value2Ptr:STRING -> int
	#
	# Returns the relationship between the two string arguments where
	# numeric comparisons are preferred; -1 if 'value1Ptr' precedes in

Changes to codegen/stdlib.tcl.

201
202
203
204
205
206
207










































208
209
210
211
212
213
214
...
650
651
652
653
654
655
656
























657
658
659
660
661
662
663
....
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228

4229
4230
4231
4232
4233
4234
4235
	label decr "action.required"
	    set value [my unmaybe $value "objPtr"]
	    $api Tcl_DecrRefCount $value
	    my ret
	label nothing "nothing.to.do"
	    my ret
	}











































	##### tcl.addNExistReference #####
	#
	# Type signature: objPtr:Tcl_Obj*! -> void
	#
	# Increment the reference count of a Tcl_Obj reference if the
	# object is supplied
................................................................................
	    set strType [$api tclStringType]
	    set type [my dereference $objPtr 0 Tcl_Obj.typePtr]
	    my ret [my eq $type $strType]
	}
	my closure isUnicodeString {STRING {name ""}} {
	    my call ${tcl.isUnicodeString} [list $STRING] $name
	}

























	##### Function tcl.impl.getDouble #####
	##### MAPPED CALL TO METHOD: Build:GetDouble #####
	#
	# Type signature: valueObj:STRING -> int * int8[]
	#
	# Gets the (pseudo-)UTF-8 version of a string. Wrapper around Tcl API
................................................................................

	##### Function tcl.booleanTest #####
	#
	# Type signature: objPtr:Tcl_Obj* -> ZEROONE
	#
	# Part of quadcode implementation ('isBoolean')
	#
	# Returns whether the string 'objPtr' is a boolean value.

	set f [$m local "tcl.booleanTest" ZEROONE<-Tcl_Obj*]
	params objPtr
	build {
	    nonnull $objPtr
	    set NULL [my null Interp*]
	    set code [my setFromAny [$api tclBooleanType] $NULL $objPtr]
	    my ret [my eq $code $0]
	}


	##### Function tcl.invoke.command #####
	#
	# Type signature: objc:int * objv:STRING* * ecvar:int* -> STRING?
	#
	# Calls the Tcl interpreter to invoke a Tcl command, and packs the
	# result into a STRING FAIL.







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|










>







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
...
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
....
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
	label decr "action.required"
	    set value [my unmaybe $value "objPtr"]
	    $api Tcl_DecrRefCount $value
	    my ret
	label nothing "nothing.to.do"
	    my ret
	}

	##### tcl.maybeAddReference #####
	#
	# Type signature: maybe:bool,objPtr:Tcl_Obj* -> void
	#
	# Increment the reference count of a Tcl_Obj if the
	# object exists.

	set f [$m local "tcl.maybeAddReference" void<-bool,Tcl_Obj*]
	params maybe value
	build {
	    my condBr $maybe $nothing $incr
	label incr "action.required"
	    $api Tcl_IncrRefCount $value
	    my ret
	label nothing "nothing.to.do"
	    my ret
	}
	my closure impure.maybeAddReference {maybe value} {
	    my call ${tcl.maybeAddReference} [list $maybe $value]
	}

	##### tcl.maybeDropReference #####
	#
	# Type signature: maybe:bool,objPtr:Tcl_Obj* -> void
	#
	# Decrement the reference count of a Tcl_Obj if the
	# object exists.

	set f [$m local "tcl.maybeDropReference" void<-bool,Tcl_Obj*]
	params maybe value
	build {
	    my condBr $maybe $nothing $decr
	label decr "action.required"
	    $api Tcl_DecrRefCount $value
	    my ret
	label nothing "nothing.to.do"
	    my ret
	}
	my closure impure.maybeDropReference {maybe value} {
	    my call ${tcl.maybeDropReference} [list $maybe $value]
	}

	##### tcl.addNExistReference #####
	#
	# Type signature: objPtr:Tcl_Obj*! -> void
	#
	# Increment the reference count of a Tcl_Obj reference if the
	# object is supplied
................................................................................
	    set strType [$api tclStringType]
	    set type [my dereference $objPtr 0 Tcl_Obj.typePtr]
	    my ret [my eq $type $strType]
	}
	my closure isUnicodeString {STRING {name ""}} {
	    my call ${tcl.isUnicodeString} [list $STRING] $name
	}

	##### Function tcl.impl.getBoolean #####
	##### MAPPED CALL TO METHOD: Build:GetBoolean #####
	#
	# Type signature: valueObj:STRING -> int1*int1

	set f [$m local "tcl.impl.getBoolean" struct{int1,int1}<-STRING]
	params valueObj
	build {
	    nonnull $valueObj
	    set boolVar [my alloc int32 "boolPtr"]
	    set str [$api Tcl_GetString $valueObj]
	    set code [$api Tcl_GetBooleanFromObj {} $valueObj $boolVar]
	    set res [my undef struct{int1,int1}]
	    set res [my insert $res [my eq $code [Const 0]] 0]
	    set res \
		[my insert $res [my neq [my load $boolVar "bool"] [Const 0]] 1]
	    my ret $res
	}
	my closure GetBoolean {valueObj} {
	    my call ${tcl.impl.getBoolean} [list $valueObj] "result"
	}
	unset -nocomplain valueObj
	

	##### Function tcl.impl.getDouble #####
	##### MAPPED CALL TO METHOD: Build:GetDouble #####
	#
	# Type signature: valueObj:STRING -> int * int8[]
	#
	# Gets the (pseudo-)UTF-8 version of a string. Wrapper around Tcl API
................................................................................

	##### Function tcl.booleanTest #####
	#
	# Type signature: objPtr:Tcl_Obj* -> ZEROONE
	#
	# Part of quadcode implementation ('isBoolean')
	#
	# Returns whether the string 'objPtr' is a Boolean bareword

	set f [$m local "tcl.booleanTest" ZEROONE<-Tcl_Obj*]
	params objPtr
	build {
	    nonnull $objPtr
	    set NULL [my null Interp*]
	    set code [my setFromAny [$api tclBooleanType] $NULL $objPtr]
	    my ret [my eq $code $0]
	}
	

	##### Function tcl.invoke.command #####
	#
	# Type signature: objc:int * objv:STRING* * ecvar:int* -> STRING?
	#
	# Calls the Tcl interpreter to invoke a Tcl command, and packs the
	# result into a STRING FAIL.

Changes to codegen/struct.tcl.

679
680
681
682
683
684
685

686
687
688
689
690
691
692
....
1522
1523
1524
1525
1526
1527
1528






1529
1530
1531
1532
1533
1534
1535
....
1563
1564
1565
1566
1567
1568
1569

1570
1571
1572
1573
1574
1575
1576
....
2603
2604
2605
2606
2607
2608
2609



2610
2611
2612



2613
2614
2615



2616
2617
2618







2619
2620
2621
2622
2623
2624
2625
....
2663
2664
2665
2666
2667
2668
2669








2670
2671
2672
2673
2674
2675
2676
....
2678
2679
2680
2681
2682
2683
2684












2685
2686
2687
2688
2689
2690
2691
....
2693
2694
2695
2696
2697
2698
2699



2700
2701
2702
2703
2704
2705
2706
2707

2708
2709
2710
2711
2712
2713
2714
....
2766
2767
2768
2769
2770
2771
2772
2773








2774
2775
2776


2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793

2794
2795
2796
2797
2798
2799
2800
    #
    # Results:
    #	None.

    method InitTclTypes {} {
	# WARNING: int type may need to be larger on some platforms!
	Type NUMERIC; # Make sure we get this early, just in case


	# Debug-world delegates for the basic types
	DBTY void <- void   void "void"
	DBTY ptr  <- ClientData  pointer "ClientData" $void
	DBTY chr  <- char   int "char" 8
	DBTY chrs <- char*  pointer "char*" $chr
	DBTY i16  <- int16  int "Tcl_UniChar" 16
................................................................................
	    i32:int32
	    i64:int64
	}
	struct NUMERIC {
	    kind:bool
	    int:INT
	    double:double






	}
	struct FOREACH {
	    val:int
	    max:int
	}
	struct DICTFOR {
	    search:DictSearch
................................................................................
	foreach {ty rt1} {
	    i32      int32
	    i64      int64
	    ZON      ZEROONE
	    INT      INT
	    DBL      DOUBLE
	    NUMERIC  NUMERIC

	    STR      STRING
	    ARY      ARRAY
	    ASTR     ARRAYSTRING
	} {
	    upvar 0 $ty t
	    set rt [linsert $rt1 0 IMPURE]
	    DBTY impure <- $rt struct <$rt1> $Obj $t
................................................................................
	    }
	    {INT DOUBLE} {
		append body2 { [my cast(DOUBLE) $} [lindex $f 0] { cast]}
	    }
	    {{INT BOOLEAN} NUMERIC} {
		append body2 { [my packNumericInt $} [lindex $f 0] { cast]}
	    }



	    {ZEROONE NUMERIC} {
		append body2 { [my packNumericInt [my cast(BOOLEAN) $} [lindex $f 0] { cast]]}
	    }



	    {INT NUMERIC} {
		append body2 { [my packNumericInt $} [lindex $f 0] { cast]}
	    }



	    {DOUBLE NUMERIC} {
		append body2 { [my packNumericDouble $} [lindex $f 0] { cast]}
	    }







	    {{ZEROONE BOOLEAN} ZEROONE} {
		append body2 { $} [lindex $f 0]
	    }
	    {{ZEROONE BOOLEAN} STRING} {
		set var [lindex $f 0]
		append body1 ";" [string trim [subst -nocommands {
		    lappend {string casts} [set $var [my {stringify($t)} $$var]]
................................................................................
		set var [lindex $f 0]
		append body1 ";" [string trim [subst -nocommands {
		    lappend {string casts} [set $var [my {stringify($t)} $$var]]
		    my addReference(STRING) $$var
		}]]
		append body2 { $} [lindex $f 0]
	    }








	    {EMPTY STRING} {
		append body2 { $} [lindex $f 0]
	    }
	    {{IMPURE ZEROONE} {IMPURE INT}} {
		append body2 [format { [my upcastImpure.INT(ZEROONE) $%s]} [lindex $f 0]]
	    }
	    {{IMPURE ZEROONE} {IMPURE NUMERIC}} {
................................................................................
	    }
	    {{IMPURE INT} {IMPURE NUMERIC}} {
		append body2 [format { [my upcastImpure.NUMERIC(INT) $%s]} [lindex $f 0]]
	    }
	    {{IMPURE DOUBLE} {IMPURE NUMERIC}} {
		append body2 [format { [my upcastImpure.NUMERIC(DOUBLE) $%s]} [lindex $f 0]]
	    }












	    {NOTHING STRING} {
		append body2 { [my undef STRING]}
	    }
	    {{EXPANDED STRING} STRING} {
		append body2 { $} [lindex $f 0]
	    }
	    {{EXPANDED INT} INT} {
................................................................................
	    }
	    {{EXPANDED DOUBLE} DOUBLE} {
		append body2 { $} [lindex $f 0]
	    }
	    {{EXPANDED NUMERIC} NUMERIC} {
		append body2 { $} [lindex $f 0]
	    }



	}

	foreach type {
	    BOOLEAN
	    ZEROONE {ZEROONE BOOLEAN}
	    INT {INT BOOLEAN}
	    DOUBLE
	    NUMERIC

	} {
	    set impureType [linsert $type 0 IMPURE]

	    dict set TypeConversions [list $type $impureType] [string trim \
		    [string map [list @type $type] {
			set var [lindex $f 0]
			append body2 { [my {packImpure(@type)} $} $var {]}
................................................................................
    #	FOLLOWS STANDARD TclOO PROTOCOL
    #
    # Side effects:
    # 	May create a method. May perform a tailcall (beware if attempting to
    # 	wrap with a filter!)

    method unknown {methodName args} {
	if {[regexp {^addReference\(FAIL IMPURE (.*)\)$} \








		 $methodName -> utype]} {
	    oo::objdefine [self] method $methodName {value} \
		[string map [list @utype $utype] {


		    my addReference(STRING) \
			[my impure.string [my unmaybe $value]]
		    # How to determine whether the underlying type is
		    # itself a reference type? (Maybe never?)
		    #my {addReference(@utype)} [my impure.value $value]
		}]
	    tailcall my $methodName {*}$args
	} elseif {[regexp {^addReference\(IMPURE[ _](.*)\)$} \
		       $methodName -> utype]} {
	    oo::objdefine [self] method $methodName {value} \
		[string map [list @utype $utype] {
		    my addReference(STRING) [my impure.string $value]
		    # How to determine whether the underlying type is
		    # itself a reference type? (Maybe never?)
		    #my {addReference(@utype)} [my impure.value $value]
		}]
	    tailcall my $methodName {*}$args

	} elseif {[regexp {^dropReference\(IMPURE[ _](.*)\)$} $methodName \
		       -> utype]} {
	    oo::objdefine [self] method $methodName {value} \
		[string map [list @utype $utype] {
		    my dropReference(STRING) [my impure.string $value]
		    # How to determine whether the underlying type is
		    # itself a reference type? (Maybe never?)






>







 







>
>
>
>
>
>







 







>







 







>
>
>



>
>
>



>
>
>



>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>








>







 







|
>
>
>
>
>
>
>
>



>
>
|
|
<
<
<







<
<
<


>







679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
....
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
....
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
....
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
....
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
....
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
....
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
....
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836



2837
2838
2839
2840
2841
2842
2843



2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
    #
    # Results:
    #	None.

    method InitTclTypes {} {
	# WARNING: int type may need to be larger on some platforms!
	Type NUMERIC; # Make sure we get this early, just in case
	Type "NUMERIC BOOLEAN"

	# Debug-world delegates for the basic types
	DBTY void <- void   void "void"
	DBTY ptr  <- ClientData  pointer "ClientData" $void
	DBTY chr  <- char   int "char" 8
	DBTY chrs <- char*  pointer "char*" $chr
	DBTY i16  <- int16  int "Tcl_UniChar" 16
................................................................................
	    i32:int32
	    i64:int64
	}
	struct NUMERIC {
	    kind:bool
	    int:INT
	    double:double
	}
	struct NUMERIC_BOOLEAN {
	    kind:int3
	    int:INT
	    double:double
	    bool:bool
	}
	struct FOREACH {
	    val:int
	    max:int
	}
	struct DICTFOR {
	    search:DictSearch
................................................................................
	foreach {ty rt1} {
	    i32      int32
	    i64      int64
	    ZON      ZEROONE
	    INT      INT
	    DBL      DOUBLE
	    NUMERIC  NUMERIC
	    NUMERIC_BOOLEAN "NUMERIC BOOLEAN"
	    STR      STRING
	    ARY      ARRAY
	    ASTR     ARRAYSTRING
	} {
	    upvar 0 $ty t
	    set rt [linsert $rt1 0 IMPURE]
	    DBTY impure <- $rt struct <$rt1> $Obj $t
................................................................................
	    }
	    {INT DOUBLE} {
		append body2 { [my cast(DOUBLE) $} [lindex $f 0] { cast]}
	    }
	    {{INT BOOLEAN} NUMERIC} {
		append body2 { [my packNumericInt $} [lindex $f 0] { cast]}
	    }
	    {{INT BOOLEAN} {NUMERIC BOOLEAN}} {
		append body2 { [my packNumericOrBooleanInt $} [lindex $f 0] { cast]}
	    }
	    {ZEROONE NUMERIC} {
		append body2 { [my packNumericInt [my cast(BOOLEAN) $} [lindex $f 0] { cast]]}
	    }
	    {ZEROONE {NUMERIC BOOLEAN}} {
		append body2 { [my packNumericOrBooleanInt $} [lindex $f 0] { cast]}
	    }
	    {INT NUMERIC} {
		append body2 { [my packNumericInt $} [lindex $f 0] { cast]}
	    }
	    {INT {NUMERIC BOOLEAN}} {
		append body2 { [my packNumericOrBooleanInt $} [lindex $f 0] { cast]}
	    }
	    {DOUBLE NUMERIC} {
		append body2 { [my packNumericDouble $} [lindex $f 0] { cast]}
	    }
	    {DOUBLE {NUMERIC BOOLEAN}} {
		append body2 { [my packNumericOrBooleanDouble $} [lindex $f 0] { cast]}
	    }
	    {BOOLEAN {NUMERIC BOOLEAN}} {
		append body2 { [my packNumericOrBooleanBoolean $} [lindex $f 0] { cast]}
	    }

	    {{ZEROONE BOOLEAN} ZEROONE} {
		append body2 { $} [lindex $f 0]
	    }
	    {{ZEROONE BOOLEAN} STRING} {
		set var [lindex $f 0]
		append body1 ";" [string trim [subst -nocommands {
		    lappend {string casts} [set $var [my {stringify($t)} $$var]]
................................................................................
		set var [lindex $f 0]
		append body1 ";" [string trim [subst -nocommands {
		    lappend {string casts} [set $var [my {stringify($t)} $$var]]
		    my addReference(STRING) $$var
		}]]
		append body2 { $} [lindex $f 0]
	    }
	    {{NUMERIC BOOLEAN} STRING} {
		set var [lindex $f 0]
		append body1 ";" [string trim [subst -nocommands {
		    lappend {string casts} [set $var [my {stringify($t)} $$var]]
		    my addReference(STRING) $$var
		}]]
		append body2 { $} [lindex $f 0]
	    }
	    {EMPTY STRING} {
		append body2 { $} [lindex $f 0]
	    }
	    {{IMPURE ZEROONE} {IMPURE INT}} {
		append body2 [format { [my upcastImpure.INT(ZEROONE) $%s]} [lindex $f 0]]
	    }
	    {{IMPURE ZEROONE} {IMPURE NUMERIC}} {
................................................................................
	    }
	    {{IMPURE INT} {IMPURE NUMERIC}} {
		append body2 [format { [my upcastImpure.NUMERIC(INT) $%s]} [lindex $f 0]]
	    }
	    {{IMPURE DOUBLE} {IMPURE NUMERIC}} {
		append body2 [format { [my upcastImpure.NUMERIC(DOUBLE) $%s]} [lindex $f 0]]
	    }
	    {{IMPURE ZEROONE} {IMPURE {NUMERIC BOOLEAN}}} {
		append body2 [format { [my upcastImpure.NUMERIC\040BOOLEAN(ZEROONE) $%s]} [lindex $f 0]]
	    }
	    {{IMPURE INT} {IMPURE NUMERIC}} {
		append body2 [format { [my upcastImpure.NUMERIC\040BOOLEAN(INT) $%s]} [lindex $f 0]]
	    }
	    {{IMPURE DOUBLE} {IMPURE NUMERIC}} {
		append body2 [format { [my upcastImpure.NUMERIC\040BOOLEAN(DOUBLE) $%s]} [lindex $f 0]]
	    }
	    {{IMPURE BOOLEAN} {IMPURE NUMERIC}} {
		append body2 [format { [my upcastImpure.NUMERIC\040BOOLEAN(BOOLEAN) $%s]} [lindex $f 0]]
	    }
	    {NOTHING STRING} {
		append body2 { [my undef STRING]}
	    }
	    {{EXPANDED STRING} STRING} {
		append body2 { $} [lindex $f 0]
	    }
	    {{EXPANDED INT} INT} {
................................................................................
	    }
	    {{EXPANDED DOUBLE} DOUBLE} {
		append body2 { $} [lindex $f 0]
	    }
	    {{EXPANDED NUMERIC} NUMERIC} {
		append body2 { $} [lindex $f 0]
	    }
	    {{EXPANDED {NUMERIC BOOLEAN}} {NUMERIC BOOLEAN}} {
		append body2 { $} [lindex $f 0]
	    }
	}

	foreach type {
	    BOOLEAN
	    ZEROONE {ZEROONE BOOLEAN}
	    INT {INT BOOLEAN}
	    DOUBLE
	    NUMERIC
	    {NUMERIC BOOLEAN}
	} {
	    set impureType [linsert $type 0 IMPURE]

	    dict set TypeConversions [list $type $impureType] [string trim \
		    [string map [list @type $type] {
			set var [lindex $f 0]
			append body2 { [my {packImpure(@type)} $} $var {]}
................................................................................
    #	FOLLOWS STANDARD TclOO PROTOCOL
    #
    # Side effects:
    # 	May create a method. May perform a tailcall (beware if attempting to
    # 	wrap with a filter!)

    method unknown {methodName args} {
	if {[regexp {^addReference\(FAIL[ _]IMPURE (.*)\)$} \
		 $methodName -> utype]} {
	    oo::objdefine [self] method $methodName {value} \
		[string map [list @utype $utype] {
		    set sval [my impure.string [my unmaybe $value]]
		    my impure.maybeAddReference [my maybe $value] $sval
		}]
	    tailcall my $methodName {*}$args
	} elseif {[regexp {^dropReference\(FAIL[ _]IMPURE[ _](.*)\)$} \
		       $methodName -> utype]} {
	    oo::objdefine [self] method $methodName {value} \
		[string map [list @utype $utype] {
		    my select [my maybe $value] \
			[Const false bool] \
			[my addReference(STRING) \
			     [my impure.string [my unmaybe $value]]]



		}]
	    tailcall my $methodName {*}$args
	} elseif {[regexp {^addReference\(IMPURE[ _](.*)\)$} \
		       $methodName -> utype]} {
	    oo::objdefine [self] method $methodName {value} \
		[string map [list @utype $utype] {
		    my addReference(STRING) [my impure.string $value]



		}]
	    tailcall my $methodName {*}$args

	} elseif {[regexp {^dropReference\(IMPURE[ _](.*)\)$} $methodName \
		       -> utype]} {
	    oo::objdefine [self] method $methodName {value} \
		[string map [list @utype $utype] {
		    my dropReference(STRING) [my impure.string $value]
		    # How to determine whether the underlying type is
		    # itself a reference type? (Maybe never?)

Changes to codegen/tclapi.tcl.

2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
	# Special "constants"
	my buildInSection APIvar {
	    my APIVar tclIntType \
		[set it [my Tcl_GetObjType [$b constString "int" "type.int"]]]
	    my APIVar tclDoubleType \
		[my Tcl_GetObjType [$b constString "double" "type.double"]]
	    my APIVar tclBooleanType \
		[my Tcl_GetObjType [$b constString "boolean" "type.boolean"]]
	    my APIVar tclByteArrayType \
		[my Tcl_GetObjType [$b constString "bytearray" "type.bytes"]]
	    my APIVar tclStringType \
		[my Tcl_GetObjType [$b constString "string" "type.string"]]
	    set wt [my Tcl_GetObjType [$b constString "wideInt" "type.wide"]]
	    my APIVar tclWideIntType [$b select [$b nonnull $wt] $wt $it]
	    my APIVar tclListType \






|







2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
	# Special "constants"
	my buildInSection APIvar {
	    my APIVar tclIntType \
		[set it [my Tcl_GetObjType [$b constString "int" "type.int"]]]
	    my APIVar tclDoubleType \
		[my Tcl_GetObjType [$b constString "double" "type.double"]]
	    my APIVar tclBooleanType \
		[my Tcl_GetObjType [$b constString "booleanString" type.boolean"]]
	    my APIVar tclByteArrayType \
		[my Tcl_GetObjType [$b constString "bytearray" "type.bytes"]]
	    my APIVar tclStringType \
		[my Tcl_GetObjType [$b constString "string" "type.string"]]
	    set wt [my Tcl_GetObjType [$b constString "wideInt" "type.wide"]]
	    my APIVar tclWideIntType [$b select [$b nonnull $wt] $wt $it]
	    my APIVar tclListType \

Changes to codegen/tycon.tcl.

15
16
17
18
19
20
21





22
23
24
25
26
27
28
...
176
177
178
179
180
181
182



183
184
185
186
187
188
189
    # The actual flag values to use in the INT type
    variable INT.type.32bit 0
    variable INT.type.64bit 1

    # The actual flag values to use in the NUMERIC type
    variable NUMERIC.type.int 0
    variable NUMERIC.type.double 1






    # Named structure types need to be only created once
    variable NamedTypeCache {}
    variable NamedTypeCacheAhead {}

    # LLVM::Const --
    #
................................................................................
	    }
	    "^EXPANDED (.*)$" {
		return [Type [lindex $m 1]]
	    }
	    ^NUMERIC$ {
		return [Type named{NUMERIC,kind:int1,int:INT,double:DOUBLE}]
	    }



	    ^FOREACH$ {
		return [Type named{FOREACH,val:int,max:int}]
	    }
	    ^DICTITER$ {
		return [Type "named{DICTFOR,
			search:DictSearch,
			dict:STRING,






>
>
>
>
>







 







>
>
>







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
...
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
    # The actual flag values to use in the INT type
    variable INT.type.32bit 0
    variable INT.type.64bit 1

    # The actual flag values to use in the NUMERIC type
    variable NUMERIC.type.int 0
    variable NUMERIC.type.double 1

    # The actual flag values to use in the NUMERIC_BOOLEAN type
    variable NUMERIC_BOOLEAN.type.int 0
    variable NUMERIC_BOOLEAN.type.double 1
    variable NUMERIC_BOOLEAN.type.bool 2

    # Named structure types need to be only created once
    variable NamedTypeCache {}
    variable NamedTypeCacheAhead {}

    # LLVM::Const --
    #
................................................................................
	    }
	    "^EXPANDED (.*)$" {
		return [Type [lindex $m 1]]
	    }
	    ^NUMERIC$ {
		return [Type named{NUMERIC,kind:int1,int:INT,double:DOUBLE}]
	    }
	    "^NUMERIC BOOLEAN$" {
		return [Type named{NUMERIC_BOOLEAN,kind:int3,int:INT,double:DOUBLE,bool:bool}]
	    }
	    ^FOREACH$ {
		return [Type named{FOREACH,val:int,max:int}]
	    }
	    ^DICTITER$ {
		return [Type "named{DICTFOR,
			search:DictSearch,
			dict:STRING,

Changes to demos/perftest/tester.tcl.

607
608
609
610
611
612
613





































614
615
616
617
618
619
620
....
1970
1971
1972
1973
1974
1975
1976


























1977
1978
1979
1980
1981
1982
1983
....
2226
2227
2228
2229
2230
2231
2232




2233
2234
2235
2236
2237
2238
2239
    return $result
}

proc concatenater {x} {
    set x [expr {int($x)}]
    concat [expr {$x - 1}] $x [expr {$x + 1.5}] "ok"
}






































proc booltest {val} {
    set res {}
    if {[string is boolean -strict $val]} {
	lappend res ok
    }
    lappend res [string is boolean $val]
................................................................................
    {cmptest2 0e0 0x0}
    {trimtest ABCDABC}
    {trimtest DABCABCD}
    {casetest aBcDe}
    {strclasstest abc123}
    {strclasstest abc-123}
    {concatenater 7}


























    {list [booltest on] [booltest no] [booltest ""] [booltest fruitbat]}
    {stristest ""}
    {stristest x}
    {stristest 0}
    {stristest 1.2}
    {stristest 0xAB}
    # List operations (also see some [try] tests)
................................................................................
    cmptest
    cmptest2
    matchtest
    replacing replacing2 replacing3
    strclasstest
    jumptable
    concatenater




    booltest
    stristest
    regsubtest
    # Failure handling, [subst], [try]
    wideretest
    substtest
    substtest2






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
>
>







607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
....
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
....
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
    return $result
}

proc concatenater {x} {
    set x [expr {int($x)}]
    concat [expr {$x - 1}] $x [expr {$x + 1.5}] "ok"
}

proc nottest {val} {
    expr {!$val}
}

proc iftest {val} {
    if {$val} {return yes} {return no}
}

proc landtest {val} {
    expr {$val && $val}

    # Tcl 8.7 does not generate INST_LAND except when the bytecode assembler
    # requests it. If we wanted to test INST_LAND, we'd need a sequence like
    #
    #    tcl::unsupported::assemble {
    #	     load val
    #	     load val
    #	     land
    #    }
}

proc lortest {val} {
    expr {$val || $val}

    # Tcl 8.7 does not generate INST_LOR except when the bytecode assembler
    # requests it. If we wanted to test INST_LOR, we'd need a sequence like
    #
    #    tcl::unsupported::assemble {
    #	     load val
    #	     load val
    #	     lor
    #    }
    #
    # But that's not implemented in the code generator, and there's no
    # really good reason to implement it, since Tcl doesn't use it.
}

proc booltest {val} {
    set res {}
    if {[string is boolean -strict $val]} {
	lappend res ok
    }
    lappend res [string is boolean $val]
................................................................................
    {cmptest2 0e0 0x0}
    {trimtest ABCDABC}
    {trimtest DABCABCD}
    {casetest aBcDe}
    {strclasstest abc123}
    {strclasstest abc-123}
    {concatenater 7}
    {nottest 1}
    {nottest 0}
    {nottest 2.0}
    {nottest true}
    {list [catch {nottest fruitbat} stat] $stat}
    {iftest yes}
    {iftest no}
    {iftest 1}
    {iftest 0}
    {iftest 0.0}
    {iftest 2.0}
    {list [catch {iftest fruitbat} stat] $stat}
    {landtest yes}
    {landtest no}
    {landtest 1}
    {landtest 0}
    {landtest 2.0}
    {landtest 0.0}
    {list [catch {landtest fruitbat} stat] $stat}
    {lortest yes}
    {lortest no}
    {lortest 1}
    {lortest 0}
    {lortest 2.0}
    {lortest 0.0}
    {list [catch {lortest fruitbat} stat] $stat}
    {list [booltest on] [booltest no] [booltest ""] [booltest fruitbat]}
    {stristest ""}
    {stristest x}
    {stristest 0}
    {stristest 1.2}
    {stristest 0xAB}
    # List operations (also see some [try] tests)
................................................................................
    cmptest
    cmptest2
    matchtest
    replacing replacing2 replacing3
    strclasstest
    jumptable
    concatenater
    nottest
    iftest
    landtest
    lortest
    booltest
    stristest
    regsubtest
    # Failure handling, [subst], [try]
    wideretest
    substtest
    substtest2

Changes to quadcode/abbreviate.tcl.

224
225
226
227
228
229
230






231
232
233
234
235
236
237
...
254
255
256
257
258
259
260










261
262
263
264
265
266
267
}

# quadcode::bytecodeAbbreviator1 --
#
#	Singleton instance of the bytecode abbreviator.

quadcode::bytecodeAbbreviator create quadcode::bytecodeAbbreviator1 {







    stringIsIntStrict {
	numericType
	dup
	jumpFalse1 +5
	push1 {literal 1}
	eq
................................................................................
    }

    stringIsDoubleStrict {
	numericType
	jumpTrue1 +6
	push1 {literal 0}
	jump1 +4










	push1 {literal 1}
    }

    stringIsInt {
	dup
	numericType
	dup






>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
...
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
}

# quadcode::bytecodeAbbreviator1 --
#
#	Singleton instance of the bytecode abbreviator.

quadcode::bytecodeAbbreviator create quadcode::bytecodeAbbreviator1 {

    stringIsBooleanStrict {
	tryCvtToBoolean
	reverse 2
	pop
    }

    stringIsIntStrict {
	numericType
	dup
	jumpFalse1 +5
	push1 {literal 1}
	eq
................................................................................
    }

    stringIsDoubleStrict {
	numericType
	jumpTrue1 +6
	push1 {literal 0}
	jump1 +4
	push1 {literal 1}
    }

    stringIsBoolean {
	tryCvtToBoolean
	jumpTrue1 +7
	push {literal {}}
	streq
	jump1 +5
	pop
	push1 {literal 1}
    }

    stringIsInt {
	dup
	numericType
	dup

Changes to quadcode/bytecode.tcl.

465
466
467
468
469
470
471


472
473
474
475
476
477
478
	    reverse -
	    storeScalar1 -
	    storeScalar4 -
	    strcaseLower -
	    strcaseTitle -
	    strcaseUpper -
	    strclass -


	    stringIsDouble -
	    stringIsDoubleStrict -
	    stringIsEntier -
	    stringIsEntierStrict -
	    stringIsInt -
	    stringIsIntStrict -
	    stringIsWide -






>
>







465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
	    reverse -
	    storeScalar1 -
	    storeScalar4 -
	    strcaseLower -
	    strcaseTitle -
	    strcaseUpper -
	    strclass -
	    stringIsBoolean -
	    stringIsBooleanStrict -
	    stringIsDouble -
	    stringIsDoubleStrict -
	    stringIsEntier -
	    stringIsEntierStrict -
	    stringIsInt -
	    stringIsIntStrict -
	    stringIsWide -

Changes to quadcode/specializer.tcl.

167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
    }

    my debug-specializer {
	puts "REGISTER: $procName"
    }

    set s [catch {

	# Convert the procedure to quadcode and perform the initial
	# quadcode-to-quadcode transformations. Add the quadcode database to
	# the 'database' dictionary.
	set ns [namespace qualifiers $origin]
	set bytecode [tcl::unsupported::getbytecode proc $origin]
	set db [quadcode::transformer new \
		    -origin $origin \






<







167
168
169
170
171
172
173

174
175
176
177
178
179
180
    }

    my debug-specializer {
	puts "REGISTER: $procName"
    }

    set s [catch {

	# Convert the procedure to quadcode and perform the initial
	# quadcode-to-quadcode transformations. Add the quadcode database to
	# the 'database' dictionary.
	set ns [namespace qualifiers $origin]
	set bytecode [tcl::unsupported::getbytecode proc $origin]
	set db [quadcode::transformer new \
		    -origin $origin \

Changes to quadcode/ssa.tcl.

265
266
267
268
269
270
271

272




273
274
275
276
277
278
279
    }

    # Find places to insert phi nodes

    set phis [lrepeat [llength $bbcontent] {}]
    dict for {v -} $global {
	if {[dict exists $writers $v]} {

	    foreach n [my bbfrontier+ [dict keys [dict get $writers $v]]] {




		set list [lindex $phis $n]
		lset phis $n {}
		lappend list [list phi $v]
		lset phis $n $list
	    }
	}
    }






>
|
>
>
>
>







265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
    }

    # Find places to insert phi nodes

    set phis [lrepeat [llength $bbcontent] {}]
    dict for {v -} $global {
	if {[dict exists $writers $v]} {
	    if {[dict exists $writers $v]} {
		set w [dict keys [dict get $writers $v]]
	    } else {
		set w {}
	    }
	    foreach n [my bbfrontier+ $w] {
		set list [lindex $phis $n]
		lset phis $n {}
		lappend list [list phi $v]
		lset phis $n $list
	    }
	}
    }

Changes to quadcode/translate.tcl.

195
196
197
198
199
200
201

202
203
204
205
206
207
208
...
940
941
942
943
944
945
946

947
948
949
950
951
952
953
...
955
956
957
958
959
960
961

962
963
964
965
966
967
968
....
1110
1111
1112
1113
1114
1115
1116


1117
1118
1119
1120
1121
1122
1123
1124


1125


1126
1127



1128
1129
1130
1131
1132
1133
1134
....
1664
1665
1666
1667
1668
1669
1670





1671
1672
1673
1674
1675
1676
1677
		set v1 [list temp [incr depth -1]]
		set v0 [list temp [incr depth -1]]
		set r $v0
		my quads [lindex $insn 0] $r $v0 $v1
	    }
	    uplus -
	    uminus -

	    bitnot {		# Unary ops
		set value [list temp [incr depth -1]]
		set r [list temp $depth]
		my generate-arith-domain-check $pc [lindex $insn 0] $value
		my quads purify {temp opd0} $value
		set op [lindex $insn 0]
		my quads $op $r {temp opd0}
................................................................................
	    jumpFalse1 -
	    jumpFalse4 {	# Conditional jump
		incr depth -1
		switch -exact -- [lindex $insn 1 0] {
		    pc {
			set to_pc [lindex $insn 1 1]
			set to_test [list temp $depth]

			my generate-jump $to_pc false $to_test
		    }
		    default {
			return -code error "I don't know what to do with\
                               [lindex $insn 1 0] as a jump target."
		    }
		}
................................................................................
	    jumpTrue1 -
	    jumpTrue4 {		# Conditional jump
		incr depth -1
		switch -exact -- [lindex $insn 1 0] {
		    pc {
			set to_pc [lindex $insn 1 1]
			set to_test [list temp $depth]

			my generate-jump $to_pc true $to_test
		    }
		    default {
			return -code error "I don't know what to do with\
                               [lindex $insn 1 0] as a jump target."
		    }
		}
................................................................................
		my quads [lindex $insn 0] $r $v0
	    }
	    originCmd {
		set v0 [list temp [incr depth -1]]
		set r $v0
		my error-quads $pc [lindex $insn 0] $r $v0
	    }


	    stringIsDouble -
	    stringIsDoubleStrict -
	    stringIsEntier -
	    stringIsEntierStrict -
	    stringIsInt -
	    stringIsIntStrict -
	    stringIsWide -
	    stringIsWideStrict {


		regexp {^stringIs(Double|Entier|Int|Wide)((?:Strict)?)$} \


		    [lindex $insn 0] -> type strict
		switch -exact $type {



		    Double {
			set typecode $::quadcode::dataType::NUMERIC
		    }
		    Entier {
			set typecode $::quadcode::dataType::ENTIER
		    }
		    Wide {
................................................................................
	     bitand [list &  INT] \
	     bitor  [list |  INT] \
	     bitxor [list ^  INT] \
	     mod    [list %  INT] \
	     lshift [list << INT] \
	     rshift [list << INT] \
	     bitnot [list ~  INT] \





	     infoLevelArgs [list "info level" INT]]
}
oo::define quadcode::transformer method \
    generate-arith-domain-check {pc operator args} {
	namespace upvar ::quadcode operator_info operator_info
	set target [my exception-target $pc catch]
	if {![dict exists $operator_info $operator]} return






>







 







>







 







>







 







>
>








>
>
|
>
>
|

>
>
>







 







>
>
>
>
>







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
...
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
...
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
....
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
....
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
		set v1 [list temp [incr depth -1]]
		set v0 [list temp [incr depth -1]]
		set r $v0
		my quads [lindex $insn 0] $r $v0 $v1
	    }
	    uplus -
	    uminus -
	    not -
	    bitnot {		# Unary ops
		set value [list temp [incr depth -1]]
		set r [list temp $depth]
		my generate-arith-domain-check $pc [lindex $insn 0] $value
		my quads purify {temp opd0} $value
		set op [lindex $insn 0]
		my quads $op $r {temp opd0}
................................................................................
	    jumpFalse1 -
	    jumpFalse4 {	# Conditional jump
		incr depth -1
		switch -exact -- [lindex $insn 1 0] {
		    pc {
			set to_pc [lindex $insn 1 1]
			set to_test [list temp $depth]
			my generate-arith-domain-check $to_pc jumpFalse $to_test
			my generate-jump $to_pc false $to_test
		    }
		    default {
			return -code error "I don't know what to do with\
                               [lindex $insn 1 0] as a jump target."
		    }
		}
................................................................................
	    jumpTrue1 -
	    jumpTrue4 {		# Conditional jump
		incr depth -1
		switch -exact -- [lindex $insn 1 0] {
		    pc {
			set to_pc [lindex $insn 1 1]
			set to_test [list temp $depth]
			my generate-arith-domain-check $pc jumpTrue $to_test
			my generate-jump $to_pc true $to_test
		    }
		    default {
			return -code error "I don't know what to do with\
                               [lindex $insn 1 0] as a jump target."
		    }
		}
................................................................................
		my quads [lindex $insn 0] $r $v0
	    }
	    originCmd {
		set v0 [list temp [incr depth -1]]
		set r $v0
		my error-quads $pc [lindex $insn 0] $r $v0
	    }
	    stringIsBoolean -
	    stringIsBooleanStrict -
	    stringIsDouble -
	    stringIsDoubleStrict -
	    stringIsEntier -
	    stringIsEntierStrict -
	    stringIsInt -
	    stringIsIntStrict -
	    stringIsWide -
	    stringIsWideStrict {
		regexp -expanded {
		    ^
		    stringIs(Boolean|Double|Entier|Int|Wide)
		    ((?:Strict)?)
		    $
		} [lindex $insn 0] -> type strict
		switch -exact $type {
		    Boolean {
			set typecode $quadcode::dataType::BOOLEAN
		    }
		    Double {
			set typecode $::quadcode::dataType::NUMERIC
		    }
		    Entier {
			set typecode $::quadcode::dataType::ENTIER
		    }
		    Wide {
................................................................................
	     bitand [list &  INT] \
	     bitor  [list |  INT] \
	     bitxor [list ^  INT] \
	     mod    [list %  INT] \
	     lshift [list << INT] \
	     rshift [list << INT] \
	     bitnot [list ~  INT] \
	     jumpTrue [list "boolean test" NUMERIC_OR_BOOLEAN] \
	     jumpFalse [list "boolean test" NUMERIC_OR_BOOLEAN] \
	     land [list "&&" NUMERIC_OR_BOOLEAN] \
	     lor [list "||" NUMERIC_OR_BOOLEAN] \
	     not [list "!" NUMERIC_OR_BOOLEAN] \
	     infoLevelArgs [list "info level" INT]]
}
oo::define quadcode::transformer method \
    generate-arith-domain-check {pc operator args} {
	namespace upvar ::quadcode operator_info operator_info
	set target [my exception-target $pc catch]
	if {![dict exists $operator_info $operator]} return

Changes to quadcode/types.tcl.

115
116
117
118
119
120
121





122
123
124
125
126
127
128
...
482
483
484
485
486
487
488


489
490
491
492
493
494
495
496
...
616
617
618
619
620
621
622
623
624
625
626
627
628
629

630
631
632
633
634
635
636
637
638
639
640
641
    # NUMERIC - the value is a number of some sort.
    #              A constant $x of this type will be pure iff either
    #              {entier($x) eq $x} or {double($x) eq $x} - that is,
    #              it is a number in canonical form.

    variable NUMERIC		[expr {$DOUBLE | $ENTIER}]






    # FOREACH - the value represents the iterator of a [foreach] or [lmap].
    #           There are no constants of this type, and it is therefore
    #           always pure.

    variable FOREACH		[expr 0x10000]

................................................................................
#
# Results:
#	Returns the deduced data type of q's left hand side

oo::define quadcode::transformer method typeOfResult {q} {
    namespace upvar ::quadcode::dataType {*}{
	DOUBLE DOUBLE INT INT STRING STRING FAIL FAIL EMPTY EMPTY


	BOOL_INT BOOL ENTIER ENTIER NUMERIC NUMERIC IMPURE IMPURE
	VOID VOID CALLFRAME CALLFRAME DICTITER DICTITER FOREACH FOREACH
	ARRAY ARRAY NEXIST NEXIST EXPANDED EXPANDED
    }

    switch -exact -- [lindex $q 0 0] {
	debug-value {
	    return [typeOfOperand $types [lindex $q 3]]
................................................................................
	lor -
	lt -
	neq -
	strclass -
	streq -
	strmatch -
	strneq {
	    return $BOOL
	}
	not {
	    set t [typeOfOperand $types [lindex $q 2]]
	    if {istype($t,$NUMERIC)} {
		return $BOOL
	    } else {

		return [expr {$BOOL | $FAIL}]
	    }
	}
	regexp - listIn {
	    return [expr {$BOOL | $FAIL}]
	}
	listLength - dictSize {
	    return [expr {$INT | $FAIL}]
	}
	phi {
	    set r 0
	    foreach {from operand} [lrange $q 2 end] {






>
>
>
>
>







 







>
>
|







 







|



|
|

>
|



|







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
...
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
...
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
    # NUMERIC - the value is a number of some sort.
    #              A constant $x of this type will be pure iff either
    #              {entier($x) eq $x} or {double($x) eq $x} - that is,
    #              it is a number in canonical form.

    variable NUMERIC		[expr {$DOUBLE | $ENTIER}]

    # NUMERIC_OR_BOOLEAN - the value is a number, or some spelling of
    #                      'true' or 'false'

    variable NUMERIC_OR_BOOLEAN	[expr {$NUMERIC | $BOOLEAN}]

    # FOREACH - the value represents the iterator of a [foreach] or [lmap].
    #           There are no constants of this type, and it is therefore
    #           always pure.

    variable FOREACH		[expr 0x10000]

................................................................................
#
# Results:
#	Returns the deduced data type of q's left hand side

oo::define quadcode::transformer method typeOfResult {q} {
    namespace upvar ::quadcode::dataType {*}{
	DOUBLE DOUBLE INT INT STRING STRING FAIL FAIL EMPTY EMPTY
	ZEROONE ZEROONE
	BOOL_INT BOOL BOOLWORD BOOLWORD
	ENTIER ENTIER NUMERIC NUMERIC IMPURE IMPURE
	VOID VOID CALLFRAME CALLFRAME DICTITER DICTITER FOREACH FOREACH
	ARRAY ARRAY NEXIST NEXIST EXPANDED EXPANDED
    }

    switch -exact -- [lindex $q 0 0] {
	debug-value {
	    return [typeOfOperand $types [lindex $q 3]]
................................................................................
	lor -
	lt -
	neq -
	strclass -
	streq -
	strmatch -
	strneq {
	    return $ZEROONE
	}
	not {
	    set t [typeOfOperand $types [lindex $q 2]]
	    if {istype($t,$NUMERIC|$BOOLWORD)} {
		return $ZEROONE
	    } else {
		puts "which might FAIL"
		return [expr {$ZEROONE | $FAIL}]
	    }
	}
	regexp - listIn {
	    return [expr {$ZEROONE | $FAIL}]
	}
	listLength - dictSize {
	    return [expr {$INT | $FAIL}]
	}
	phi {
	    set r 0
	    foreach {from operand} [lrange $q 2 end] {