Changeset 2335 for src/Pugs/Prim.hs
- Timestamp:
- 04/25/05 21:09:55 (4 years ago)
- svk:copy_cache_prev:
- 3850
- Files:
-
- 1 modified
-
src/Pugs/Prim.hs (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
src/Pugs/Prim.hs
r2325 r2335 27 27 28 28 op0 :: Ident -> [Val] -> Eval Val 29 op0 "!" = fmap opJuncNone. mapM fromVal30 op0 "&" = fmap opJuncAll. mapM fromVal31 op0 "^" = fmap opJuncOne. mapM fromVal32 op0 "|" = fmap opJuncAny. mapM fromVal33 op0 "want" = const $ fmap VStr (asks envWant)29 op0 "!" = (return . opJuncNone =<<) . mapM fromVal 30 op0 "&" = (return . opJuncAll =<<) . mapM fromVal 31 op0 "^" = (return . opJuncOne =<<) . mapM fromVal 32 op0 "|" = (return . opJuncAny =<<) . mapM fromVal 33 op0 "want" = const $ return . VStr =<< asks envWant 34 34 op0 "time" = const $ do 35 35 clkt <- liftIO getClockTime … … 40 40 op0 "not" = const retEmpty 41 41 op0 "so" = const (return $ VBool True) 42 op0 "¥" = fmap (VList . concat . op0Zip) . mapM fromVal42 op0 "¥" = (return . VList . concat . op0Zip =<<) . mapM fromVal 43 43 op0 "Y" = op0 "¥" 44 44 op0 "File::Spec::cwd" = const $ do 45 45 mycwd <- liftIO getCurrentDirectory 46 46 return $ VStr mycwd 47 op0 "pi" = const $ return (VNum pi)47 op0 "pi" = const $ return . VNum $ pi 48 48 op0 "say" = const $ op1 "say" =<< readVar "$_" 49 49 op0 "print" = const $ op1 "print" =<< readVar "$_" … … 97 97 ref <- fromVal x 98 98 val' <- case val of 99 (VStr str) -> return (VStr $ strInc str)99 (VStr str) -> return . VStr $ strInc str 100 100 _ -> op1Numeric (+1) val 101 101 writeRef ref val' … … 146 146 val <- readRef ref 147 147 str <- fromVal val 148 return (VStr $ reverse str))148 return . VStr $ reverse str) 149 149 (do ref <- fromVal v 150 150 vals <- readRef ref 151 151 vlist <- fromVal vals 152 return (VList $ reverse vlist))152 return . VList $ reverse vlist) 153 153 _ -> ifListContext 154 154 (op1Cast (VList . reverse) v) … … 170 170 op1 "one" = op1Cast opJuncOne 171 171 op1 "none" = op1Cast opJuncNone 172 op1 "perl" = fmap VStr . prettyVal 0172 op1 "perl" = (return . VStr =<<) . (prettyVal 0) 173 173 op1 "require_haskell" = \v -> do 174 174 name <- fromVal v … … 222 222 op1 "readlink" = \v -> do 223 223 str <- fromVal v 224 tryIO undef $ fmap VStr (readSymbolicLink str)224 tryIO undef $ return . VStr =<< readSymbolicLink str 225 225 op1 "sleep" = boolIO (threadDelay . (* 1000000)) 226 226 op1 "mkdir" = boolIO createDirectory … … 254 254 ifListContext 255 255 (op1 "=" val) 256 ( fmap VStr(liftIO $ hGetContents h))256 (return . VStr =<< (liftIO $ hGetContents h)) 257 257 _ -> do 258 258 fileName <- fromVal val … … 306 306 (VSocket _) -> boolIO sClose val 307 307 _ -> boolIO hClose val 308 op1 "key" = fmap fst. (fromVal :: Val -> Eval VPair)309 op1 "value" = fmap snd. (fromVal :: Val -> Eval VPair)308 op1 "key" = (return . fst =<<) . (fromVal :: Val -> Eval VPair) 309 op1 "value" = (return . snd =<<) . (fromVal :: Val -> Eval VPair) 310 310 op1 "pairs" = \v -> do 311 311 pairs <- op1Pairs v … … 316 316 pair <- readRef ref 317 317 fromVal pair 318 return (VList $ concat kvs)318 return . VList $ concat kvs 319 319 op1 "keys" = op1Keys 320 320 op1 "values" = op1Values … … 336 336 getLine :: VHandle -> Eval Val 337 337 getLine fh = tryIO undef $ 338 fmap (VStr . (++ "\n")) (hGetLine fh)338 (return . VStr . (++ "\n") =<< hGetLine fh) 339 339 handleOf VUndef = handleOf (VList []) 340 340 handleOf (VList []) = do … … 353 353 return hdl 354 354 handleOf (VStr x) = do 355 rv <- tryIO Nothing ( fmap Just $openFile x ReadMode)355 rv <- tryIO Nothing (return . Just =<< openFile x ReadMode) 356 356 case rv of 357 357 Nothing -> retError "No such file or directory" (Val $ VStr x) … … 359 359 handleOf (VList [x]) = handleOf x 360 360 handleOf v = fromVal v 361 op1 "ref" = fmap (VStr . show) . evalValType361 op1 "ref" = (return . VStr . show =<<) . evalValType 362 362 op1 "pop" = \x -> join $ doArray x Array.pop -- monadic join 363 363 op1 "shift" = \x -> join $ doArray x Array.shift -- monadic join … … 386 386 387 387 op1Cast :: (Value n) => (n -> Val) -> Val -> Eval Val 388 op1Cast f val = fmap f (fromVal =<< fromVal' val)388 op1Cast f val = return . f =<< fromVal =<< fromVal' val 389 389 390 390 op2Cast :: (Value n, Value m) => (n -> m -> Val) -> Val -> Val -> Eval Val … … 602 602 op2 "exists" = \x y -> do 603 603 ref <- fromVal x 604 fmap VBool (existsFromRef ref y)604 return . VBool =<< existsFromRef ref y 605 605 op2 "unshift" = op2Array Array.unshift 606 606 op2 "push" = op2Array Array.push … … 644 644 op2 "splice" = \x y -> do 645 645 fetchSize <- doArray x Array.fetchSize 646 len 646 len' <- fromVal y 647 647 sz <- fetchSize 648 op4 "splice" x y (castV (sz - (len `mod` sz))) (VList []) 648 let len = if len' < 0 then if sz > 0 then (len' `mod` sz) else 0 else len' 649 op4 "splice" x y (castV (sz - len)) (VList []) 649 650 op2 "sort" = \x y -> do 650 651 xs <- fromVals x … … 768 769 769 770 op3 "splice" = \x y z -> do 770 op4 "splice" x y z (VList []) 771 op4 "splice" x y z (VList []) 771 772 op3 other = \x y z -> return $ VError ("unimplemented 3-ary op: " ++ other) (App other [Val x, Val y, Val z] []) 772 773 … … 793 794 794 795 -- op4 "splice" = \x y z w-> do 795 op4 "splice" = \x y z w -> do 796 op4 "splice" = \x y z w -> do 796 797 splice <- doArray x Array.splice 797 798 start <- fromVal y … … 807 808 op2Hyper op x y 808 809 | VList x' <- x, VList y' <- y 809 = fmap VList $ hyperLists x' y'810 = hyperLists x' y' >>= (return . VList) 810 811 | VList x' <- x 811 = fmap VList $ mapM ((flip (op2 op)) y) x'812 = mapM ((flip (op2 op)) y) x' >>= (return . VList) 812 813 | VList y' <- y 813 = fmap VList $ mapM (op2 op x) y'814 = mapM (op2 op x) y' >>= (return . VList) 814 815 | otherwise 815 816 = return $ VError "Hyper OP only works on lists" (Val VUndef) … … 949 950 op1Numeric f VUndef = return . VInt $ f 0 950 951 op1Numeric f (VInt x) = return . VInt $ f x 951 op1Numeric f l@(VList _)= fmap (VInt . f) (fromVal l)952 op1Numeric f l@(VList _)= return . VInt . f =<< fromVal l 952 953 op1Numeric f (VRat x) = return . VRat $ f x 953 954 op1Numeric f (VRef x) = op1Numeric f =<< readRef x 954 op1Numeric f x = fmap (VNum . f) (fromVal x)955 op1Numeric f x = return . VNum . f =<< fromVal x 955 956 956 957 --- XXX wrong: try num first, then int, then vcast to Rat (I think)
