Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add leg et al, &grep, &map, infix:<x>

  • Loading branch information...
commit ea8058ef0aa7f06e65e5358aeaab155edaf8f997 1 parent 12c3adc
@sorear authored
Showing with 45 additions and 65 deletions.
  1. +1 −0  src/CLRTypes.pm
  2. +1 −0  src/CgOp.pm
  3. +23 −47 test2.pl
  4. +20 −18 v6/TODO
View
1  src/CLRTypes.pm
@@ -136,6 +136,7 @@ my %typedata = (
'Console.Error.WriteLine' => [m => 'Void'],
'System.Environment.Exit' => [m => 'Void'],
'String.Concat' => [m => 'String'],
+ 'String.CompareOrdinal'=> [m => 'Int32'],
'Kernel.AnyP' => [f => 'IP6'],
'Kernel.AnyMO' => [f => 'DynMetaObject'],
'Kernel.ArrayP' => [f => 'IP6'],
View
1  src/CgOp.pm
@@ -163,6 +163,7 @@ use warnings;
sub str_length { getfield('Length', $_[0]) }
sub str_substring { rawcall($_[0], 'Substring', $_[1], $_[2]) }
sub str_chr { rawnew('str', cast('clr:System.Char', $_[0]), CgOp::int(1)) }
+ sub strcmp { rawscall('String.CompareOrdinal', $_[0], $_[1]) }
sub strbuf_new { rawnew('strbuf') }
sub strbuf_append { rawcall($_[0], 'Append', $_[1]) }
View
70 test2.pl
@@ -1,58 +1,34 @@
# vim: ft=perl6
use Test;
-{
- is chars("foo"), 3, '&chars works';
- is substr("Hello",1,3), 'ell', '&substr works';
- is substr("Hello",2), "llo", '&substr works (2 args)';
- is reverse(1,2,3).join("|"), '3|2|1', '&reverse works';
- is join("|",1,2,3), '1|2|3', '&join works';
- my @foo = 4,5,6;
- is join("|",item @foo), '4 5 6', '&item works';
- is join("|",@foo.item), '4 5 6', 'Mu.item works';
- is (not False), 'Bool::True', '&not works';
- is (defined 5), 'Bool::True', '&defined works';
- push @foo, 7, 8;
- is join("|",@foo), '4|5|6|7|8', '&push works';
- unshift @foo, 2, 3;
- is join("|",@foo), '2|3|4|5|6|7|8', '&unshift works';
- is pop(@foo), '8', '&pop works';
- is shift(@foo), '2', '&shift works';
- is join("|",@foo), '3|4|5|6|7', '... with side effects';
- is +True, '1', "Bool.Numeric works";
- my %bar = :a<9>;
- is %bar<a>, '9', "Hash.LISTSTORE works";
- %bar = :c<9>;
- ok (!defined %bar<a>), "Hash.LISTSTORE clears existing";
- is keys(%bar), "c", "Hash.keys works";
- is values(%bar), "9", "Hash.values works";
- is (join "|", %bar.kv), "c|9", "Hash.kv works";
- is (%bar.invert.<9>), "c", "Hash.invert works";
- ok %bar<c> :exists, ":exists works";
- is (%bar<c> :delete), "9", ":delete returns old";
- ok !(%bar<c> :exists), ":delete removes value";
+sub infix:<x>($str, $ct) {
+ my $i = +$ct;
+ my $j = ''; # XXX use strbuf
+ while $i >= 1 {
+ $i--;
+ $j ~= $str;
+ }
+ $j;
}
-{
- my class A {
- method tom() { 12 }
- method foo($x) { $x * $x }
- method bar(:$x) { $x + $x }
- }
- my class B is A {
- method tom() { nextsame; }
- method foo($x) { nextsame; } #OK
- method bar(:$x) { nextsame; } #OK
- }
- is B.tom(), 12, "nextsame functional";
- is B.foo(5), 25, "nextsame functional w/ argument";
- # TODO
- # is B.bar(:x(7)), 14, "nextsame functional w/ named arg";
+sub grep($filter, *@items) { @items.grep($filter) }
+sub map($callback, *@items) { @items.map($callback) }
- sub foo(*%x) { %x }
- is foo(:z(2))<z>, 2, "slurpy hashes work";
+sub infix:<leg>($s1, $s2) {
+ Q:CgOp { (box Num (cast num (strcmp (unbox str (@ {$s1.Str})) (unbox str (@ {$s2.Str}))))) }
}
+sub infix:<ge>($s1, $s2) { ($s1 leg $s2) >= 0 }
+sub infix:<gt>($s1, $s2) { ($s1 leg $s2) > 0 }
+sub infix:<le>($s1, $s2) { ($s1 leg $s2) <= 0 }
+sub infix:<lt>($s1, $s2) { ($s1 leg $s2) < 0 }
+
+ok 'cow' le 'sow', 'cow le sow';
+ok !('sow' le 'cow'), 'sow !le cow';
+ok 'row' lt 'tow', 'row lt tow';
+ok 'how' gt 'bow', 'how gt bow';
+ok 'yow' ge 'yow', 'yow ge yow';
+
#is $?FILE, 'test.pl', '$?FILE works';
#is $?ORIG.substr(0,5), '# vim', '$?ORIG works';
View
38 v6/TODO
@@ -22,18 +22,13 @@ Cursor.moreinput
Cursor.O
Cursor.suppose
Cursor.trim_heredoc
-:delete
-:exists
EXPR will need a re-write with tests.
$<foo> = 1
$*FOO as a parameter
func(|($key => $value))
gt, lt, leg, etc
-Hash.keys &keys
-Hash.LISTSTORE
hash literals
infix:<x>
-invert(%hash)
List.at-pos(WhateverCode)
Match.CURSOR
Match.iterator should return numbered captures
@@ -47,21 +42,28 @@ temp $*FOO
token { :my $var = expr; $var }
token { $param-role-var }
-DONE OR AVERTED:
-
-given & when
-if not binding $_
-Mu.new(foo => $bar)
+DONE:
Bool.Numeric
-//=, ||=, &&=, etc
-substr($str,$from,$len)
-not($bool)
+&chars
defined($thing)
-shift(@array)
-push(@array, $thing)
+:delete
+:exists
+Hash.keys &keys
+Hash.LISTSTORE
+invert(%hash)
&item
-&reverse
-&chars
-&note
&join
+not($bool)
+&note
pop(@array)
+push(@array, $thing)
+&reverse
+shift(@array)
+substr($str,$from,$len)
+
+AVERTED:
+
+//=, ||=, &&=, etc
+given & when
+if not binding $_
+Mu.new(foo => $bar)
Please sign in to comment.
Something went wrong with that request. Please try again.