Ticket #7803: Lib.hs

File Lib.hs, 1.9 KB (added by akio, 13 months ago)
Line 
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE UndecidableInstances #-}
7
8module Lib
9    ( Evaluate (..)
10    , HasIntegral (..)
11    , Poly4 (..)
12    , Domain
13    , IntOfLogPoly4 (..)
14    , Piecewise (..)
15    ) where
16
17import GHC.Exts (Constraint)
18
19class Evaluate poly where
20    evaluate :: (Domain' poly a) => poly a -> a -> a
21
22class Evaluate (IntegralOf poly) => HasIntegral poly where
23    type IntegralOf poly :: * -> *
24    indefinite :: (Domain' poly a, Domain' (IntegralOf poly) a) => poly a -> IntegralOf poly a
25
26type family Domain (f :: * -> *) a :: Constraint
27
28class Domain f a => Domain' f a
29instance Domain f a => Domain' f a
30
31newtype Poly4 a = Poly4 { poly4_a :: a }
32
33type instance Domain Poly4 a = Fractional a
34
35data IntOfLogPoly4 a = IntOfLogPoly4 { ilp4_k :: !a , ilp4_u :: !a }
36
37type instance Domain IntOfLogPoly4 a = (Floating a)
38
39instance Evaluate IntOfLogPoly4 where
40    evaluate (IntOfLogPoly4 k _) x = k + x * exp5Tail (- log x)
41    {-# INLINE evaluate #-}
42
43{-# RULES "exp5Tail/Double" exp5Tail = exp5TailDouble #-}
44{-# NOINLINE exp5Tail #-}
45
46exp5Tail :: (Floating a) => a -> a
47exp5Tail x = x / 120
48
49exp5TailDouble :: Double -> Double
50exp5TailDouble x = x / 120
51
52instance HasIntegral Poly4 where
53    type IntegralOf Poly4 = IntOfLogPoly4
54    indefinite = \ (Poly4 a) -> IntOfLogPoly4 0 a
55    {-# INLINE indefinite #-}
56
57newtype Piecewise poly a = Piecewise {unPiecewise :: [poly a]}
58
59type instance Domain (Piecewise poly) a = (Domain poly a, Num a)
60
61instance (Evaluate poly) => Evaluate (Piecewise poly) where
62    evaluate = \ (Piecewise pp) x ->
63        evaluate (head pp) x
64    {-# INLINE evaluate #-}
65
66instance (HasIntegral poly ) =>
67        HasIntegral (Piecewise poly) where
68    type IntegralOf (Piecewise poly) = Piecewise (IntegralOf poly)
69    indefinite (Piecewise m) = Piecewise $ map indefinite m
70    {-# INLINE indefinite #-}