Numeric.hs

{-# LANGUAGE QuasiQuotes #-}
module Atomo.Kernel.Numeric (load) where

import Data.Ratio

import Atomo


load :: VM ()
load = do
    mapM_ eval
        [ [e|operator right 8 ^|]
        , [e|operator 7 % * /|]
        , [e|operator 6 + -|]
        ]

    [p|(i: Integer) sqrt|] =: do
        Integer i <- here "i" >>= findInteger
        return (Double (sqrt (fromIntegral i)))

    [p|(d: Double) sqrt|] =: do
        Double d <- here "d" >>= findDouble
        return (Double (sqrt d))

    [p|(d: Double) ceiling|] =: do
        Double d <- here "d" >>= findDouble
        return (Integer (ceiling d))

    [p|(d: Double) round|] =: do
        Double d <- here "d" >>= findDouble
        return (Integer (round d))

    [p|(d: Double) floor|] =: do
        Double d <- here "d" >>= findDouble
        return (Integer (floor d))

    [p|(i: Integer) reciprocal|] =: do
        Integer i <- here "i" >>= findInteger
        return (Double (recip (fromIntegral i)))

    [p|(d: Double) reciprocal|] =: do
        Double d <- here "d" >>= findDouble
        return (Double (recip d))

    [p|(r: Rational) reciprocal|] =: do
        Rational r <- here "r" >>= findRational
        return (Rational (recip r))

    [p|(r: Rational) numerator|] =: do
        Rational r <- here "r" >>= findRational
        return (Integer (numerator r))

    [p|(r: Rational) denominator|] =: do
        Rational r <- here "r" >>= findRational
        return (Integer (denominator r))

    [p|(d: Double) as: Integer|] =::: [e|d floor|]
    [p|(d: Double) as: Rational|] =::: [e|d rationalize|]
    [p|(i: Integer) as: Double|] =: do
        Integer i <- here "i" >>= findInteger
        return (Double (fromIntegral i))
    [p|(i: Integer) as: Rational|] =: do
        Integer i <- here "i" >>= findInteger
        return (Rational (i % 1))
    [p|(r: Rational) as: Double|] =::: [e|r approximate|]
    [p|(r: Rational) as: Integer|] =::: [e|r approximate floor|]

    [p|(i: Integer) rationalize|] =::: [e|(i as: Double) rationalize|]
    [p|(d: Double) rationalize|] =::: [e|d rationalize: 0.001|]
    [p|(d: Double) rationalize: (e: Double)|] =: do
        Double d <- here "d" >>= findDouble
        Double e' <- here "e" >>= findDouble
        return (Rational (approxRational d e'))

    [p|(r: Rational) approximate|] =: do
        Rational r <- here "r" >>= findRational
        return (Double (fromRational r))

    [p|(a: Integer) + (b: Integer)|] =: primII (+)
    [p|(a: Rational) + (b: Rational)|] =: primRR (+)
    [p|(a: Double) + (b: Double)|] =: primDD (+)
    [p|(a: Integer) + (b: Double)|] =: primID (+)
    [p|(a: Integer) + (b: Rational)|] =: primIR (+)
    [p|(a: Double) + (b: Integer)|] =: primDI (+)
    [p|(a: Double) + (b: Rational)|] =: primDR (+)
    [p|(a: Rational) + (b: Integer)|] =: primRI (+)
    [p|(a: Rational) + (b: Double)|] =: primRD (+)

    [p|(a: Integer) - (b: Integer)|] =: primII (-)
    [p|(a: Rational) - (b: Rational)|] =: primRR (-)
    [p|(a: Double) - (b: Double)|] =: primDD (-)
    [p|(a: Integer) - (b: Double)|] =: primID (-)
    [p|(a: Integer) - (b: Rational)|] =: primIR (-)
    [p|(a: Double) - (b: Integer)|] =: primDI (-)
    [p|(a: Double) - (b: Rational)|] =: primDR (-)
    [p|(a: Rational) - (b: Integer)|] =: primRI (-)
    [p|(a: Rational) - (b: Double)|] =: primRD (-)

    [p|(a: Integer) * (b: Integer)|] =: primII (*)
    [p|(a: Rational) * (b: Rational)|] =: primRR (*)
    [p|(a: Double) * (b: Double)|] =: primDD (*)
    [p|(a: Integer) * (b: Double)|] =: primID (*)
    [p|(a: Integer) * (b: Rational)|] =: primIR (*)
    [p|(a: Double) * (b: Integer)|] =: primDI (*)
    [p|(a: Double) * (b: Rational)|] =: primDR (*)
    [p|(a: Rational) * (b: Integer)|] =: primRI (*)
    [p|(a: Rational) * (b: Double)|] =: primRD (*)

    [p|(a: Integer) / (b: Integer)|] =: primII div
    [p|(a: Rational) / (b: Rational)|] =: primRR (/)
    [p|(a: Double) / (b: Double)|] =: primDD (/)
    [p|(a: Integer) / (b: Double)|] =: primID (/)
    [p|(a: Integer) / (b: Rational)|] =: primIR (/)
    [p|(a: Double) / (b: Integer)|] =: primDI (/)
    [p|(a: Double) / (b: Rational)|] =: primDR (/)
    [p|(a: Rational) / (b: Integer)|] =: primRI (/)
    [p|(a: Rational) / (b: Double)|] =: primRD (/)

    [p|(a: Integer) ^ (b: Integer)|] =: primII (^)
    [p|(a: Double) ^ (b: Double)|] =: primDD (**)
    [p|(a: Integer) ^ (b: Double)|] =: primID (**)
    [p|(a: Double) ^ (b: Integer)|] =: primDI (**)
    [p|(a: Rational) ^ (b: Integer)|] =: do
        Rational a <- here "a" >>= findRational
        Integer b <- here "b" >>= findInteger
        return (Rational (a ^ b))

    [p|(a: Integer) % (b: Integer)|] =: primII mod
    [p|(a: Integer) quotient: (b: Integer)|] =: primII quot
    [p|(a: Integer) remainder: (b: Integer)|] =: primII rem
  where
    primII f = do
        Integer a <- here "a" >>= findInteger
        Integer b <- here "b" >>= findInteger
        return (Integer (f a b))

    primDD f = do
        Double a <- here "a" >>= findDouble
        Double b <- here "b" >>= findDouble
        return (Double (f a b))

    primRR f = do
        Rational a <- here "a" >>= findRational
        Rational b <- here "b" >>= findRational
        return (Rational (f a b))

    primID f = do
        Integer a <- here "a" >>= findInteger
        Double b <- here "b" >>= findDouble
        return (Double (f (fromIntegral a) b))

    primIR f = do
        Integer a <- here "a" >>= findInteger
        Rational b <- here "b" >>= findRational
        return (Rational (f (toRational a) b))

    primDI f = do
        Double a <- here "a" >>= findDouble
        Integer b <- here "b" >>= findInteger
        return (Double (f a (fromIntegral b)))

    primDR f = do
        Double a <- here "a" >>= findDouble
        Rational b <- here "b" >>= findRational
        return (Rational (f (toRational a) b))

    primRD f = do
        Rational a <- here "a" >>= findRational
        Double b <- here "b" >>= findDouble
        return (Rational (f a (toRational b)))

    primRI f = do
        Rational a <- here "a" >>= findRational
        Integer b <- here "b" >>= findInteger
        return (Rational (f a (toRational b)))