Changeset 3501 for src/Pugs/Prim/List.hs

Show
Ignore:
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:
1 modified

Legend:

Unmodified
Added
Removed

  • src/Pugs/Prim/List.hs

    r3495 r3501  
    11module Pugs.Prim.List ( 
    22    op0Zip, op1Pick, op1Sum, 
    3     op1Min, op1Max, 
     3    op1Min, op1Max, op1Uniq, 
    44    op2FoldL, op2Fold, op2Grep, op2Map, op2Join, 
    55    sortByM, 
    … …  
    102102        return $ if min_or_max (cmp > (0::VInt)) then a else b 
    103103 
     104op1Uniq v = do 
     105    -- We want to have a real Haskell list 
     106    args    <- fromVal v 
     107    -- Extract our comparator sub, or Nothing if none was specified 
     108    (valList, cmp) <- case args of 
     109        (v:vs) -> do 
     110            ifValTypeIsa v "Code" 
     111                (return (vs, Just v)) 
     112                (ifValTypeIsa (last args) "Code" 
     113                    (return (init args, Just $ last args)) 
     114                    (return (args, Nothing))) 
     115        _  -> return (args, Nothing) 
     116    -- After this parameter unpacking, we begin doing the real work. 
     117    op1Uniq' cmp valList 
     118    where 
     119    op1Uniq' :: (Maybe Val) -> [Val] -> Eval Val 
     120    -- If the user didn't specify an own comparasion sub, we can simply use 
     121    -- Haskell's nub. 
     122    op1Uniq' Nothing valList = return . VList $ nub valList 
     123    -- Else, we have to write our own nubByM and use that. 
     124    op1Uniq' (Just subVal) valList = do 
     125        sub <- fromVal subVal 
     126        evl <- asks envEval 
     127        -- Here we execute the user's sub 
     128        result <- nubByM (\a b -> do 
     129            rv  <- local (\e -> e{ envContext = cxtItem "Bool" }) $ do 
     130                evl (App (Val sub) [Val a, Val b] []) 
     131            -- The sub returns either true or false. 
     132            bool <- fromVal rv 
     133            return . VBool $ bool) valList 
     134        return . VList $ result 
     135    -- This is the same as nubBy, only lifted into the Eval monad 
     136    nubByM :: (Val -> Val -> Eval Val) -> [Val] -> Eval [Val] 
     137    nubByM eq l = nubByM' l [] 
     138      where 
     139        nubByM' [] _      = return [] 
     140        nubByM' (y:ys) xs = do 
     141            -- elemByM returns a Val, but we need a VBool, so we have to use fromVal. 
     142            cond <- fromVal =<< elemByM eq y xs 
     143            if cond then nubByM' ys xs else do 
     144                result <- nubByM' ys (y:xs) 
     145                return (y:result) 
     146        elemByM :: (Val -> Val -> Eval Val) -> Val -> [Val] -> Eval Val 
     147        elemByM _  _ []     = return . VBool $ False 
     148        elemByM eq y (x:xs) = do 
     149            cond <- fromVal =<< eq x y 
     150            -- Same here (we need a VBool, not a Var). 
     151            if cond then return . VBool $ cond else elemByM eq y xs 
     152 
    104153op2FoldL :: Val -> Val -> Eval Val 
    105154op2FoldL sub@(VCode _) list = op2FoldL list sub