Changeset 15201 for src/Pugs/Prim/Numeric.hs
- Timestamp:
- 02/06/07 21:28:57 (22 months ago)
- Files:
-
- 1 modified
-
src/Pugs/Prim/Numeric.hs (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
src/Pugs/Prim/Numeric.hs
r12522 r15201 3 3 module Pugs.Prim.Numeric ( 4 4 op2Numeric, op1Floating, op1Round, op1Numeric, 5 op2Exp, op2Divide, op2Modulus, 5 op2Exp, op2Divide, op2Modulus, op2OrdNumeric 6 6 ) where 7 7 import Pugs.Internals … … 11 11 import Pugs.Prim.Lifts 12 12 13 --- XXX wrong: try num first, then int, then vcast to Rat (I think) 13 op2OrdNumeric :: Value b => (forall a. (Ord a) => a -> a -> b) -> Val -> Val -> Eval Val 14 op2OrdNumeric f x y 15 | VInt x' <- x, VInt y' <- y = return $ castV $ f x' y' 16 | VRat x' <- x, VRat y' <- y = return $ castV $ f x' y' 17 | VRat x' <- x, VInt y' <- y = return $ castV $ f x' (y' % 1) 18 | VInt x' <- x, VRat y' <- y = return $ castV $ f (x' % 1) y' 19 | VUndef <- x = op2OrdNumeric f (VInt 0) y 20 | VUndef <- y = op2OrdNumeric f x (VInt 0) 21 | VType{} <- x = op2OrdNumeric f (VInt 0) y 22 | VType{} <- y = op2OrdNumeric f x (VInt 0) 23 | VRef r <- x = do 24 x' <- readRef r 25 op2OrdNumeric f x' y 26 | VRef r <- y = do 27 y' <- readRef r 28 op2OrdNumeric f x y' 29 | VComplex x' <- x = do 30 y' <- fromVal y 31 return . castV $ f x' y' 32 | VComplex y' <- y = do 33 x' <- fromVal x 34 return . castV $ f x' y' 35 | otherwise = do 36 x' <- fromVal x :: Eval VNum 37 y' <- fromVal y 38 return . castV $ f x' y' 39 14 40 op2Numeric :: (forall a. (Num a) => a -> a -> a) -> Val -> Val -> Eval Val 15 41 op2Numeric f x y … … 28 54 y' <- readRef r 29 55 op2Numeric f x y' 56 | VComplex x' <- x = do 57 y' <- fromVal y 58 return . VComplex $ f x' y' 59 | VComplex y' <- y = do 60 x' <- fromVal x 61 return . VComplex $ f x' y' 30 62 | otherwise = do 31 63 x' <- fromVal x … … 33 65 return . VNum $ f x' y' 34 66 35 op1Floating :: (Double -> Double) -> Val -> Eval Val 36 op1Floating f v = do 37 foo <- fromVal v 38 return $ VNum $ f foo 67 op1Floating :: (forall a. (Floating a) => a -> a) -> Val -> Eval Val 68 op1Floating f VUndef = return . VNum $ f 0 69 op1Floating f VType{} = return . VNum $ f 0 70 op1Floating f (VComplex x) = return . VComplex $ f x 71 op1Floating f (VRef x) = op1Floating f =<< readRef x 72 op1Floating f x = fmap (VNum . f) (fromVal x) 39 73 40 74 op1Round :: (Double -> Integer) -> Val -> Eval Val … … 52 86 op1Numeric f l@(VList _)= fmap (VInt . f) (fromVal l) 53 87 op1Numeric f (VRat x) = return . VRat $ f x 88 op1Numeric f (VComplex x) = return . VComplex $ f x 54 89 op1Numeric f (VRef x) = op1Numeric f =<< readRef x 55 90 op1Numeric f x = fmap (VNum . f) (fromVal x) … … 68 103 if isDigit . head $ show (num1 :: VNum) 69 104 then op2Rat ((^^) :: VRat -> VInt -> VRat) x y 70 else op2Num ( (**) :: VNum -> VNum -> VNum) x y71 _ -> op2Num ( (**) :: VNum -> VNum -> VNum) x y105 else op2Num (**) x y 106 _ -> op2Num (**) x y 72 107 73 108 op2Divide :: Val -> Val -> Eval Val … … 81 116 | VRat x' <- x, VRat y' <- y 82 117 = if y' == 0 then err else return . VRat $ x' / y' 118 | VComplex x' <- x = do 119 y' <- fromVal y 120 if y' == 0 then err else return . VComplex $ x' / y' 121 | VComplex y' <- y = do 122 x' <- fromVal x 123 if y' == 0 then err else return . VComplex $ x' / y' 83 124 | otherwise 84 125 = op2Num (/) x y … … 96 137 | VRat x' <- x, VRat y' <- y 97 138 = if y' == 0 then err else return . VRat $ x' `fmod` y' 139 -- | VComplex x' <- x = do 140 -- y' <- fromVal y 141 -- if y' == 0 then err else return . VComplex $ x' `fmod` y' 142 -- | VComplex y' <- y = do 143 -- x' <- fromVal x 144 -- if y' == 0 then err else return . VComplex $ x' `fmod` y' 98 145 | otherwise -- pray for the best 99 146 = op2Num fmod x y
