Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Expansion... sort of |
|---|---|
| Timelines: | family | ancestors | list-and-dict-types |
| Files: | files | file ages | folders |
| SHA3-256: |
721be90d969652e5a76c9ad38fe221eb |
| User & Date: | dkf 2019-02-02 18:14:46 |
Context
|
2019-02-02
| ||
| 18:14 | Expansion... sort of Leaf check-in: 721be90d96 user: dkf tags: list-and-dict-types | |
|
2019-01-02
| ||
| 16:22 | A little bit less wrong. check-in: 75fd3b203e user: dkf tags: list-and-dict-types | |
Changes
Changes to codegen/compile.tcl.
562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 ... 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 .... 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 |
set src1 [lindex $srcs 0]
set name [my LocalVarName $tgt]
append opcode ( [my ValueTypes {*}$srcs] )
set srcs [lmap s $srcs {my LoadOrLiteral $s}]
set canFail [expr {"FAIL" in operandType($tgt)}]
set ec [if {$canFail} {list $errorCode}]
if {consumed($src1, $pc + 1)} {
$b printref $value "[lindex $l 0 0]:A:"
set res [$b $opcode {*}$srcs {*}$ec $name]
} else {
$b printref $value "[lindex $l 0 0]:B:"
$b addReference([my OperandType $src1]) [lindex $srcs 0]
set res [$b $opcode {*}$srcs {*}$ec $name]
$b dropReference([my OperandType $src1]) [lindex $srcs 0]
}
if {$canFail} {
my SetErrorLine $errorCode [$b maybe $res]
}
................................................................................
set srcs [lassign $l opcode tgt srcObj]
set name [my LocalVarName $tgt]
if {[llength $srcs] == 1} {
# Simple case
set srcs [list $srcObj {*}$srcs]
append opcode ( [my ValueTypes {*}$srcs] )
set srcs [lmap s $srcs {my LoadOrLiteral $s}]
set res [$b $opcode {*}$srcs $errorCode $name]
my StoreResult $tgt $res
} else {
# Need to construct the variadic path
set vectortypes [lmap s $srcs {my OperandType $s}]
set vector [$b buildVector $objv $vectortypes \
[lmap s $srcs {my LoadOrLiteral $s}]]
append opcode ( [my OperandType $srcObj] )
................................................................................
return [$b frame.pack $frame $value $name]
} elseif {"CALLFRAME" in $tgttype} {
error "callframe injection"
}
# Handle FAIL-extended types
if {"FAIL" eq $srctype && "FAIL" in $tgttype} {
# Implementation type of pure FAIL is int32 (Tcl result code)
set tgttype [lrange $tgttype 1 end]
return [$b fail $tgttype $value]
} elseif {"FAIL" in $srctype && "FAIL" in $tgttype} {
set value [$b unmaybe $value]
set srctype [lrange $srctype 1 end]
set tgttype [lrange $tgttype 1 end]
|
| | | > |
562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 ... 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 .... 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 |
set src1 [lindex $srcs 0]
set name [my LocalVarName $tgt]
append opcode ( [my ValueTypes {*}$srcs] )
set srcs [lmap s $srcs {my LoadOrLiteral $s}]
set canFail [expr {"FAIL" in operandType($tgt)}]
set ec [if {$canFail} {list $errorCode}]
if {consumed($src1, $pc + 1)} {
$b printref [lindex $srcs 0] "[lindex $l 0 0]:A:"
set res [$b $opcode {*}$srcs {*}$ec $name]
} else {
$b printref [lindex $srcs 0] "[lindex $l 0 0]:B:"
$b addReference([my OperandType $src1]) [lindex $srcs 0]
set res [$b $opcode {*}$srcs {*}$ec $name]
$b dropReference([my OperandType $src1]) [lindex $srcs 0]
}
if {$canFail} {
my SetErrorLine $errorCode [$b maybe $res]
}
................................................................................
set srcs [lassign $l opcode tgt srcObj]
set name [my LocalVarName $tgt]
if {[llength $srcs] == 1} {
# Simple case
set srcs [list $srcObj {*}$srcs]
append opcode ( [my ValueTypes {*}$srcs] )
set srcs [lmap s $srcs {my LoadOrLiteral $s}]
set res [$b $opcode {*}$srcs $name]
my StoreResult $tgt $res
} else {
# Need to construct the variadic path
set vectortypes [lmap s $srcs {my OperandType $s}]
set vector [$b buildVector $objv $vectortypes \
[lmap s $srcs {my LoadOrLiteral $s}]]
append opcode ( [my OperandType $srcObj] )
................................................................................
return [$b frame.pack $frame $value $name]
} elseif {"CALLFRAME" in $tgttype} {
error "callframe injection"
}
# Handle FAIL-extended types
if {"FAIL" eq $srctype && "FAIL" in $tgttype} {
my Warn "widen FAIL (%s) to %s" [PrintValueToString $value] $tgttype
# Implementation type of pure FAIL is int32 (Tcl result code)
set tgttype [lrange $tgttype 1 end]
return [$b fail $tgttype $value]
} elseif {"FAIL" in $srctype && "FAIL" in $tgttype} {
set value [$b unmaybe $value]
set srctype [lrange $srctype 1 end]
set tgttype [lrange $tgttype 1 end]
|
Changes to codegen/stdlib.tcl.
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 ... 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 ... 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 ... 500 501 502 503 504 505 506 507 508 509 510 511 512 513 |
#
# Increment the reference count of a Tcl_Obj reference if the
# object is supplied
set f [$m local "tcl.addFailReference" void<-Tcl_Obj*?]
params value:maybeObjPtr
build {
my condBr [my maybe $value] $nothing $incr
label incr "action.required.afr"
set value [my unmaybe $value "objPtr"]
$api Tcl_IncrRefCount $value
my ret
label nothing "nothing.to.do"
my ret
}
................................................................................
#
# Decrement the reference count of a Maybe containing a Tcl_Obj
# reference, and delete it if the reference count drops to zero.
set f [$m local "tcl.dropFailReference" void<-Tcl_Obj*?]
params value:maybeObjPtr
build {
my condBr [my maybe $value] $nothing $decr
label decr "action.required"
set value [my unmaybe $value "objPtr"]
$api Tcl_DecrRefCount $value
my ret
label nothing "nothing.to.do"
my ret
}
................................................................................
#
# Decrement the reference count of a Maybe Maybe containing a Tcl_Obj
# reference, and delete it if the reference count drops to zero.
set f [$m local "tcl.dropFailNExistReference" void<-Tcl_Obj*!?]
params value:maybeObjPtr
build {
my condBr [my maybe $value] $nothing $decr
label decr "action.required"
my Call tcl.dropNExistReference [my unmaybe $value]
my ret
label nothing "nothing.to.do"
my ret
}
................................................................................
params pr val prefix
build {
my condBr [my maybe $val] $done $print
label print:
my Call writeref $pr [my unmaybe $val] $prefix
my ret
label done:
my ret
}
set f [$m local writearef void<-int,ARRAY,char* noinline]
params pr val prefix
build {
nonnull $val
set chan [$api Tcl_GetStdChannel [Const [expr 1<<3]]]
|
| | | > |
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 ... 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 ... 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 ... 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 |
#
# Increment the reference count of a Tcl_Obj reference if the
# object is supplied
set f [$m local "tcl.addFailReference" void<-Tcl_Obj*?]
params value:maybeObjPtr
build {
my condBr [my maybe $value] $incr $nothing
label incr "action.required.afr"
set value [my unmaybe $value "objPtr"]
$api Tcl_IncrRefCount $value
my ret
label nothing "nothing.to.do"
my ret
}
................................................................................
#
# Decrement the reference count of a Maybe containing a Tcl_Obj
# reference, and delete it if the reference count drops to zero.
set f [$m local "tcl.dropFailReference" void<-Tcl_Obj*?]
params value:maybeObjPtr
build {
my condBr [my maybe $value] $decr $nothing
label decr "action.required"
set value [my unmaybe $value "objPtr"]
$api Tcl_DecrRefCount $value
my ret
label nothing "nothing.to.do"
my ret
}
................................................................................
#
# Decrement the reference count of a Maybe Maybe containing a Tcl_Obj
# reference, and delete it if the reference count drops to zero.
set f [$m local "tcl.dropFailNExistReference" void<-Tcl_Obj*!?]
params value:maybeObjPtr
build {
my condBr [my maybe $value] $decr $nothing
label decr "action.required"
my Call tcl.dropNExistReference [my unmaybe $value]
my ret
label nothing "nothing.to.do"
my ret
}
................................................................................
params pr val prefix
build {
my condBr [my maybe $val] $done $print
label print:
my Call writeref $pr [my unmaybe $val] $prefix
my ret
label done:
my Call writeref $pr {} $prefix
my ret
}
set f [$m local writearef void<-int,ARRAY,char* noinline]
params pr val prefix
build {
nonnull $val
set chan [$api Tcl_GetStdChannel [Const [expr 1<<3]]]
|
Changes to codegen/struct.tcl.
2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 |
}
{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} {
|
> > > > > > > > > > > > |
2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 |
}
{NOTHING STRING} {
append body2 { [my undef STRING]}
}
{{EXPANDED STRING} STRING} {
append body2 { $} [lindex $f 0]
}
{{EXPANDED LIST} LIST} {
append body2 { $} [lindex $f 0]
}
{{EXPANDED LIST} STRING} {
append body2 { $} [lindex $f 0]
}
{{EXPANDED DICT} DICT} {
append body2 { $} [lindex $f 0]
}
{{EXPANDED DICT} 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} {
|
Changes to quadcode/types.tcl.
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
...
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
|
# Simple numbers are simple words when not IMPURE
if {istype($t1,$NUMERIC) && !($t1 & $IMPURE)} {
return $t1
}
return [expr {$EXPANDED | $t1}]
}
verifyList {
return [expr {$FAIL | [typeOfOperand $types [lindex $q 2]]}]
}
invoke {
# We know the result type of a handful of the things
# that might be invoked
if {[lindex $q 3 0] eq "literal"} {
set rtype [my typeOfInvoke [lindex $q 3 1] [lrange $q 4 end]]
} else {
................................................................................
}
listAppend - listConcat {
return $LIST
}
listIndex {
if {[llength $q] == 4} {
set t2 [typeOfOperand $types [lindex $q 3]]
if {istype($t2, $INT) || istype($t2, $ZEROONE)} {
return $STRING
}
} elseif {[llength $q] == 3} {
return [typeOfOperand $types [lindex $q 2]]
}
return [expr {$STRING | $FAIL}]
}
listRange {
set t1 [typeOfOperand $types [lindex $q 3]]
set t2 [typeOfOperand $types [lindex $q 3]]
if {(istype($t1, $INT) || istype($t1, $ZEROONE)) &&
(istype($t2, $INT) || istype($t2, $ZEROONE))} {
return $LIST
}
return [expr {$LIST | $FAIL}]
}
listSet {
return [expr {$LIST | $FAIL}]
}
strindex - strrange - strreplace - dictGet {
return [expr {$STRING | $FAIL}]
}
dictSetOrUnset - dictAppend {
return $DICT
}
dictUnset {
if {[llength $q] == 4} {
|
|
>
|
>
>
|
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
...
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
|
# Simple numbers are simple words when not IMPURE
if {istype($t1,$NUMERIC) && !($t1 & $IMPURE)} {
return $t1
}
return [expr {$EXPANDED | $t1}]
}
verifyList {
return [expr {$FAIL | $LIST}]
}
invoke {
# We know the result type of a handful of the things
# that might be invoked
if {[lindex $q 3 0] eq "literal"} {
set rtype [my typeOfInvoke [lindex $q 3 1] [lrange $q 4 end]]
} else {
................................................................................
}
listAppend - listConcat {
return $LIST
}
listIndex {
if {[llength $q] == 4} {
set t2 [typeOfOperand $types [lindex $q 3]]
# TODO: have end-relative indices be their own type
if {istype($t2, $INT) || istype($t2, $ZEROONE)} {
return $STRING
}
} elseif {[llength $q] == 3} {
return [typeOfOperand $types [lindex $q 2]]
}
return [expr {$STRING | $FAIL}]
}
listRange {
set t1 [typeOfOperand $types [lindex $q 3]]
set t2 [typeOfOperand $types [lindex $q 4]]
# TODO: have end-relative indices be their own type
if {(istype($t1, $INT) || istype($t1, $ZEROONE)) &&
(istype($t2, $INT) || istype($t2, $ZEROONE))} {
return $LIST
}
return [expr {$LIST | $FAIL}]
}
listSet {
return [expr {$LIST | $FAIL}]
}
strindex - strrange - strreplace - dictGet {
# TODO: have end-relative indices be their own type and be non-failing
return [expr {$STRING | $FAIL}]
}
dictSetOrUnset - dictAppend {
return $DICT
}
dictUnset {
if {[llength $q] == 4} {
|