Changeset 17865

Timestamp:

09/16/07 01:53:07 (14 months ago)

Author:

ryporter

Message:

adding support for first() to pugs

Files:

• src/Pugs/Prim.hs (modified) (3 diffs)
• src/Pugs/Prim/List.hs (modified) (2 diffs)
• t/builtins/lists/first.t (modified) (2 diffs)

src/Pugs/Prim.hs

@@ -1040 +1040 @@
 op2 "pick" = op2Pick
 op2 "grep" = op2Grep
+op2 "first" = op2First
 op2 "map"  = op2Map
 op2 "join" = op2Join
@@ -1902 +1903 @@
 \\n   List      pre     map     safe   (Code, List)\
 \\n   List      pre     grep    safe   (Code, List)\
+\\n   Scalar    pre     first   safe   (Code, List)\
 \\n   List      pre     sort    safe   (Code, List)\
 \\n   List      pre     reduce  safe   (Code, List)\
@@ -1908 +1910 @@
 \\n   List      pre     map     safe   (Array: Code)\
 \\n   List      pre     grep    safe   (Array: Code)\
+\\n   Scalar    pre     first   safe   (Array: Code)\
 \\n   List      pre     sort    safe   (Array: Code)\
 \\n   List      pre     reduce  safe   (Array: Code)\

src/Pugs/Prim/List.hs

@@ -5 +5 @@
     op1Min, op1Max, op1Uniq,
     op2Pick,
-    op2ReduceL, op2Reduce, op2Grep, op2Map, op2Join,
+    op2ReduceL, op2Reduce, op2Grep, op2First, op2Map, op2Join,
     sortByM,
     op1HyperPrefix, op1HyperPostfix, op2Hyper,
@@ -331 +331 @@
     return $ VList vals
 
+op2First :: Val -> Val -> Eval Val
+op2First sub@(VCode _) list = op2First list sub
+op2First list sub = do
+  (VList vals) <- (op2Grep list sub)
+  if (length vals) > 0 
+    then return $ (vals !! 0)
+    else fail $ "Cannot call first() with a filter that removes all elements from the input list"
+
 op2Map :: Val -> Val -> Eval Val
 op2Map sub@(VCode _) list = op2Map list sub

t/builtins/lists/first.t

@@ -10 +10 @@
 =cut
 
-plan 6;
+plan 7;
 
 my @list = (1 .. 10);
@@ -16 +16 @@
 {
     my $result = first { ($_ % 2) }, @list;
-    ok ($result ~~ Item, "first() returns an Item");
-    is ($result, 1, "returned value by first() is correct");
+    ok($result ~~ Item, "first() returns an Item");
+    is($result, 1, "returned value by first() is correct");
 }
 
 {
     my $result = @list.first( { ($_ == 4)});
-    ok ($result ~~ Item, "method form of first returns an item");
-    is ($result, 4, "method form of first returns the expected item");
+    ok($result ~~ Item, "method form of first returns an item");
+    is($result, 4, "method form of first returns the expected item");
 }
 
 {
-    my $result = @list.grep():{ ($_ == 4) };
-    ok($result ~~ Item, "first():{block} returns an Item");
+    my $result = @list.first():{ ($_ == 4) };
+    ok($result ~~ Item, "first():<block> returns an Item");
     is($result, 4, "first() returned the expected value");
 }
 
+{
+    dies_ok { @list.first( { ($_ == 11) } ) }, "first should fail if there is no first element";
+}