data-type (empty) → 0.0.1

raw patch · 12 files changed

+455/−0 lines, 12 filesdep +basesetup-changed

Dependencies added: base

Files

.ghci +3/−0
Data/Type/Apply.hs +16/−0
Data/Type/Bool.hs +80/−0
Data/Type/Eq.hs +21/−0
Data/Type/Member.hs +35/−0
Data/Type/Nat.hs +26/−0
Data/Type/TList.hs +7/−0
Data/Type/Test/Bool.hs +175/−0
Data/Type/Test/Nat.hs +25/−0
LICENSE +30/−0
Setup.hs +2/−0
data-type.cabal +35/−0

+ .ghci view

@@ -0,0 +1,3 @@+let extensions= (const . return $ let version = Data.Version.versionBranch System.Info.compilerVersion in if version < [6, 6] then ":set -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances" else if version >= [6, 8] then ":set -XTypeOperators" else "") :: String -> IO String
+:def extensions extensions
+:extensions

+ Data/Type/Apply.hs view

@@ -0,0 +1,16 @@+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+-- .$Header: c:/Source/Haskell/Type/Data/Type/RCS/Apply.hs,v 1.1 2010/01/16 00:39:25 dosuser Exp dosuser $
+module Data.Type.Apply where
+
+-- A heterogeneous apply operator
+
+class Apply f a r | f a -> r where
+  apply :: f -> a -> r
+  apply = undefined
+
+-- Normal function application
+instance Apply (x -> y) x y where
+  apply f x = f x
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

+ Data/Type/Bool.hs view

