type-digits (empty) → 0.1

raw patch · 5 files changed

+185/−0 lines, 5 filesdep +basedep +tagged-thdep +template-haskellsetup-changed

Dependencies added: base, tagged-th, template-haskell, type-spine

Files

• LICENSE +0/−0
• Setup.hs +2/−0
• Type/Digits.hs +126/−0
• Type/Digits/Aux.hs +26/−0
• type-digits.cabal +31/−0

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,126 @@+{-# LANGUAGE TypeFamilies, EmptyDataDecls, TemplateHaskell,+  ScopedTypeVariables, QuasiQuotes #-}++{- |++Module      :  Type.Digits+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+  (module Type.Digits.Aux,+   digit, toType, toType_, toDigits, toDigits_,+   flexible, fixed, flexible', fixed',+   exactly) where++import Type.Spine+import Type.Spine.Stage0 (kTypeG)+import Type.Spine.TH (liftNameG)++import Data.Proxy.TH (qProxy)++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]++-- | Convert a number to the name of the corresponding digit -- error if the+-- argument is out of range.+digit :: Num a => a -> Name+digit r = $(caseE [| r |] $ [+  match (litP (IntegerL k))+          (normalB $ liftNameG $ mkName n) []+ | (k, n) <- zip [0..] digitNames]+            ++ [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_ = ($ TupleT 0) . toType@.+toType_ :: [Name] -> Type+toType_ = ($ TupleT 0) . toType++-- | @toDigits f = toType . f@+toDigits :: (a -> [Name]) -> a -> Type -> Type+toDigits f = toType . f++-- | @toDigits_ = (($ TupleT 0) .) . toDigits@.+toDigits_ :: (a -> [Name]) -> a -> Type+toDigits_ = (($ TupleT 0) .) . toDigits++-- | @flexible' = flexible . fromEnum@+flexible' :: Enum a => a -> [Name]+flexible' = flexible . fromEnum++-- | @fixed' = fixed . fromEnum@+fixed' :: Enum a => a -> [Name]+fixed' = fixed . fromEnum++-- | Converts an @Integral@ to a type-level numeral using as many digits as it+-- takes that particular number.+flexible :: Integral a => a -> [Name]+flexible+  | 0 == radix = digit' -- NB guard against @/0@ -- e.g. number of elements in @a@ = radix+  | otherwise = w where+  digit' = (:[]) . digit+  w n = k $ digit' r where+    (q, r) = quotRem n radix+    k | 0 == q = id+      | otherwise = (w q ++)++-- | 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, Integral a) => a -> [Name]+fixed = exactly (ceiling $ width [qProxy|a|]) . flexible+++{-+packToDigits :: forall a. (Bounded a, Integral a) => [a] -> [Name]+packToDigits+  | ce == fl = concatMap fixed+  | otherwise = undefined where+  p = [qProxy|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 = width' . spanT++width' :: Floating a => Integer -> a+width' = logBase radix . fromInteger++spanT :: forall a. (Bounded a, Integral a) => [qProxy|a|] -> Integer+spanT _ = 1 + toInteger (maxBound :: a) - toInteger (minBound :: a)++spanT' :: forall a. (Bounded a, Enum a) => [qProxy|a|] -> Integer+spanT' _ = 1 + toInteger (fromEnum (maxBound :: a) - fromEnum (minBound :: a))++-- | Pads its second argument so that the resulting length is its first+-- argument; fails if the second argument is already larger.+exactly :: Int -> [Name] -> [Name]+exactly k l+  | n > k = error "Base: argument to `exactly' has too many elements"+  | otherwise = replicate (k - n) (digit 0) ++ l+  where n = length l

@@ -0,0 +1,26 @@+{- |++Module      :  Type.Digits.Aux+Copyright   :  (c) The University of Kansas 2011+License     :  BSD3++Maintainer  :  nicolas.frisby@gmail.com+Stability   :  experimental+Portability :  see LANGUAGE pragmas (... GHC)++The parameters for the @type-digits@ package.++-}+module Type.Digits.Aux where++import Data.List (genericLength)++-- | The names of the digits.+digitNames :: [String]+digitNames = 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

@@ -0,0 +1,31 @@+Name:           type-digits+Version:        0.1+License:        BSD3+License-File:   LICENSE+Author:         Nicolas Frisby <nicolas.frisby@gmail.com>+Maintainer:     Nicolas Frisby <nicolas.frisby@gmail.com>++Category: Type System++Synopsis:       /Arbitrary/ type-level digits++Description: Arbitrary ype-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.++  '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.++Cabal-Version: >= 1.6.0.1++Build-Type: Simple+++Library+  Build-Depends: base >= 4 && < 5, template-haskell+  Build-Depends: type-spine < 0.2, tagged-th < 0.2++  Exposed-Modules: Type.Digits, Type.Digits.Aux