Changeset 3501

Timestamp:

05/20/05 13:59:49 (4 years ago)

Author:

iblech

svk:copy_cache_prev:

5078

Message:

uniq() implemented (with inplace syntax too), tests pass :)

Files:

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

src/Pugs/Prim.hs

@@ -462 +462 @@
 op1 "min"   = op1Min
 op1 "max"   = op1Max
+op1 "uniq"  = op1Uniq
 op1 "chr"   = op1Cast (VStr . (:[]) . chr)
 op1 "ord"   = op1Cast $ \str -> if null str then undef else (castV . ord . head) str
@@ -1084 +1085 @@
 \\n   Scalar    pre     min     (List)\
 \\n   Scalar    pre     max     (List)\
+\\n   List      pre     uniq    (List)\
 \\n   Str       pre     join    (Array: Str)\
 \\n   Str       pre     join    (Str, List)\

src/Pugs/Prim/List.hs

@@ -1 +1 @@
 module Pugs.Prim.List (
     op0Zip, op1Pick, op1Sum,
-    op1Min, op1Max,
+    op1Min, op1Max, op1Uniq,
     op2FoldL, op2Fold, op2Grep, op2Map, op2Join,
     sortByM,
@@ -102 +102 @@
         return $ if min_or_max (cmp > (0::VInt)) then a else b
 
+op1Uniq v = do
+    -- We want to have a real Haskell list
+    args    <- fromVal v
+    -- Extract our comparator sub, or Nothing if none was specified
+    (valList, cmp) <- case args of
+        (v:vs) -> do
+            ifValTypeIsa v "Code"
+                (return (vs, Just v))
+                (ifValTypeIsa (last args) "Code"
+                    (return (init args, Just $ last args))
+                    (return (args, Nothing)))
+        _  -> return (args, Nothing)
+    -- After this parameter unpacking, we begin doing the real work.
+    op1Uniq' cmp valList
+    where
+    op1Uniq' :: (Maybe Val) -> [Val] -> Eval Val
+    -- If the user didn't specify an own comparasion sub, we can simply use
+    -- Haskell's nub.
+    op1Uniq' Nothing valList = return . VList $ nub valList
+    -- Else, we have to write our own nubByM and use that.
+    op1Uniq' (Just subVal) valList = do
+        sub <- fromVal subVal
+        evl <- asks envEval
+        -- Here we execute the user's sub
+        result <- nubByM (\a b -> do
+            rv  <- local (\e -> e{ envContext = cxtItem "Bool" }) $ do
+                evl (App (Val sub) [Val a, Val b] [])
+            -- The sub returns either true or false.
+            bool <- fromVal rv
+            return . VBool $ bool) valList
+        return . VList $ result
+    -- This is the same as nubBy, only lifted into the Eval monad
+    nubByM :: (Val -> Val -> Eval Val) -> [Val] -> Eval [Val]
+    nubByM eq l = nubByM' l []
+      where
+        nubByM' [] _      = return []
+        nubByM' (y:ys) xs = do
+            -- elemByM returns a Val, but we need a VBool, so we have to use fromVal.
+            cond <- fromVal =<< elemByM eq y xs
+            if cond then nubByM' ys xs else do
+                result <- nubByM' ys (y:xs)
+                return (y:result)
+        elemByM :: (Val -> Val -> Eval Val) -> Val -> [Val] -> Eval Val
+        elemByM _  _ []     = return . VBool $ False
+        elemByM eq y (x:xs) = do
+            cond <- fromVal =<< eq x y
+            -- Same here (we need a VBool, not a Var).
+            if cond then return . VBool $ cond else elemByM eq y xs
+
 op2FoldL :: Val -> Val -> Eval Val
 op2FoldL sub@(VCode _) list = op2FoldL list sub

t/builtins/lists/uniq.t

@@ -20 +20 @@
   my @array = <a b b c d e b b b b f b>;
   is ~@array, "a b b c d e b b b b f b",  "basic sanity";
-  is eval('~@array.uniq'), "a b c d e f", "method form of uniq works", :todo;
-  is eval('~uniq @array'), "a b c d e f", "subroutine form of uniq works", :todo;
-  ok eval('@array.=uniq'),                "inplace form of uniq works (1)", :todo;
-  is      ~@array,         "a b c d e f", "inplace form of uniq works (2)", :todo;
+  is eval('~@array.uniq'), "a b c d e f", "method form of uniq works";
+  is eval('~uniq @array'), "a b c d e f", "subroutine form of uniq works";
+  ok eval('@array.=uniq'),                "inplace form of uniq works (1)";
+  is      ~@array,         "a b c d e f", "inplace form of uniq works (2)";
 }
 
@@ -30 +30 @@
   my @array = <a b A c b d>;
   # Semantics w/o junctions
-  is eval('~@array.uniq:{ lc $^a eq lc $^b }'), "a b c d", "method form of uniq with own comparator works", :todo;
-  is eval('~uniq { lc $^a eq lc $^b } @array'), "a b c d", "subroutine form of uniq with own comparator works", :todo;
+  is eval('~@array.uniq:{ lc $^a eq lc $^b }'), "a b c d", "method form of uniq with own comparator works";
+  is eval('~uniq { lc $^a eq lc $^b } @array'), "a b c d", "subroutine form of uniq with own comparator works";
 
   # Semantics w/ junctions