Check-in [c0e88e91be]

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

Overview
Comment:merge trunk
Timelines: family | ancestors | descendants | both | inline
Files: files | file ages | folders
SHA3-256: c0e88e91be075156c5681e53409061dc60b00e80d61348043788f220a1940401
User & Date: kbk 2018-03-27 01:40:39.992
Context
2018-04-17
00:13
Merge trunk Leaf check-in: 25e63838cd user: kbk tags: inline
2018-03-27
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
2018-03-18
22:30
merge trunk check-in: 1cbcf74c81 user: kbk tags: inline
Changes
Unified Diff Ignore Whitespace Patch
Changes to codegen/build.tcl.
43
44
45
46
47
48
49















50
51
52
53
54
55
56
    # 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.







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







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
    # 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.
115
116
117
118
119
120
121






















































122
123
124
125
126
127
128
    #	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:







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







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
    #	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:
185
186
187
188
189
190
191
















































192
193
194
195
196
197
198
    #
    # 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:







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







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
    #
    # 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:
4235
4236
4237
4238
4239
4240
4241




























4242
4243
4244
4245
4246
4247
4248

    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.







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







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

    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.
4342
4343
4344
4345
4346
4347
4348
















































4349



































4350
4351
4352
4353
4354
4355
4356
    #	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').
    #







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







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
    #	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').
    #
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
		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 {







|







4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
		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 {
5098
5099
5100
5101
5102
5103
5104

















5105
5106
5107
5108
5109
5110
5111
    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
    #







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







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
    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
    #
5671
5672
5673
5674
5675
5676
5677




















5678
5679
5680
5681
5682
5683
5684
    #
    # 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:







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







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
    #
    # 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:
6170
6171
6172
6173
6174
6175
6176


















6177
6178
6179
6180
6181
6182
6183
    #
    # 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.
    #







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







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 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
			    [$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]







>







479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
			    [$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]
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
		"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]} {







|







538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
		"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]} {
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
			$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







|
|






|
|







744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
			$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
    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.







>


>
|
>
>
|
>
|
>







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
    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.
654
655
656
657
658
659
660























661
662
663
664
665
666
667
	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').
	#







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







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
	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').
	#
1189
1190
1191
1192
1193
1194
1195










1196

1197
1198
1199





















1200
1201
1202
1203
1204
1205
1206
	    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.








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



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







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
	    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.

1253
1254
1255
1256
1257
1258
1259

1260
1261
1262
1263
1264
1265
1266
	    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".







>







1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
	    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".
1277
1278
1279
1280
1281
1282
1283



























1284



















1285




1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
	    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
	#
	# Tests if a STRING can be parsed as a DOUBLE. Part of the
	# implementation of quadcode "instanceOf".

	set f [$m local "tcl.isDouble" ZEROONE<-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]
	}








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



















|







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
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
	    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
	#
	# Tests if a STRING can be parsed as a DOUBLE. Part of the
	# implementation of quadcode "instanceOf".

	set f [$m local "tcl.isDouble" ZEROONE<-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]
	}

1330
1331
1332
1333
1334
1335
1336




































1337
1338
1339
1340
1341
1342
1343
	    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".







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







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
	    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".
1356
1357
1358
1359
1360
1361
1362



































1363
1364
1365
1366
1367
1368
1369
	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".








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







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
1552
	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".

1384
1385
1386
1387
1388
1389
1390










































1391
1392
1393
1394
1395
1396
1397
	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
	# standard ordering, 1 if 'value2Ptr' precedes, and 0 if they are







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







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
1622
	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
	# standard ordering, 1 if 'value2Ptr' precedes, and 0 if they are
Changes to codegen/stdlib.tcl.
201
202
203
204
205
206
207










































208
209
210
211
212
213
214
	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







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







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
	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
650
651
652
653
654
655
656
























657
658
659
660
661
662
663
	    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







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







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
	    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
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227

4228
4229
4230
4231
4232
4233
4234

	##### 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.







|









>







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

	##### 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
    #
    # 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







>







679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
    #
    # 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
1522
1523
1524
1525
1526
1527
1528






1529
1530
1531
1532
1533
1534
1535
	    i32:int32
	    i64:int64
	}
	struct NUMERIC {
	    kind:bool
	    int:INT
	    double:double






	}
	struct FOREACH {
	    val:int
	    max:int
	}
	struct DICTFOR {
	    search:DictSearch







>
>
>
>
>
>







1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
	    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
1563
1564
1565
1566
1567
1568
1569

1570
1571
1572
1573
1574
1575
1576
	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







>







1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
	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
2603
2604
2605
2606
2607
2608
2609



2610
2611
2612



2613
2614
2615



2616
2617
2618







2619
2620
2621
2622
2623
2624
2625
	    }
	    {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]]







>
>
>



>
>
>



>
>
>



>
>
>
>
>
>
>







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
	    }
	    {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]]
2663
2664
2665
2666
2667
2668
2669








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












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



2700
2701
2702
2703
2704
2705
2706
2707

2708
2709
2710
2711
2712
2713
2714
		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}} {
		append body2 [format { [my upcastImpure.NUMERIC(ZEROONE) $%s]} [lindex $f 0]]
	    }
	    {{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} {
		append body2 { $} [lindex $f 0]
	    }
	    {{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 {]}







>
>
>
>
>
>
>
>















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















>
>
>








>







2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
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
2736
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
		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}} {
		append body2 [format { [my upcastImpure.NUMERIC(ZEROONE) $%s]} [lindex $f 0]]
	    }
	    {{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} {
		append body2 { $} [lindex $f 0]
	    }
	    {{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 {]}
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
    #	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?)







|



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







<
<
<


>







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
    #	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
    # 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 --
    #







>
>
>
>
>







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
    # 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 --
    #
176
177
178
179
180
181
182



183
184
185
186
187
188
189
	    }
	    "^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,







>
>
>







181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
	    }
	    "^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.
612
613
614
615
616
617
618





































619
620
621
622
623
624
625
    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]







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







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
658
659
660
661
662
    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]
1975
1976
1977
1978
1979
1980
1981


























1982
1983
1984
1985
1986
1987
1988
    {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)







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







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
2047
2048
2049
2050
2051
    {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)
2232
2233
2234
2235
2236
2237
2238




2239
2240
2241
2242
2243
2244
2245
    cmptest
    cmptest2
    matchtest
    replacing replacing2 replacing3
    strclasstest
    jumptable
    concatenater




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







>
>
>
>







2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
    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
}

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

quadcode::bytecodeAbbreviator create quadcode::bytecodeAbbreviator1 {







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







>
>
>
>
>
>







224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
}

# 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
254
255
256
257
258
259
260










261
262
263
264
265
266
267
    }

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










	push1 {literal 1}
    }

    stringIsInt {
	dup
	numericType
	dup







>
>
>
>
>
>
>
>
>
>







260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
    }

    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
		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}







>







195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
		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}
940
941
942
943
944
945
946

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

962
963
964
965
966
967
968
	    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."
		    }
		}







>















>







941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
	    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."
		    }
		}
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
		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 {







>
>








>
>
|
>
>
|

>
>
>







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
		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 {
1664
1665
1666
1667
1668
1669
1670





1671
1672
1673
1674
1675
1676
1677
	     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







>
>
>
>
>







1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
	     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

    # 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]








>
>
>
>
>







115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

    # 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]

482
483
484
485
486
487
488


489
490
491
492
493
494
495
496
#
# 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]]







>
>
|







487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
#
# 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]]
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
	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] {







|



|
|

>
|



|







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
	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] {