Another attempt. Now with short-circuit version of get_bool.
--
Bacek
commit e6661598b0f481003a46a54bf49287f252b2a32f
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 0b5379a..af36be1 100644
--- a/languages/perl6/src/classes/Junction.pir
+++ b/languages/perl6/src/classes/Junction.pir
@@ -219,6 +219,77 @@ 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
+
+ values = self.'values'()
+ it = iter values
+
+ # 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:
+ # check values while True.
+ all_loop:
+ unless it goto ret_true
+ $P0 = shift it
+ $I0 = 'prefix:?'($P0)
+ unless $I0 goto ret_false
+ goto all_loop
+
+ any:
+ # check values while False.
+ any_loop:
+ unless it goto ret_false
+ $P0 = shift it
+ $I0 = 'prefix:?'($P0)
+ if $I0 goto ret_true
+ goto any_loop
+
+ one:
+ # check values while count < 1.
+ .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 values while False.
+ none_loop:
+ unless it goto ret_true
+ $P0 = shift it
+ $I0 = 'prefix:?'($P0)
+ if $I0 goto ret_false
+ goto none_loop
+
+ ret_true:
+ $P0 = get_hll_global ['Bool'], 'True'
+ .return($P0)
+ ret_false:
+ $P0 = get_hll_global ['Bool'], 'False'
+ .return($P0)
+.end
=back
@@ -460,18 +531,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:+(...)>
@@ -511,20 +570,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.
@@ -1091,21 +1136,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
@@ -1119,21 +1164,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
@@ -1147,21 +1192,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
@@ -1175,21 +1220,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
@@ -1203,21 +1248,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
@@ -1231,21 +1276,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
@@ -1259,21 +1304,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
@@ -1287,21 +1332,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
@@ -1315,21 +1360,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
@@ -1343,21 +1388,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
@@ -1371,21 +1416,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
@@ -1399,21 +1444,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
@@ -1447,7 +1492,7 @@ loop:
sa:
$P0 = op_sub(x, cur_elem)
nsa:
- ResultHash[$P0] = 1
+ ResultHash[$P0] = $P0
inc i
goto loop
loop_end:
@@ -1467,6 +1512,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:
@@ -1475,66 +1521,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
@@ -1559,7 +1545,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:
@@ -1579,6 +1565,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:
@@ -1587,7 +1574,7 @@ nv_loop_end:
.return(new_junc)
.end
-
+
=back
=cut
