reflection 1.2.0.1 → 1.3

raw patch · 3 files changed

+147/−4 lines, 3 filesdep +template-haskelldep ~base

Dependencies added: template-haskell

Dependency ranges changed: base

Files

• CHANGELOG.markdown +3/−0
• fast/Data/Reflection.hs +141/−2
• reflection.cabal +3/−2

@@ -1,3 +1,6 @@+# 1.3+* Merged some functionality from Data.Analytics.Reflection. Notably the ability to use type nats to reflect numbers, and to splice numbers directly. This reduces orphan instances somewhat.+ # 1.2 * Added `Given` and give. 

@@ -1,8 +1,19 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE TemplateHaskell #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeOperators #-}+#define USE_TYPE_LITS 1+#endif+{-# OPTIONS_GHC -fno-warn-orphans #-} ---------------------------------------------------------------------------- -- | -- Module     : Data.Reflection@@ -46,16 +57,29 @@     -- * Given     , Given(..)     , give+    -- * Template Haskell reflection+    , int, nat+    -- * Useful compile time naturals+    , Z, D, SD, PD     ) where +import Control.Monad+import Data.Functor import Data.Proxy +#ifdef USE_TYPE_LITS+import GHC.TypeLits+#endif++import Language.Haskell.TH hiding (reify)+ #ifdef __HUGS__ import Hugs.IOExts #else import Unsafe.Coerce #endif + ------------------------------------------------------------------------------ -- Reifies ------------------------------------------------------------------------------@@ -93,3 +117,118 @@ give :: forall a r. a -> (Given a => r) -> r give a k = unsafeCoerce (Gift k :: Gift a r) a {-# INLINE give #-}+++data Z -- 0+data D  (n :: *) -- 2n+data SD (n :: *) -- 2n+1+data PD (n :: *) -- 2n-1++instance Reifies Z Int where+  reflect _ = 0+  {-# INLINE reflect #-}++retagD :: (Proxy n -> a) -> proxy (D n) -> a+retagD f _ = f Proxy+{-# INLINE retagD #-}++retagSD :: (Proxy n -> a) -> proxy (SD n) -> a+retagSD f _ = f Proxy+{-# INLINE retagSD #-}++retagPD :: (Proxy n -> a) -> proxy (PD n) -> a+retagPD f _ = f Proxy+{-# INLINE retagPD #-}++instance Reifies n Int => Reifies (D n) Int where+  reflect = (\n -> n + n) <$> retagD reflect+  {-# INLINE reflect #-}++instance Reifies n Int => Reifies (SD n) Int where+  reflect = (\n -> n + n + 1) <$> retagSD reflect+  {-# INLINE reflect #-}++instance Reifies n Int => Reifies (PD n) Int where+  reflect = (\n -> n + n - 1) <$> retagPD reflect+  {-# INLINE reflect #-}++-- | This can be used to generate a template haskell splice for a type level version of a given 'int'.+--+-- This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used+-- in the \"Functional Pearl: Implicit Configurations\" paper by Oleg Kiselyov and Chung-Chieh Shan.+int :: Int -> TypeQ+int n = case quotRem n 2 of+  (0, 0) -> conT ''Z+  (q,-1) -> conT ''PD `appT` int q+  (q, 0) -> conT ''D  `appT` int q+  (q, 1) -> conT ''SD `appT` int q+  _     -> error "ghc is bad at math"++-- | This is a restricted version of 'int' that can only generate natural numbers. Attempting to generate+-- a negative number results in a compile time error. Also the resulting sequence will consist entirely of+-- Z, D, and SD constructors representing the number in zeroless binary.+nat :: Int -> TypeQ+nat n+  | n >= 0 = int n+  | otherwise = error "nat: negative"++instance Num a => Num (Q a) where+  (+) = liftM2 (+)+  (*) = liftM2 (*)+  (-) = liftM2 (-)+  negate = fmap negate+  abs = fmap abs+  signum = fmap signum+  fromInteger = return . fromInteger++instance Fractional a => Fractional (Q a) where+  (/) = liftM2 (/)+  recip = fmap recip+  fromRational = return . fromRational++-- | This permits the use of $(5) as a type splice.+instance Num Type where+#ifdef USE_TYPE_LITS+  a + b = AppT (AppT (VarT ''(+)) a) b+  a * b = AppT (AppT (VarT ''(*)) a) b+#if MIN_VERSION_base(4,8,0)+  a - b = AppT (AppT (VarT ''(-)) a) b+#else+  (-) = error "Type.(-): undefined"+#endif+  fromInteger = LitT . NumTyLit+#else+  (+) = error "Type.(+): undefined"+  (*) = error "Type.(*): undefined"+  (-) = error "Type.(-): undefined"+  fromInteger n = case quotRem n 2 of+      (0, 0) -> ConT ''Z+      (q,-1) -> ConT ''PD `AppT` fromInteger q+      (q, 0) -> ConT ''D  `AppT` fromInteger q+      (q, 1) -> ConT ''SD `AppT` fromInteger q+      _ -> error "ghc is bad at math"+#endif+  abs = error "Type.abs"+  signum = error "Type.signum"++plus, times, minus :: Num a => a -> a -> a+plus = (+)+times = (*)+minus = (-)+fract :: Fractional a => a -> a -> a+fract = (/)++-- | This permits the use of $(5) as an expression splice.+instance Num Exp where+  a + b = AppE (AppE (VarE 'plus) a) b+  a * b = AppE (AppE (VarE 'times) a) b+  a - b = AppE (AppE (VarE 'minus) a) b+  negate = AppE (VarE 'negate)+  signum = AppE (VarE 'signum)+  abs = AppE (VarE 'abs)+  fromInteger = LitE . IntegerL++instance Fractional Exp where+  a / b = AppE (AppE (VarE 'fract) a) b+  recip = AppE (VarE 'recip)+  fromRational = LitE . RationalL

@@ -1,5 +1,5 @@ name:           reflection-version:        1.2.0.1+version:        1.3 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett, Elliott Hird, Oleg Kiselyov and Chung-chieh Shan@@ -52,7 +52,8 @@    build-depends:     base >= 2 && < 5,-    tagged >= 0.4.4 && < 1+    tagged >= 0.4.4 && < 1,+    template-haskell    default-language: Haskell98