Changeset 2952

Timestamp:

05/11/05 00:31:18 (4 years ago)

Author:

bsmith

svk:copy_cache_prev:

4498

Message:

Refactoring: Pugs.Prims -> Pugs.Prims.Numeric and Pugs.Prims.Lifts

Location:

src/Pugs

Files:

• Prim.hs (modified) (4 diffs)
• Prim/Lifts.hs (added)
• Prim/Numeric.hs (modified) (2 diffs)

src/Pugs/Prim.hs

@@ -27 +27 @@
 import Pugs.Prim.List
 import Pugs.Prim.Numeric
+import Pugs.Prim.Lifts
 
 op0 :: Ident -> [Val] -> Eval Val
@@ -437 +438 @@
             retEmpty
 
-op1Cast :: (Value n) => (n -> Val) -> Val -> Eval Val
-op1Cast f val = fmap f (fromVal =<< fromVal' val)
-
-op2Cast :: (Value n, Value m) => (n -> m -> Val) -> Val -> Val -> Eval Val
-op2Cast f x y = do
-    x' <- fromVal =<< fromVal' x
-    y' <- fromVal =<< fromVal' y
-    return (f x' y')
-
 op1StrFirst :: (Char -> Char) -> Val -> Eval Val
 op1StrFirst f = op1Cast $ VStr .
@@ -784 +776 @@
         return (val:rest)
 
-op2Array :: (forall a. ArrayClass a => a -> [Val] -> Eval ()) -> Val -> Val -> Eval Val
-op2Array f x y = do
-    f    <- doArray x f
-    vals <- fromVal y
-    f vals
-    size <- doArray x array_fetchSize
-    idx  <- size
-    return $ castV idx
-
-vCastStr :: Val -> Eval VStr
-vCastStr = fromVal
-vCastRat :: Val -> Eval VRat
-vCastRat = fromVal
-
-op2Str :: (Value v1, Value v2) => (v1 -> v2 -> VStr) -> Val -> Val -> Eval Val
-op2Str f x y = do
-    x' <- fromVal x
-    y' <- fromVal y
-    return $ VStr $ f x' y'
-
-op2Num    :: (Value v1, Value v2) => (v1 -> v2 -> VNum) -> Val -> Val -> Eval Val
-op2Num  f = op2Cast $ (VNum .) . f
-
-op2Bool   :: (Value v1, Value v2) => (v1 -> v2 -> VBool) -> Val -> Val -> Eval Val
-op2Bool f = op2Cast $ (VBool .) . f
-
-op2Int    :: (Value v1, Value v2) => (v1 -> v2 -> VInt) -> Val -> Val -> Eval Val
-op2Int  f = op2Cast $ (VInt .) . f
-
-op2Rat    :: (Value v1, Value v2) => (v1 -> v2 -> VRat) -> Val -> Val -> Eval Val
-op2Rat  f = op2Cast $ (VRat .) . f
-
-op2Exp :: Val -> Val -> Eval Val
-op2Exp x y = do
-    num2 <- fromVal =<< fromVal' y
-    case reverse $ show (num2 :: VNum) of
-        ('0':'.':_) -> do
-            num1 <- fromVal =<< fromVal' x
-            if isDigit . head $ show (num1 :: VNum)
-                then op2Rat ((^^) :: VRat -> VInt -> VRat) x y
-                else op2Num ((**) :: VNum -> VNum -> VNum) x y
-        _ -> op2Num ((**) :: VNum -> VNum -> VNum) x y
-
 op1Range :: Val -> Val
 op1Range (VStr s)    = VList $ map VStr $ strRangeInf s
@@ -840 +789 @@
 op2Range x (VRat n)  = VList $ map VRat [vCast x .. n]
 op2Range x y         = VList $ map VInt [vCast x .. vCast y]
-
-op2Divide :: Val -> Val -> Eval Val
-op2Divide x y
-    | VInt x' <- x, VInt y' <- y
-    = if y' == 0 then err else return . VRat $ x' % y'
-    | VInt x' <- x, VRat y' <- y
-    = if y' == 0 then err else return . VRat $ (x' % 1) / y'
-    | VRat x' <- x, VInt y' <- y
-    = if y' == 0 then err else return . VRat $ x' / (y' % 1)
-    | VRat x' <- x, VRat y' <- y
-    = if y' == 0 then err else return . VRat $ x' / y'
-    | otherwise
-    = op2Num (/) x y
-    where
-    err = fail "Illegal division by zero"
-
-op2Modulus :: Val -> Val -> Eval Val
-op2Modulus x y
-    | VInt x' <- x, VInt y' <- y
-    = if y' == 0 then err else return . VInt $ x' `mod` y'
-    | VInt x' <- x, VRat y' <- y
-    = if y' == 0 then err else return . VInt $ x' `mod` (truncate y')
-    | VRat x' <- x, VInt y' <- y
-    = if y' == 0 then err else return . VInt $ (truncate x') `mod` y'
-    | VRat x' <- x, VRat y' <- y
-    = if y' == 0 then err else return . VInt $ (truncate x') `mod` (truncate y')
-    | VRef ref <- x
-    = do
-        x' <- readRef ref
-        op2Modulus x' y
-    | VRef ref <- y
-    = do
-        y' <- readRef ref
-        op2Modulus x y'
-    | otherwise      -- pray for the best
-    = op2Int mod x y -- typeErr
-    where
-    err = fail "Illegal modulus zero"
 
 op2ChainedList :: Val -> Val -> Val

src/Pugs/Prim/Numeric.hs

@@ -3 +3 @@
 module Pugs.Prim.Numeric (
     op2Numeric, op1Floating, op1Numeric,
+    op2Exp, op2Divide, op2Modulus,
 ) where
 import Pugs.Internals
 import Pugs.AST
+import Pugs.Types
+
+import Pugs.Prim.Lifts
 
 --- XXX wrong: try num first, then int, then vcast to Rat (I think)
@@ -39 +43 @@
 op1Numeric f (VRef x)   = op1Numeric f =<< readRef x
 op1Numeric f x          = fmap (VNum . f) (fromVal x)
+
+op2Exp :: Val -> Val -> Eval Val
+op2Exp x y = do
+    num2 <- fromVal =<< fromVal' y
+    case reverse $ show (num2 :: VNum) of
+        ('0':'.':_) -> do
+            num1 <- fromVal =<< fromVal' x
+            if isDigit . head $ show (num1 :: VNum)
+                then op2Rat ((^^) :: VRat -> VInt -> VRat) x y
+                else op2Num ((**) :: VNum -> VNum -> VNum) x y
+        _ -> op2Num ((**) :: VNum -> VNum -> VNum) x y
+
+op2Divide :: Val -> Val -> Eval Val
+op2Divide x y
+    | VInt x' <- x, VInt y' <- y
+    = if y' == 0 then err else return . VRat $ x' % y'
+    | VInt x' <- x, VRat y' <- y
+    = if y' == 0 then err else return . VRat $ (x' % 1) / y'
+    | VRat x' <- x, VInt y' <- y
+    = if y' == 0 then err else return . VRat $ x' / (y' % 1)
+    | VRat x' <- x, VRat y' <- y
+    = if y' == 0 then err else return . VRat $ x' / y'
+    | otherwise
+    = op2Num (/) x y
+    where
+    err = fail "Illegal division by zero"
+
+op2Modulus :: Val -> Val -> Eval Val
+op2Modulus x y
+    | VInt x' <- x, VInt y' <- y
+    = if y' == 0 then err else return . VInt $ x' `mod` y'
+    | VInt x' <- x, VRat y' <- y
+    = if y' == 0 then err else return . VInt $ x' `mod` (truncate y')
+    | VRat x' <- x, VInt y' <- y
+    = if y' == 0 then err else return . VInt $ (truncate x') `mod` y'
+    | VRat x' <- x, VRat y' <- y
+    = if y' == 0 then err else return . VInt $ (truncate x') `mod` (truncate y')
+    | VRef ref <- x
+    = do
+        x' <- readRef ref
+        op2Modulus x' y
+    | VRef ref <- y
+    = do
+        y' <- readRef ref
+        op2Modulus x y'
+    | otherwise      -- pray for the best
+    = op2Int mod x y -- typeErr
+    where
+    err = fail "Illegal modulus zero"