Vasily Chekalkin wrote:
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'.
And again. After comments from Pm I remade 'get_bool' to short-circuit
version. Noting else changed from previous version.
--
Bacek
diff --git a/languages/perl6/src/classes/Junction.pir b/languages/perl6/src/classes/Junction.pir
index 9e5baca..d18b14e 100644
--- a/languages/perl6/src/classes/Junction.pir
+++ b/languages/perl6/src/classes/Junction.pir
@@ -154,6 +154,10 @@ Clone v-table method.
.end
+.sub 'get_string' :method :vtable
+ .return self.'perl'()
+.end
+
=item perl()
Returns a Perl representation of a junction.
@@ -208,6 +212,80 @@ 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 pmc it
+
+ # get values
+ values = self.'values'()
+ it = iter values
+
+ # Now go by juction type to short-circuited version.
+ .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:
+ # Check iter while prefix:? is True.
+ all_loop:
+ unless it goto ret_true
+ $P0 = shift it
+ $I0 = 'prefix:?'($P0)
+ if $I0 goto all_loop
+ goto ret_false
+
+ any:
+ # Check iter while prefix:? is False.
+ any_loop:
+ unless it goto ret_false
+ $P0 = shift it
+ $I0 = 'prefix:?'($P0)
+ unless $I0 goto any_loop
+ goto ret_true
+
+ one:
+ # Check iter while count of True less than one.
+ .local int count
+ count = 0
+ one_loop:
+ unless it goto check_count
+ $P0 = shift it
+ $I0 = 'prefix:?'($P0)
+ count += $I0
+ if count > 1 goto ret_false
+ goto one_loop
+
+ check_count:
+ if count == 1 goto ret_true
+ goto ret_false
+
+ none:
+ # Check iter while prefix:? is False.
+ none_loop:
+ unless it goto ret_true
+ $P0 = shift it
+ $I0 = 'prefix:?'($P0)
+ unless $I0 goto none_loop
+ goto ret_true
+
+
+ ret_true:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return($P0)
+ ret_false:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return($P0)
+.end
=back
@@ -457,8 +535,8 @@ Override not for junctions.
.sub 'prefix:!' :multi('Junction')
.param pmc j
- $P0 = find_global 'prefix:!'
- .return unary_junction_helper($P0, j)
+ $P0 = j.'get_bool'()
+ .return 'prefix:!'($P0)
.end
@@ -509,8 +587,8 @@ Override boolification for junctions.
.sub 'prefix:?' :multi('Junction')
.param pmc j
- $P0 = find_global 'prefix:?'
- .return unary_junction_helper($P0, j)
+ $P0 = j.'get_bool'()
+ .return ($P0)
.end
@@ -1080,21 +1158,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 +1186,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 +1214,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 +1242,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 +1270,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 +1298,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 +1326,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 +1354,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 +1382,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 +1410,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 +1438,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 +1466,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 +1514,7 @@ loop:
sa:
$P0 = op_sub(x, cur_elem)
nsa:
- ResultHash[$P0] = 1
+ ResultHash[$P0] = $P0
inc i
goto loop
loop_end:
@@ -1456,6 +1534,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 +1543,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 +1567,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 +1587,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 +1596,7 @@ nv_loop_end:
.return(new_junc)
.end
-
+
=back
=cut
