type-digits 0.1.0.2 → 0.2
raw patch · 5 files changed
+112/−37 lines, 5 filesdep −tagged-thdep ~type-spine
Dependencies removed: tagged-th
Dependency ranges changed: type-spine
Files
- Type/Digits.hs +21/−28
- Type/Digits/Aux.hs +8/−3
- Type/Digits/Stage0.hs +30/−0
- Type/Digits/Stage1.hs +36/−0
- type-digits.cabal +17/−6
Type/Digits.hs view
@@ -15,58 +15,51 @@ -} module Type.Digits- (module Type.Digits.Aux,+ (digitStrings, radix,+ Digit, digit, toType, toType_, toDigits, toDigits_, flexible, fixed, flexible', fixed',- exactly) where+ exactly,+ digitNames, digitTypes, digitStopName, digitStopType) where import Type.Spine-import Type.Spine.Stage0 (kTypeG)-import Type.Spine.TH (liftNameG)--import Data.Proxy.TH (qProxy)+import Type.Spine.TH (liftNameG_d) +import Type.Digits.Stage0+import Type.Digits.Stage1 import Type.Digits.Aux import Language.Haskell.TH --- declares each digit and its 'Spine' instance-concat `fmap` sequence [ do- n <- return $ mkName n- let k2 = kTypeG $ ArrowK StarK StarK- x <- dataD (return []) n [PlainTV (mkName "x")] [] []- (:[x]) `fmap` tySynInstD ''Spine [k2 `appT` conT n]- (conT ''TypeName `appT` (k2 `appT` conT n))- | n <- digitNames]+fmap concat $ mapM spineType_pro $ 'DigitStop : digitNames + -- | Convert a number to the name of the corresponding digit -- error if the -- argument is out of range. digit :: (Show a, Eq a, Num a) => a -> Name digit r = $(caseE [| r |] $ [ match (litP (IntegerL k))- (normalB $ liftNameG $ mkName n) []- | (k, n) <- zip [0..] digitNames]+ (normalB $ liftNameG_d $ mkName n) []+ | (k, n) <- zip [0..] digitStrings] ++ [match wildP (normalB $ [| error $ "Type.Digits.digit: not (0 <= " ++ show r ++ " < " ++ show radix ++ ")" |]) []]) -- -- | Give a list of digit names, and a base type, yields a type. toType :: [Name] -> Type -> Type-toType = foldr (\n acc -> AppT (ConT n) . acc) id+toType = foldr (\n acc -> AppT (PromotedT n) . acc) id --- | @toType_ = ($ TupleT 0) . toType@.+-- | @toType_ = ($ PromotedT 'DigitStop) . toType@. toType_ :: [Name] -> Type-toType_ = ($ TupleT 0) . toType+toType_ = ($ PromotedT 'DigitStop) . toType -- | @toDigits f = toType . f@ toDigits :: (a -> [Name]) -> a -> Type -> Type toDigits f = toType . f --- | @toDigits_ = (($ TupleT 0) .) . toDigits@.+-- | @toDigits_ = (($ PromotedT 'DigitStop) .) . toDigits@. toDigits_ :: (a -> [Name]) -> a -> Type-toDigits_ = (($ TupleT 0) .) . toDigits+toDigits_ = (($ PromotedT 'DigitStop) .) . toDigits -- | @flexible' = flexible . fromEnum@ flexible' :: Enum a => a -> [Name]@@ -91,7 +84,7 @@ -- | Converts a @Bounded@ @Integral@ to a type-level numeral using exactly the -- number of digits it takes to represent each value of that type uniquely. fixed :: forall a. (Bounded a, Show a, Eq a, Integral a) => a -> [Name]-fixed = exactly (ceiling $ width [qProxy|a|]) . flexible+fixed = exactly (ceiling $ width (Proxy :: Proxy a)) . flexible {-@@ -99,22 +92,22 @@ packToDigits | ce == fl = concatMap fixed | otherwise = undefined where- p = [qProxy|a|]; w :: Float; w = width p; ce = ceiling w; fl = floor w+ p = Proxy :: Proxy a]; w :: Float; w = width p; ce = ceiling w; fl = floor w leftover = product (replicate ce radix) - spanT p leftover' = spanT p - product (replicate fl radix) -} -width :: (Bounded a, Integral a, Floating b) => [qProxy|a|] -> b+width :: (Bounded a, Integral a, Floating b) => Proxy a -> b width = width' . spanT width' :: Floating a => Integer -> a width' = logBase radix . fromInteger -spanT :: forall a. (Bounded a, Integral a) => [qProxy|a|] -> Integer+spanT :: forall a. (Bounded a, Integral a) => Proxy a -> Integer spanT _ = 1 + toInteger (maxBound :: a) - toInteger (minBound :: a) -spanT' :: forall a. (Bounded a, Enum a) => [qProxy|a|] -> Integer+spanT' :: forall a. (Bounded a, Enum a) => Proxy a -> Integer spanT' _ = 1 + toInteger (fromEnum (maxBound :: a) - fromEnum (minBound :: a)) -- | Pads its second argument so that the resulting length is its first
Type/Digits/Aux.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE PolyKinds #-}+ {- | Module : Type.Digits.Aux@@ -16,11 +18,14 @@ import Data.List (genericLength) -- | The names of the digits.-digitNames :: [String]-digitNames = map ('T':) $ take 128+digitStrings :: [String]+digitStrings = map ('T':) $ take 128 [ [c0, c1] | c0 <- ['0'..'9'] ++ ['A'..'F'], c1 <- ['0'..'9'] ++ ['A'..'F']] --digitNames = map (\c -> ['T', c]) $ ['0'..'9'] ++ ['A'..'F'] -- | The number of digits. radix :: Num i => i-radix = genericLength digitNames+radix = genericLength digitStrings+++data Proxy a = Proxy
+ Type/Digits/Stage0.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TemplateHaskell #-}++{- |++Module : Type.Digits.Stage0+Copyright : (c) The University of Kansas 2011+License : BSD3++Maintainer : nicolas.frisby@gmail.com+Stability : experimental+Portability : see LANGUAGE pragmas (... GHC)++Type-level numerals built from type-level digits of an arbitrary radix.++-}+module Type.Digits.Stage0 where++import Type.Digits.Aux++import Language.Haskell.TH++import Control.Monad (ap)++++-- declares each digit+(: []) `fmap` dataD (cxt []) (mkName "Digit") []+ (normalC (mkName "DigitStop") []+ : [ normalC n [(,) `fmap` notStrict `ap` conT (mkName "Digit")] | n <- map mkName digitStrings ]+ ) []
+ Type/Digits/Stage1.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE TemplateHaskell #-}++{- |++Module : Type.Digits.Stage1+Copyright : (c) The University of Kansas 2011+License : BSD3++Maintainer : nicolas.frisby@gmail.com+Stability : experimental+Portability : see LANGUAGE pragmas (... GHC)++Type-level numerals built from type-level digits of an arbitrary radix.++-}+module Type.Digits.Stage1 where++import Type.Digits.Aux (digitStrings)+import Type.Digits.Stage0+import Type.Spine.TH (liftNameG_d)++import Language.Haskell.TH++++digitNames :: [Name]+digitNames = $(listE $ [ liftNameG_d n | n <- map mkName digitStrings ])++digitTypes :: [Type]+digitTypes = map PromotedT digitNames++digitStopName :: Name+digitStopName = 'DigitStop++digitStopType :: Type+digitStopType = PromotedT digitStopName
type-digits.cabal view
@@ -1,5 +1,5 @@ Name: type-digits-Version: 0.1.0.2+Version: 0.2 License: BSD3 License-File: LICENSE Author: Nicolas Frisby <nicolas.frisby@gmail.com>@@ -9,16 +9,27 @@ Synopsis: Arbitrary-base type-level digits -Description: Arbitrary ype-level digits, for when the radix itself doesn't+Description: This is a workaround until type-level literals (specifically+ naturals) are more fully supported. The main difference is that these+ types-level digits and numerals can be inspected/case-discriminated within+ type family instances. See the @type-ord@ and @type-cereal@ packages for use+ cases; they ultimately support the @yoko@ package.++ Arbitrary type-level digits, for when the radix itself doesn't actually matter. It's currently base-128, because that seemed to best- expedite the compilation of the modules using this package. Please let me- know what you find if you experiment with this.+ expedite the compilation of the modules with which I using this+ package. Please let me know what you find if you experiment with this. 'Type.Digits.radix' is the (arbitrary) radix. 'Type.Digits.digit' computes the 'NameG' of a digit from its value (assuming its less than the radix). Combinators are provided to compute a full type-level numeral from values (potentially) larger than the radix. + The digits themselves all take less significant numeral as an argument. I+ chose this over minimal digits in promoted lists because I wanted to keep the+ actual encoding of type-level numeral smaller; they get quite large with some+ of my uses and the type family computation becomes quite slow.+ Cabal-Version: >= 1.6.0.1 Build-Type: Simple@@ -26,6 +37,6 @@ Library Build-Depends: base >= 4 && < 5, template-haskell- Build-Depends: type-spine < 0.2, tagged-th < 0.2+ Build-Depends: type-spine >= 0.2 - Exposed-Modules: Type.Digits, Type.Digits.Aux+ Exposed-Modules: Type.Digits, Type.Digits.Aux, Type.Digits.Stage0, Type.Digits.Stage1