@@ -0,0 +1,80 @@+{-# LANGUAGE EmptyDataDecls, MultiParamTypeClasses, FunctionalDependencies #-}
+{-# LANGUAGE CPP, UndecidableInstances, FlexibleInstances #-}
+--
+-- .$Header: c:/Source/Haskell/Type/Data/Type/RCS/Bool.hs,v 1.2 2010/02/03 01:11:45 dosuser Exp dosuser $
+module Data.Type.Bool where
+
+data TTrue
+data TFalse
+
+hTrue :: TTrue
+hTrue = undefined :: TTrue
+
+hFalse :: TFalse
+hFalse = undefined :: TFalse
+
+class TNot a r | a -> r where
+    tNot :: a -> r
+    tNot _ = undefined
+
+instance TNot TFalse TTrue
+instance TNot TTrue TFalse
+
+instance TNot a b => TNot (f a) b
+
+class TAnd a b r | a b -> r where
+    tAnd :: a -> b -> r
+    tAnd _ _ = undefined
+
+{-
+instance TAnd TFalse TFalse TFalse where
+    tAnd _ _ = hFalse
+instance TAnd TFalse TTrue TFalse where
+    tAnd _ _ = hFalse
+instance TAnd TTrue TFalse TFalse where
+    tAnd _ _ = hFalse
+instance TAnd TTrue TTrue TTrue where
+    tAnd _ _ = hTrue
+-}
+
+{-
+instance TAnd TFalse b TFalse where
+    tAnd _ _ = hFalse
+instance TAnd TTrue b b where
+    tAnd _ _ = undefined
+-}
+
+instance TAnd TFalse b TFalse
+instance TAnd TTrue b b where
+    tAnd _ y = y
+
+instance TAnd a b r => TAnd (f a) (g b) r
+
+class TOr a b r | a b -> r where
+    tOr :: a -> b -> r
+    tOr _ _ = undefined
+
+{-
+instance TOr TFalse TFalse TFalse where
+    tOr _ _ = hFalse
+instance TOr TFalse TTrue TTrue where
+    tOr _ _ = hTrue
+instance TOr TTrue TFalse TTrue where
+    tOr _ _ = hTrue
+instance TOr TTrue TTrue TTrue where
+    tOr _ _ = hTrue
+-}
+
+instance TOr TFalse b b where
+    tOr _ y = y
+instance TOr TTrue b TTrue
+
+instance TOr a b r => TOr (f a) (g b) r
+
+class CNot f r where
+    cNot :: f a -> r
+    cNot = undefined
+
+instance TNot (f a) r => CNot f r
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

+ Data/Type/Eq.hs view

@@ -0,0 +1,21 @@+{-# LANGUAGE UndecidableInstances, OverlappingInstances, MultiParamTypeClasses,
+    FunctionalDependencies, FlexibleInstances
+    #-}
+--
+-- .$Header: c:/Source/Haskell/Type/Data/Type/RCS/Eq.hs,v 1.2 2010/02/03 01:12:28 dosuser Exp dosuser $
+module Data.Type.Eq where
+
+import Data.Type.Bool
+
+class TypeCast   a b   | a -> b, b->a   where typeCast   :: a -> b
+class TypeCast'  t a b | t a -> b, t b -> a where typeCast'  :: t->a->b
+class TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b
+instance TypeCast'  () a b => TypeCast a b where typeCast x = typeCast' () x
+instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''
+instance TypeCast'' () a a where typeCast'' _ x  = x
+
+class  TypeEq x y b | x y -> b
+instance TypeEq x x TTrue
+instance TypeCast TFalse b => TypeEq x y b
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

+ Data/Type/Member.hs view

@@ -0,0 +1,35 @@+{-# LANGUAGE UndecidableInstances, EmptyDataDecls,
+    FlexibleInstances, MultiParamTypeClasses
+    #-}
+-- .$Header: c:/Source/Haskell/Type/Data/Type/RCS/Member.hs,v 1.2 2010/02/03 01:13:16 dosuser Exp dosuser $
+module Data.Type.Member where
+
+import Data.Type.Apply
+import Data.Type.Bool
+import Data.Type.Eq
+import Data.Type.TList
+
+data Member s
+
+member :: Member s
+member = undefined
+
+mNil :: Member TNil
+mNil = member
+
+mUnit :: a -> Member a
+mUnit _ = member
+
+mCons :: Member a -> Member b -> Member (a :*: b)
+mCons _ _ = member
+
+infixr 5 `mCons`
+
+instance Apply (Member TNil) a TFalse
+
+instance TypeEq s a b => Apply (Member s) a b
+
+instance (TypeEq h a b1, Apply (Member t) a b2, TOr b1 b2 b) =>
+    Apply (Member (h :*: t)) a b
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

+ Data/Type/Nat.hs view

@@ -0,0 +1,26 @@+{-# LANGUAGE ScopedTypeVariables #-}
+-- .$Header$
+module Data.Type.Nat where
+
+data Z = Z
+data S n = S n
+
+zero :: Z
+zero = Z
+one :: S Z
+one = S Z
+two :: S (S Z)
+two = S one
+three :: S (S (S Z))
+three = S two
+
+class Nat n where
+    fromNat :: Enum e => n -> e
+
+instance Nat Z where
+    fromNat _ = toEnum 0
+
+instance forall n. Nat n => Nat (S n) where
+    fromNat _ = succ $ fromNat (undefined :: n)
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

+ Data/Type/TList.hs view

@@ -0,0 +1,7 @@+module Data.Type.TList where
+
+data TNil = TNil
+data a :*: b = a :*: b
+infixr 5 :*:
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

+ Data/Type/Test/Bool.hs view

@@ -0,0 +1,175 @@+{-# LANGUAGE UndecidableInstances, OverlappingInstances, FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables, EmptyDataDecls, MultiParamTypeClasses #-}
+{- LANGUAGE TypeOperators -}
+{- Enable the above to compile with GHC >= 6.8 -}
+{- 6.6 fails to even parse it -}
+--
+-- .$Header$
+module Data.Type.Test.Bool where
+
+import Data.Type.Apply
+import Data.Type.Bool
+import Data.Type.Eq
+import Data.Type.TList
+
+t9 :: TTrue
+t9 = tNot hFalse
+t10 :: TFalse
+t10 = tNot hTrue
+
+data Test a
+
+vtt :: Test TTrue
+vtt = undefined
+
+vtf :: Test TFalse
+vtf = undefined
+
+t11 :: TFalse
+t11 = tNot vtt
+t12 :: TTrue
+t12 = tNot vtf
+
+t1 :: TFalse
+t1 = tAnd hFalse hFalse
+t2 :: TFalse
+t2 = tAnd hFalse hTrue
+t3 :: TFalse
+t3 = tAnd hTrue hFalse
+t4 :: TTrue
+t4 = tAnd hTrue hTrue
+
+t13 :: TFalse
+t13 = tAnd vtf vtf
+t14 :: TFalse
+t14 = tAnd vtf vtt
+t15 :: TFalse
+t15 = tAnd vtt vtf
+t16 :: TTrue
+t16 = tAnd vtt vtt
+
+t5 :: TFalse
+t5 = tOr hFalse hFalse
+t6 :: TTrue
+t6 = tOr hFalse hTrue
+t7 :: TTrue
+t7 = tOr hTrue hFalse
+t8 :: TTrue
+t8 = tOr hTrue hTrue
+
+t17 :: TFalse
+t17 = tOr vtf vtf
+t18 :: TTrue
+t18 = tOr vtf vtt
+t19 :: TTrue
+t19 = tOr vtt vtf
+t20 :: TTrue
+t20 = tOr vtt vtt
+
+data Test2 a b
+
+vt2ff :: Test2 TFalse TFalse
+vt2ff = undefined
+
+{-
+t21 :: TTrue
+t21 = cNot vt2ff
+-}
+
+data F = F
+data C = C
+data X = X
+
+data Member s
+
+member :: Member s
+member = undefined
+
+mNil :: Member TNil
+mNil = member
+
+mUnit :: a -> Member a
+mUnit _ = member
+
+mCons :: Member a -> Member b -> Member (a :*: b)
+mCons _ _ = member
+
+infixr 5 `mCons`
+
+instance Apply (Member TNil) a TFalse
+
+instance (TypeEq h a b1, Apply (Member t) a b2, TOr b1 b2 b) =>
+    Apply (Member (h :*: t)) a b
+
+class TypeClassify s t where
+    typeClassify :: s -> t -> Bool
+
+instance forall t a b. (Apply (Member t) a b, AsBool b) =>
+    TypeClassify (Member t) a
+  where
+    typeClassify _ _ = asBool (undefined :: b)
+
+class AsBool b where
+    asBool :: b -> Bool
+
+instance AsBool TTrue where
+    asBool _ = True
+
+instance AsBool TFalse where
+    asBool _ = False
+
+t22 :: TFalse
+t22 = apply mNil F
+t23 :: TTrue
+t23 = apply (mUnit F `mCons` mNil) F
+t24 :: TFalse
+t24 = apply (mUnit F `mCons` mNil) C
+t25 :: TFalse
+t25 = apply (mUnit F `mCons` mUnit C `mCons` mNil) X
+t26 :: TTrue
+t26 = apply (mUnit F `mCons` mUnit C `mCons` mNil) F
+t27 :: TTrue
+t27 = apply (mUnit F `mCons` mUnit C `mCons` mNil) C
+
+data Member' s
+
+member' :: Member' s
+member' = undefined
+
+mNil' :: Member' TNil
+mNil' = member'
+
+mUnit' :: a -> Member' a
+mUnit' _ = member'
+
+mCons' :: Member' a -> Member' b -> Member' (a :*: b)
+mCons' _ _ = member'
+
+infixr 5 `mCons'`
+
+instance Apply (Member' TNil) a TFalse
+
+instance TypeEq s a b => Apply (Member' s) a b
+
+-- instance TOr (TypeEq h a b1) (Apply (Member' t) a b2) b =>
+instance (TypeEq h a b1, Apply (Member' t) a b2, TOr b1 b2 b) =>
+    Apply (Member' (h :*: t)) a b
+
+t28 :: TFalse
+t28 = apply mNil' F
+t29 :: TTrue
+t29 = apply (mUnit' F `mCons'` mNil') F
+t30 :: TFalse
+t30 = apply (mUnit' F `mCons'` mNil') C
+t31 :: TFalse
+t31 = apply (mUnit' F `mCons'` mUnit' C `mCons'` mNil') X
+t32 :: TTrue
+t32 = apply (mUnit' F `mCons'` mUnit' C `mCons'` mNil') F
+t33 :: TTrue
+t33 = apply (mUnit' F `mCons'` mUnit' C `mCons'` mNil') C
+t34 :: TFalse
+t34 = apply (mUnit' F) X
+t35 :: TTrue
+t35 = apply (mUnit' F) F
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

+ Data/Type/Test/Nat.hs view

@@ -0,0 +1,25 @@+-- .$Header$
+module Data.Type.Test.Nat where
+
+import Data.Type.Nat
+
+import Test.HUnit
+
+bindTo = (=<<)
+
+t0 :: Test
+t0 = "fromNat zero" ~: 0 ~=? fromNat zero
+
+t1 :: Test
+t1 = "fromNat one" ~: 1 ~=? fromNat one
+
+t2 :: Test
+t2 = "fromNat two" ~: 2 ~=? fromNat two
+
+t3 :: Test
+t3 = "fromNat three" ~: 3 ~=? fromNat three
+
+runTest :: IO ()
+runTest = bindTo print . runTestTT $ test [t0, t1, t2, t3]
+
+-- vim: expandtab:tabstop=4:shiftwidth=4

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Iain Alexander 2010.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Iain Alexander nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

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

+ data-type.cabal view

@@ -0,0 +1,35 @@+Name:            data-type
+Version:         0.0.1
+Cabal-version:   >= 1.2.3
+Build-Type:      Simple
+License:         BSD3
+License-File:    LICENSE
+Author:          Iain Alexander <ia@stryx.demon.co.uk>
+Maintainer:      Iain Alexander <ia@stryx.demon.co.uk>
+Stability:       Experimental
+Bug-reports:     mailto:ia@stryx.demon.co.uk
+Synopsis:        Basic type wrangling types and classes
+Description:     Primitive types and classes for
+                 Oleg-inspired type[class] manipulation
+Category:        Data, Type System
+Tested-with:     GHC==6.4.1, GHC==6.6.1, GHC==6.8.3, GHC==6.10.4, GHC==6.12.3
+               , GHC==7.0.1
+Extra-source-files:  Data/Type/Test/Bool.hs
+                     , Data/Type/Test/Nat.hs
+                     , .ghci
+Library
+    Exposed-Modules:   Data.Type.Apply
+                     , Data.Type.Bool
+                     , Data.Type.Eq
+                     , Data.Type.Member
+                     , Data.Type.Nat
+                     , Data.Type.TList
+    if impl(ghc < 6.6.1)
+        Extensions:      UndecidableInstances OverlappingInstances
+        Ghc-options:     -fglasgow-exts
+                         -- -fallow-undecidable-instances
+                         -- -fallow-overlapping-instances
+    if impl(ghc >= 6.8.1)
+        Extensions:      TypeOperators
+    Build-Depends:   base < 5
+-- vim: expandtab:tabstop=4:shiftwidth=4