Changeset 2952 for src/Pugs/Prim/Numeric.hs

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

Files:

• src/Pugs/Prim/Numeric.hs (modified) (2 diffs)

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"