Hello.
After some breakages and discussions on #perl6 and #parrot I've remade
this patch to proper handling boolean contexts.
1. Refactor 'junction_comparision_helper' to 'get_bool' vtable.
2. Remove 'prefix:?' and 'prefix:!' overrides. Parrot DTRT without them.
3. Replace 'junction_comparision_helper' with 'infix_junction_helper'.
--
Bacek
commit f15089f62abd7478573ad4145589153b5465ae92
Author: Vasily Chekalkin <[EMAIL PROTECTED]>
Date: Wed Nov 5 05:23:47 2008 +1100
Refactor junctions
diff --git a/languages/perl6/src/classes/Junction.pir b/languages/perl6/src/classes/Junction.pir
index 9e5baca..9e1b09d 100644
--- a/languages/perl6/src/classes/Junction.pir
+++ b/languages/perl6/src/classes/Junction.pir
@@ -208,6 +208,60 @@ Returns a Perl representation of a junction.
.return (res)
.end
+=item
+
+Override get_bool for Junction
+
+=cut
+
+.sub 'get_bool' :method :vtable
+ # We need to find how many values are equal.
+ .local pmc values
+ .local int num_equal
+ .local int count
+ .local int i
+
+ values = self.'values'()
+ count = elements values
+ i = 0
+ num_equal = 0
+ loop:
+ if i >= count goto end_loop
+ $P0 = values[i]
+ $I0 = 'prefix:?'($P0)
+ num_equal += $I0
+ inc i
+ goto loop
+ end_loop:
+
+ # Now go by juction type.
+ .local int type
+ type = self.'!type'()
+ if type == JUNCTION_TYPE_ALL goto all
+ if type == JUNCTION_TYPE_ANY goto any
+ if type == JUNCTION_TYPE_ONE goto one
+ if type == JUNCTION_TYPE_NONE goto none
+
+ all:
+ if num_equal == count goto ret_true
+ goto ret_false
+ any:
+ if num_equal > 0 goto ret_true
+ goto ret_false
+ one:
+ if num_equal == 1 goto ret_true
+ goto ret_false
+ none:
+ if num_equal == 0 goto ret_true
+ goto ret_false
+
+ ret_true:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return($P0)
+ ret_false:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return($P0)
+.end
=back
@@ -449,18 +503,6 @@ Override prefix decrement for junctions.
.end
-=item C<prefix:!(...)>
-
-Override not for junctions.
-
-=cut
-
-.sub 'prefix:!' :multi('Junction')
- .param pmc j
- $P0 = find_global 'prefix:!'
- .return unary_junction_helper($P0, j)
-.end
-
=item C<prefix:+(...)>
@@ -500,20 +542,6 @@ Override stringification for junctions.
.return unary_junction_helper($P0, j)
.end
-
-=item C<prefix:?(...)>
-
-Override boolification for junctions.
-
-=cut
-
-.sub 'prefix:?' :multi('Junction')
- .param pmc j
- $P0 = find_global 'prefix:?'
- .return unary_junction_helper($P0, j)
-.end
-
-
=item C<prefix:=(...)>
Override iteration for junctions.
@@ -1080,21 +1108,21 @@ Override numerical equality for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:=="
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:==' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:=="
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:==' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:=="
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1108,21 +1136,21 @@ Override numerical inequality for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:!="
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:!=' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:!="
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:!=' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:!="
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1136,21 +1164,21 @@ Override numerical greater than for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:>"
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:>' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:>"
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:>' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:>"
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1164,21 +1192,21 @@ Override numerical less than for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:<"
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:<' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:<"
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:<' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:<"
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1192,21 +1220,21 @@ Override numerical greater than or equal to for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:>="
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:>=' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:>="
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:>=' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:>="
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1220,21 +1248,21 @@ Override numerical less than or equal to for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:<="
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:<=' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:<="
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:<=' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:<="
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1248,21 +1276,21 @@ Override string equality for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:eq"
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:eq' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:eq"
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:eq' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:eq"
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1276,21 +1304,21 @@ Override string inequality for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:ne"
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:ne' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:ne"
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:ne' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:ne"
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1304,21 +1332,21 @@ Override string less than for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:lt"
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:lt' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:lt"
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:lt' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:lt"
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1332,21 +1360,21 @@ Override string greater than for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:gt"
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:gt' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:gt"
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:gt' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:gt"
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1360,21 +1388,21 @@ Override string less than or equal for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:le"
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:le' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:le"
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:le' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:le"
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1388,21 +1416,21 @@ Override string greater than or equal for junctions.
.param pmc j1
.param pmc j2
$P0 = find_global "infix:ge"
- .return junction_comparrison_helper($P0, j1, j2, 0)
+ .return infix_junction_helper($P0, j1, j2, 0)
.end
.sub 'infix:ge' :multi('Junction',_)
.param pmc j
.param pmc x
$P0 = find_global "infix:ge"
- .return junction_comparrison_helper($P0, j, x, 0)
+ .return infix_junction_helper($P0, j, x, 0)
.end
.sub 'infix:ge' :multi(_,'Junction')
.param pmc x
.param pmc j
$P0 = find_global "infix:ge"
- .return junction_comparrison_helper($P0, j, x, 1)
+ .return infix_junction_helper($P0, j, x, 1)
.end
@@ -1436,7 +1464,7 @@ loop:
sa:
$P0 = op_sub(x, cur_elem)
nsa:
- ResultHash[$P0] = 1
+ ResultHash[$P0] = $P0
inc i
goto loop
loop_end:
@@ -1456,6 +1484,7 @@ loop_end:
nv_loop:
unless iterator goto nv_loop_end
$P0 = shift iterator
+ $P0 = ResultHash[$P0]
push new_values, $P0
goto nv_loop
nv_loop_end:
@@ -1464,66 +1493,6 @@ nv_loop_end:
.return(new_junc)
.end
-# Helper sub for junction comparrisons.
-.sub junction_comparrison_helper :anon
- .param pmc op_func
- .param pmc j
- .param pmc x
- .param int second_arg
-
- # We need to find how many values are equal.
- .local pmc values
- .local int num_equal
- .local int count
- .local int i
- values = j.'values'()
- count = elements values
- i = 0
- num_equal = 0
-loop:
- if i >= count goto end_loop
- $P0 = values[i]
- if second_arg goto sa
- $I0 = op_func($P0, x)
- goto not_sa
-sa:
- $I0 = op_func(x, $P0)
-not_sa:
- num_equal += $I0
- inc i
- goto loop
-end_loop:
-
- # Now go by juction type.
- .local int type
- type = j.'!type'()
- if type == JUNCTION_TYPE_ALL goto all
- if type == JUNCTION_TYPE_ANY goto any
- if type == JUNCTION_TYPE_ONE goto one
- if type == JUNCTION_TYPE_NONE goto none
-
-all:
- if num_equal == count goto ret_true
- goto ret_false
-any:
- if num_equal > 0 goto ret_true
- goto ret_false
-one:
- if num_equal == 1 goto ret_true
- goto ret_false
-none:
- if num_equal == 0 goto ret_true
- goto ret_false
-
-ret_true:
- $P0 = get_hll_global ['Bool'], 'True'
- .return($P0)
-ret_false:
- $P0 = get_hll_global ['Bool'], 'False'
- .return($P0)
-.end
-
-
# Helper sub for implementing unary operators.
.sub unary_junction_helper :anon
.param pmc op_sub
@@ -1548,7 +1517,7 @@ loop:
if i >= count goto loop_end
cur_elem = values[i]
$P0 = op_sub(cur_elem)
- ResultHash[$P0] = 1
+ ResultHash[$P0] = $P0
inc i
goto loop
loop_end:
@@ -1568,6 +1537,7 @@ loop_end:
nv_loop:
unless iterator goto nv_loop_end
$P0 = shift iterator
+ $P0 = ResultHash[$P0]
push new_values, $P0
goto nv_loop
nv_loop_end:
@@ -1576,7 +1546,7 @@ nv_loop_end:
.return(new_junc)
.end
-
+
=back
=cut
