gdritter repos endsay / master src / PSNum.hs
master

Tree @master (Download .tar.gz)

PSNum.hs @master — raw · history · blame 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
{-# LANGUAGE RankNTypes #-}

module PSNum where

import Types

data PSNum
  = PSInt Integer
  | PSReal Double
    deriving (Eq, Show)

toPSNum :: Object -> Endsay PSNum
toPSNum (OInteger n) = return (PSInt n)
toPSNum (OReal n)    = return (PSReal n)
toPSNum _            = error ".."

fromPSNum :: PSNum -> Object
fromPSNum (PSInt n)  = OInteger n
fromPSNum (PSReal n) = OReal n

promoteNum :: (forall a. Num a => a -> a -> a) -> PSNum -> PSNum -> PSNum
promoteNum op (PSInt x)  (PSInt y)  = PSInt (x `op` y)
promoteNum op (PSInt x)  (PSReal y) = PSReal (fromIntegral x `op` y)
promoteNum op (PSReal x) (PSInt y)  = PSReal (x `op` fromIntegral y)
promoteNum op (PSReal x) (PSReal y) = PSReal (x `op` y)

resNum :: (forall a. (Num a, Ord a) => a -> a -> b) -> PSNum -> PSNum -> b
resNum op (PSInt x)  (PSInt y)  = (x `op` y)
resNum op (PSInt x)  (PSReal y) = (fromIntegral x `op` y)
resNum op (PSReal x) (PSInt y)  = (x `op` fromIntegral y)
resNum op (PSReal x) (PSReal y) = (x `op` y)

overNum :: (forall a. Num a => a -> a) -> PSNum -> PSNum
overNum op (PSInt x) = PSInt (op x)
overNum op (PSReal x) = PSReal (op x)

instance Num PSNum where
  (+) = promoteNum (+)
  (-) = promoteNum (-)
  (*) = promoteNum (*)
  negate = overNum negate
  abs = overNum abs
  signum = overNum signum
  fromInteger = PSInt

instance Ord PSNum where
  compare = resNum compare