typenats0.2source/0000755000076400007640000000000010466473060014112 5ustar robertroberttypenats0.2source/test/0000755000076400007640000000000010466473060015071 5ustar robertroberttypenats0.2source/test/Nats.hs0000644000076400007640000001324510466473060016337 0ustar robertrobert{

 Copyright 20052006, Robert Dockins.

}
module Nats where
import Test.QuickCheck
data Nat
= Z
 O Nat
 I Nat
 CantSubtract
deriving Show
natToIntegral :: Integral a => Nat > a
natToIntegral Z = fromInteger 0
natToIntegral (O a) = let x = natToIntegral a in x+x
natToIntegral (I a) = let x = natToIntegral a in succ (x+x)
natToIntegral CantSubtract = error "subtraction failure"
integralToNat :: Integral a => a > Nat
integralToNat n
 n < 0 = error "cannot convert negative integrals"
 n == 0 = Z
 m == 0 = O (integralToNat d)
 otherwise = I (integralToNat d)
where (d,m) = n `divMod` 2
instance Arbitrary Nat where
arbitrary = sized (\size > do
x < choose (0,size+1)
resize (size1)
(case x of { x
 x == 0 > return Z
 x `mod` 2 == 0 > arbitrary >>= return . O
 otherwise > arbitrary >>= return . I }))
coarbitrary Z = variant 0
coarbitrary (O x) = variant 1 . coarbitrary x
coarbitrary (I x) = variant 2 . coarbitrary x
eqNat :: Nat > Nat > Bool
eqNat Z Z = True
eqNat Z (O x) = eqNat Z x
eqNat (O x) Z = eqNat x Z
eqNat (O x) (O y) = eqNat x y
eqNat (I x) (I y) = eqNat x y
eqNat _ _ = False
instance Eq Nat where (==) = eqNat
natSucc :: Nat > Nat
natSucc Z = (I Z)
natSucc (O x) = (I x)
natSucc (I x) = O (natSucc x)
add :: Nat > Nat > Nat
add Z x = x
add x Z = x
add (O a) (O b) = O (add a b)
add (I a) (O b) = I (add a b)
add (O a) (I b) = I (add a b)
add (I a) (I b) = O (addC a b)
addC :: Nat > Nat > Nat
addC Z x = natSucc x
addC x Z = natSucc x
addC (O a) (O b) = I (add a b)
addC (I a) (O b) = O (addC a b)
addC (O a) (I b) = O (addC a b)
addC (I a) (I b) = I (addC a b)
sub :: Nat > Nat > Nat
sub a Z = a
sub Z (O b) = sub Z b
sub Z (I b) = CantSubtract
sub (O a) (O b) = case sub a b of CantSubtract > CantSubtract; x > O x
sub (I a) (I b) = case sub a b of CantSubtract > CantSubtract; x > O x
sub (I a) (O b) = case sub a b of CantSubtract > CantSubtract; x > I x
sub (O a) (I b) = case borrow a of
CantSubtract > CantSubtract;
a' > case sub a' b of
CantSubtract > CantSubtract
x > I x
borrow :: Nat > Nat
borrow Z = CantSubtract
borrow (I x) = O x
borrow (O x) = case borrow x of CantSubtract > CantSubtract; y > I y
mul :: Nat > Nat > Nat
mul a (O b) = mul (O a) b
mul a (I b) = add a (mul (O a) b)
mul a Z = Z
natDivMod :: Nat > Nat > (Nat,Nat)
natDivMod a b = startDiv b a Z Z
 reverse the digits
startDiv :: Nat > Nat > Nat > Nat > (Nat,Nat)
startDiv (O d) (O r) w z = startDiv d (O r) (O w) z
startDiv (O d) (I r) w z = startDiv d (I r) (O w) z
startDiv (O d) Z w z = startDiv d Z (O w) z
startDiv (I d) (O r) w z = startDiv d (O r) (I w) z
startDiv (I d) (I r) w z = startDiv d (I r) (I w) z
startDiv (I d) Z w z = startDiv d Z (I w) z
startDiv Z (O r) w z = startDiv Z r w (O z)
startDiv Z (I r) w z = startDiv Z r w (I z)
startDiv Z Z w z = startDiv2 w z
 throw away extra zeros
startDiv2 :: Nat > Nat > (Nat,Nat)
startDiv2 (O w) Z = startDiv2 w Z
startDiv2 (O w) (O z) = startDiv2 w z
startDiv2 (O w) (I z) = startDiv2 w (I z)
startDiv2 (I w) (O z) = startDiv2 (I w) z
startDiv2 (I w) Z = startDiv3 (I w) Z Z Z
startDiv2 (I w) (I z) = startDiv3 (I w) (I z) Z Z
startDiv2 Z z = error "division by zero"
 start unreversing the nubmers until all digits of
 the divisor are in proper order
startDiv3 :: Nat > Nat > Nat > Nat > (Nat,Nat)
startDiv3 (O w) (O z) d r = startDiv3 w z (O d) (O r)
startDiv3 (O w) (I z) d r = startDiv3 w z (O d) (I r)
startDiv3 (O w) Z d r = startDiv3 w Z (O d) r
startDiv3 (I w) (O z) d r = startDiv3 w z (I d) (O r)
startDiv3 (I w) (I z) d r = startDiv3 w z (I d) (I r)
startDiv3 (I w) Z d r = startDiv3 w Z (I d) r
startDiv3 Z z d r = doDiv z d r Z
 do the long division
doDiv :: Nat > Nat > Nat > Nat > (Nat,Nat)
doDiv Z d r q =
case sub r d of
CantSubtract > (O q,r)
Z > (I q,Z)
O x > (I q,O x)
I x > (I q,I x)
doDiv (O z) d r q =
case sub r d of
CantSubtract > doDiv z d (O r) (O q)
Z > doDiv z d Z (I q)
O x > doDiv z d (O (O x)) (I q)
I x > doDiv z d (O (I x)) (I q)
doDiv (I z) d r q =
case sub r d of
CantSubtract > doDiv z d (I r) (O q)
Z > doDiv z d (I Z) (I q)
O x > doDiv z d (I (O x)) (I q)
I x > doDiv z d (I (I x)) (I q)
natDiv :: Nat > Nat > Nat
natDiv x y = let (q,_) = natDivMod x y in q
natMod :: Nat > Nat > Nat
natMod x y = let (_,r) = natDivMod x y in r
zero = Z
one = (I Z)
two = (O (I Z))
three = (I (I Z))
four = (O (O (I Z)))
five = (I (O (I Z)))
six = (O (I (I Z)))
seven = (I (I (I Z)))
eight = (O (O (O (I Z))))
nine = (I (O (O (I Z))))
ten = (O (I (O (I Z))))
eleven = (I (I (O (I Z))))
twelve = (O (O (I (I Z))))
thirteen = (I (O (I (I Z))))
fourteen = (O (I (I (I Z))))
fifteen = (I (I (I (I Z))))
sixteen = (O (O (O (O (I Z)))))
seventeen = (I (O (O (O (I Z)))))
eighteen = (O (I (O (O (I Z)))))
nineteen = (I (I (O (O (I Z)))))
{
main = do let x = nineteen; y = six
putStrLn $ show $ doDiv Z (I (I Z)) (O (O (I (O Z)))) (I (O Z))
putStrLn $ show $ natToIntegral $ natDiv x y
putStrLn $ show $ natToIntegral $ natMod x y
}typenats0.2source/test/MkTypeNats.hs0000644000076400007640000000777010466473060017477 0ustar robertrobert{

 Copyright 20052006, Robert Dockins.

}
module MkTypeNats where
import Test.HUnit
import System.Random
import Control.Monad
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import Test.QuickCheck
import Nats ( Nat (..), natToIntegral, integralToNat )
import TypeNats
mkNat :: Nat > ExpQ
mkNat Z = conE 'Z
mkNat (O x) = appE (conE 'O) (mkNat x)
mkNat (I x) = appE (conE 'I) (mkNat x)
instance Lift Nat where lift = mkNat
mkTypeNat :: Nat > TypeQ
mkTypeNat Z = conT ''Z
mkTypeNat (I x) = appT (conT ''I) (mkTypeNat x)
mkTypeNat (O x) = appT (conT ''O) (mkTypeNat x)
mkTypeNatExpr :: Nat > ExpQ
mkTypeNatExpr n = sigE [ undefined ] (mkTypeNat n)
mkTypeNatTest :: Nat > Nat > ExpQ
mkTypeNatTest n1 n2 = do
let x1 = natToIntegral n1 :: Integer
let x2 = natToIntegral n2 :: Integer
let xa = if x1 < x2 then x1 else x2
let xb = if x1 < x2 then x2 else x1
let na = if x1 < x2 then n1 else n2
let nb = if x1 < x2 then n2 else n1
tnaName < newName "tna"
tnbName < newName "tnb"
leqName < newName "leqTest"
eqName < newName "eqTest"
let tna = varE tnaName
let tnb = varE tnbName
let leq = varE leqName
let eq = varE eqName
letE [ funD tnaName [ clause [] (normalB (mkTypeNatExpr na)) [] ]
, funD tnbName [ clause [] (normalB (mkTypeNatExpr nb)) [] ]
, sigD leqName [t LEqNat a b => a > b > Bool ]
, funD leqName [ clause [] (normalB [ \_ _ > True ]) [] ]
, sigD eqName [t EqNat a b => a > b > Bool ]
, funD eqName [ clause [] (normalB [ \_ _ > True ]) [] ]
]
[ TestLabel (concat ["Nat test with '",show x1,"' and '",show x2,"'"]) $ TestCase (do
assertBool "eq test" ($eq $tna $tna)
assertEqual "addition test 1" (xa+xb) (naturalToIntegral ($tna `add` $tnb))
assertEqual "addition test 2" (xb+xa) (naturalToIntegral ($tnb `add` $tna))
assertEqual "subtraction test" (xbxa) (naturalToIntegral ($tnb `sub` $tna))
assertBool "leqTest" ($leq $tna $tnb)
assertEqual "multiply test 1" (xa*xb) (naturalToIntegral ($tna `mul` $tnb))
assertEqual "multiply test 2" (xb*xa) (naturalToIntegral ($tnb `mul`$tna))
assertEqual "div2 test 1" (xa `div` 2) (naturalToIntegral (div2 $tna))
assertEqual "div2 test 2" (xb `div` 2) (naturalToIntegral (div2 $tnb))
assertEqual "gcd test 1" (succ xa `gcd` succ xb) (naturalToIntegral (natSucc $tna `natGCD` natSucc $tnb))
assertEqual "gcd test 2" (succ xb `gcd` succ xa) (naturalToIntegral (natSucc $tnb `natGCD` natSucc $tna))
assertEqual "normalize test 1" xa (naturalToIntegral (normalize $tna))
assertEqual "normalize test 2" xb (naturalToIntegral (normalize $tnb))
assertEqual "div test 1" (xb `div` succ xa) (naturalToIntegral ($tnb `natDiv` natSucc $tna))
assertEqual "div test 2" (xa `div` succ xb) (naturalToIntegral ($tna `natDiv` natSucc $tnb))
assertEqual "mod test 1" (xb `mod` succ xa) (naturalToIntegral ($tnb `natMod` natSucc $tna))
assertEqual "mod test 2" (xa `mod` succ xb) (naturalToIntegral ($tna `natMod` natSucc $tnb))
)
]
pairList :: [Nat] > [(Nat,Nat)]
pairList [] = []
pairList (a:[]) = (Z,a) : []
pairList (a:b:xs) = (a,b) : pairList xs
mkTypeNatTests :: Int > Q [ExpQ]
mkTypeNatTests numTests = do
stdGen < runIO (getStdGen)
let (stdGen1,stdGen') = split stdGen
let (stdGen2,stdGen3) = split stdGen'
let nats1 = generate 8 stdGen1 (vector (2*numTests))
let nats2 = generate 16 stdGen2 (vector (2*numTests))
let nats3 = generate 32 stdGen3 (vector (2*numTests))
let nats' = pairList (nats1++nats2++nats3)
return [ mkTypeNatTest x1 x2  (x1,x2) < nats' ]
mkTypeNatTestCase :: Int > Q [Dec]
mkTypeNatTestCase numTests = do
tests < mkTypeNatTests numTests
sequence [funD (mkName "typeNatTests")
[ clause [] (normalB (listE tests)) [] ]]
typenats0.2source/test/Test.hs0000644000076400007640000000030310466473060016340 0ustar robertrobert{

 Copyright 20052006, Robert Dockins.

}
module Main where
import Test.HUnit
import TypeNats
import MkTypeNats
$(mkTypeNatTestCase 10)
main = runTestTT (TestList typeNatTests)
typenats0.2source/src/0000755000076400007640000000000010466473060014701 5ustar robertroberttypenats0.2source/src/TypeNats.hs0000644000076400007640000004017010466473060017006 0ustar robertrobert{

 Copyright 20052006, Robert Dockins.

}
{  This module defines typelevel natural numbers and arithmetic operation on them
including addition, subtraction, multiplication, division and GCD.
Numbers are represented as a list of binary digits, terminated by a distinguished type 'Z'.
Least significant digits are outermost, which makes the numbers littleendian when read.
Because a binary representation is used, reasonably large numbers can be
represented. I have personally done tests with numbers at the order
of 10^15 in GHC. However, larger numbers require the GHC \'fcontextstack\' option.
For example, the test suite sets \'fcontextstack64\'.
Because of the limitations of typeclasses, some of the algorithms are pretty
messy. The division algorithm is particularly ugly. Suggestions for improvements
are welcome.
}
module TypeNats where
  Terminates a list of binary digits with an imagined infinity of zeros.
data Z
  A zero bit.
data O a
  A one bit.
data I a  a one bit
type Zero = Z
type One = (I Z)
type Two = (O (I Z))
type Three = (I (I Z))
type Four = (O (O (I Z)))
type Five = (I (O (I Z)))
type Six = (O (I (I Z)))
type Seven = (I (I (I Z)))
type Eight = (O (O (O (I Z))))
type Nine = (I (O (O (I Z))))
type Ten = (O (I (O (I Z))))
type Eleven = (I (I (O (I Z))))
type Twelve = (O (O (I (I Z))))
type Thirteen = (I (O (I (I Z))))
type Fourteen = (O (I (I (I Z))))
type Fifteen = (I (I (I (I Z))))
type Sixteen = (O (O (O (O (I Z)))))
type Seventeen = (I (O (O (O (I Z)))))
type Eighteen = (O (I (O (O (I Z)))))
type Nineteen = (I (I (O (O (I Z)))))
type Twenty = (O (O (I (O (I Z)))))
type Thirty = (O (I (O (I (I Z)))))
type Fourty = (O (O (O (I (O (I Z))))))
type Fifty = (O (I (O (O (I (I Z))))))
type Sixty = (O (O (I (I (I (I Z))))))
type Seventy = (O (I (I (O (O (O (I Z)))))))
type Eighty = (O (O (O (O (I (O (I Z)))))))
type Ninety = (O (I (O (I (I (O (I Z)))))))
type Hundred = (O (O (I (O (O (I (I Z)))))))
 Hexidecimal digits
type Ox0 a = (O (O (O (O a))))
type Ox1 a = (I (O (O (O a))))
type Ox2 a = (O (I (O (O a))))
type Ox3 a = (I (I (O (O a))))
type Ox4 a = (O (O (I (O a))))
type Ox5 a = (I (O (I (O a))))
type Ox6 a = (O (I (I (O a))))
type Ox7 a = (I (I (I (O a))))
type Ox8 a = (O (O (O (I a))))
type Ox9 a = (I (O (O (I a))))
type Oxa a = (O (I (O (I a))))
type Oxb a = (I (I (O (I a))))
type Oxc a = (O (O (I (I a))))
type Oxd a = (I (O (I (I a))))
type Oxe a = (O (I (I (I a))))
type Oxf a = (I (I (I (I a))))
 some larger numbers
type Thousand = Ox8 (Oxe (Ox3 Z))
type Million = Ox0 (Ox4 (Ox2 (Ox4 (Oxf Z))))
type Billion = Ox0 (Ox0 (Oxa (Oxc (Oxa (Ox9 (Oxb (Ox3 Z)))))))
  The Natural class, with conversion to intergral values.
 The conversion should be linear in the number of bits, which
 is logarithmic in the magnitute of the number.
class Natural a where
naturalToIntegral :: Integral b => a > b
instance Natural Z where
naturalToIntegral _ = fromInteger 0
instance Natural a => Natural (O a) where
naturalToIntegral _ = let x = naturalToIntegral (undefined::a) in x+x
instance Natural a => Natural (I a) where
naturalToIntegral _ = let x = naturalToIntegral (undefined::a) in succ (x+x)
  Zero predicate. Zero is represented by a single 'Z' or
 a string of 'O' terminated by 'Z'.
class IsZero a
instance IsZero Z
instance IsZero a => IsZero (O a)
  The equality relation on nats.
class EqNat a b
instance (IsZero a) => EqNat a Z
instance (EqNat Z b) => EqNat Z (O b)
instance (EqNat a b) => EqNat (O a) (O b)
instance (EqNat a b) => EqNat (I a) (I b)
  The successor function; defined for all naturals.
class (Natural a, Natural b) => NatSucc a b  a > b
instance NatSucc Z (I Z)
instance Natural a => NatSucc (O a) (I a)
instance NatSucc a b => NatSucc (I a) (O b)
natSucc :: (NatSucc a b) => a > b
natSucc = undefined
  The predecessor function; not defined for zero.
class (Natural a, Natural b) => NatPred a b  a > b
instance Natural a => NatPred (I a) (O a)
instance NatPred a b => NatPred (O a) (I b)
natPred :: NatPred a b => a > b
natPred = undefined
  Binary addition. This is a pretty basic full adder.
 The 'AddC' class represents add with carry.
 Addition is defined for all pairs of natural numbers.
class (Natural a,Natural b,Natural c) => Add a b c  a b > c
instance Add Z Z Z
instance (Natural a) => Add Z (O a) (O a)
instance (Natural a) => Add Z (I a) (I a)
instance (Natural a) => Add (O a) Z (O a)
instance (Natural a) => Add (I a) Z (I a)
instance Add a b c => Add (O a) (O b) (O c)
instance Add a b c => Add (I a) (O b) (I c)
instance Add a b c => Add (O a) (I b) (I c)
instance AddC a b c => Add (I a) (I b) (O c)
class (Natural a,Natural b,Natural c) => AddC a b c  a b > c
instance AddC Z Z (I Z)
instance Natural a => AddC Z (O a) (I a)
instance NatSucc a b => AddC Z (I a) (O b)
instance Natural a => AddC (O a) Z (I a)
instance NatSucc a b => AddC (I a) Z (O b)
instance Add a b c => AddC (O a) (O b) (I c)
instance AddC a b c => AddC (I a) (O b) (O c)
instance AddC a b c => AddC (O a) (I b) (O c)
instance AddC a b c => AddC (I a) (I b) (I c)
add :: Add a b c => a > b > c
add = undefined
  A distinguished error type which is returned when
 subtraction is impossible.
data CantSubtract
  Binary subtraction. Slightly less elegant than the adder but it works.
 'DoSub' returns a distingushed error type if a < b and '()' if the subtraction suceeds.
class (Natural a, Natural b) => Sub a b c  a b > c
instance DoSub a b c () => Sub a b c
class (Natural a, Natural b) => DoSub a b c d  a b > c d
instance Natural a => DoSub a Z a ()
instance DoSub Z b c d => DoSub Z (O b) c d  this rule does not loop, because
 the b parameter is decreasing
instance Natural b => DoSub Z (I b) () CantSubtract
instance DoSub a b c d => DoSub (O a) (O b) (O c) d
instance DoSub a b c d => DoSub (I a) (O b) (I c) d
instance DoSub a b c d => DoSub (I a) (I b) (O c) d
instance SubBorrow b c a z z d => DoSub (O a) (I b) (I c) d
sub :: Sub a b c => a > b > c
sub = undefined
 this is tricky, we use the top level call to SubBorrow
 to unify the final result with z, so that is is avaliable
 when we want to call Sub again
class (Natural b,Natural x) => SubBorrow b c x y z d  x z b > c d, x > y
instance Natural b => SubBorrow b () Z () z CantSubtract
instance (Natural x,DoSub z b c d) => SubBorrow b c (I x) (O x) z d
instance SubBorrow b c x y z d => SubBorrow b c (O x) (I y) z d
{
how we used to do it. This way can't return the distinguished
CantSubtract type when borrowing fails. We need that distinguisged
type in order to do the tests we need for division and GCD
instance (Borrow a a',Sub a' b c) => Sub (O a) (I b) (I c)
class Borrow a b  a > b
instance Borrow (I a) (O a)
instance Borrow a b => Borrow (O a) (I b)
}
class Trichotomy n m lt eq gt z  n m lt eq gt > z
instance (DoSub n m p a, DoSub m n q b, DoTrichotomy a b lt eq gt z) => Trichotomy n m lt eq gt z
class DoTrichotomy a b lt eq gt z  a b lt eq gt > z
instance DoTrichotomy CantSubtract () lt eq gt lt
instance DoTrichotomy () () lt eq gt eq
instance DoTrichotomy () CantSubtract lt eq gt gt
 comparison relations on naturals, defined
 in terms of subtraction
  The lessthanorequalto relation
class LEqNat a b
instance (DoSub b a c ()) => LEqNat a b
  The greaterthanorequalto relation
class GEqNat a b
instance (DoSub a b c ()) => GEqNat a b
  The lessthan relation
class LTNat a b
instance (DoSub a b c CantSubtract) => LTNat a b
  The greaterthan relation
class GTNat a b
instance (DoSub b a c CantSubtract) => GTNat a b
  Binary multiplication. This is a
 simple shift and add peasant multiplier.
class Mul a b c  a b > c
instance Mul a Z Z
instance (Mul (O a) b x) => Mul a (O b) x
instance (Mul (O a) b c,Add a c x) => Mul a (I b) x
mul :: Mul a b c => a > b > c
mul = undefined
  Division by 2.
 This is real easy, just throw away the outermost
 type constructor.
class (Natural a,Natural b) => Div2 a b  a > b
instance Div2 Z Z
instance Natural a => Div2 (O a) a
instance Natural a => Div2 (I a) a
div2 :: Div2 a b => a > b
div2 = undefined
  Normalize a nat; that is, remove all leading zeros.
class NatNormalize a b  a > b
instance (NatRev a Z c
,NatNorm c c'
,NatRev c' Z a'
)
=> NatNormalize a a'
class NatRev a b c  a b > c
instance NatRev Z b b
instance NatRev a (O b) c => NatRev (O a) b c
instance NatRev a (I b) c => NatRev (I a) b c
class NatNorm a b  a > b
instance NatNorm Z Z
instance NatNorm (I a) (I a)
instance NatNorm a b => NatNorm (O a) b
normalize :: NatNormalize a b => a > b
normalize = undefined
  A distinguished error type returned when
 attempting to divide by zero.
data DivideByZero
  Binary division and modulus. This one is suprisingly difficult to implement.
class DivMod a d q r  a d > q r
instance ( NatRev a Z a'
, NatRev d Z d'
, PreDivMod a' d' (q,r)
) => DivMod a d q r
 here we throw away leading zeros and test for
 a zero divisor
class PreDivMod a d z  a d > z
instance PreDivMod Z d z => PreDivMod Z (O d) z
instance PreDivMod a d z => PreDivMod (O a) (O d) z
instance PreDivMod (I a) d z => PreDivMod (I a) (O d) z
instance PreDivMod a (I d) z => PreDivMod (O a) (I d) z
instance PreDivMod2 Z (I d) Z Z z => PreDivMod Z (I d) z
instance PreDivMod2 (I a) (I d) Z Z z => PreDivMod (I a) (I d) z
instance PreDivMod a Z DivideByZero
 now we begin to "unreverse" until all the divisor
 digits are in the correct order
class PreDivMod2 a w d r z  a w d r > z
instance PreDivMod2 Z w (O d) r z => PreDivMod2 Z (O w) d r z
instance PreDivMod2 a w (O d) (O r) z => PreDivMod2 (O a) (O w) d r z
instance PreDivMod2 a w (O d) (I r) z => PreDivMod2 (I a) (O w) d r z
instance PreDivMod2 Z w (I d) r z => PreDivMod2 Z (I w) d r z
instance PreDivMod2 a w (I d) (O r) z => PreDivMod2 (O a) (I w) d r z
instance PreDivMod2 a w (I d) (I r) z => PreDivMod2 (I a) (I w) d r z
instance DoDivMod a d Z r z => PreDivMod2 a Z d r z
 now we do binary long division
 first we do case analysis on the
 remining dividend, then case analysis
 on the difference between the current
 remainder and the dividend....
class DoDivMod a d q r z  a d q r > z
instance ( DoSub r d x err
, DoDivModZ err x q r z
) => DoDivMod Z d q r z
instance ( DoSub r d x err
, DoDivModO err x a d q r z
) => DoDivMod (O a) d q r z
instance ( DoSub r d x err
, DoDivModI err x a d q r z
) => DoDivMod (I a) d q r z
class DoDivModZ err x q r z  err x q r > z
instance DoDivModZ () Z q r (I q,r)
instance DoDivModZ () (O x) q r (I q,O x)
instance DoDivModZ () (I x) q r (I q,I x)
instance DoDivModZ CantSubtract x q r (O q,r)
class DoDivModO err x a d q r z  err x a d q r > z
instance DoDivMod a d (I q) Z z => DoDivModO () Z a d q r z
instance DoDivMod a d (I q) (O (O x)) z => DoDivModO () (O x) a d q r z
instance DoDivMod a d (I q) (O (I x)) z => DoDivModO () (I x) a d q r z
instance DoDivMod a d (O q) (O r) z => DoDivModO CantSubtract x a d q r z
class DoDivModI err x a d q r z  err x a d q r > z
instance DoDivMod a d (I q) (I Z) z => DoDivModI () Z a d q r z
instance DoDivMod a d (I q) (I (O x)) z => DoDivModI () (O x) a d q r z
instance DoDivMod a d (I q) (I (I x)) z => DoDivModI () (I x) a d q r z
instance DoDivMod a d (O q) (I r) z => DoDivModI CantSubtract x a d q r z
natDivMod :: DivMod a b q r => a > b > (q,r)
natDiv :: DivMod a b q r => a > b > q
natMod :: DivMod a b q r => a > b > r
natDivMod = undefined
natDiv = undefined
natMod = undefined
  A distinguished error type returned when
 an attempt is made to take the GCD of 0 and 0.
data GCDZeroZero
  Greatest Common Divisor (GCD).
 Here we use the binary euclidian algorithm.
 there is a little fancy dancing to with DoGCD2
 in order to replace the largest argument with
 their difference
class GCD a b c  a b > c
instance ( NatNormalize a a'
, NatNormalize b b'
, DoGCD a' b' c
) => GCD a b c
class DoGCD a b c  a b > c
instance DoGCD Z Z GCDZeroZero
instance DoGCD (O a) Z (O a)
instance DoGCD (I a) Z (I a)
instance DoGCD Z (O a) (O a)
instance DoGCD Z (I a) (I a)
instance DoGCD a b c => DoGCD (O a) (O b) (O c)
instance DoGCD a (I b) c => DoGCD (O a) (I b) c
instance DoGCD (I a) b c => DoGCD (I a) (O b) c
 in this branch we want to replace the largest argument with
 the absolute value of their difference. All this nastyness
 is necessary to be able to figure out which one is bigger and
 subtract the correct way.
instance (DoSub a b x1 f1
,DoSub b a x2 f2
,DoGCD2 x1 x2 f1 f2
(I a) (I b) c) => DoGCD (I a) (I b) c
class DoGCD2 x1 x2 f1 f2 a b c  x1 x2 f1 f2 a b > c
 handle GCD(x,x) case. x and y must be (possibly distinct) representations of zero
instance (IsZero x,IsZero y) => DoGCD2 x y () () a b a
 replace the larger with the difference
instance DoGCD (O x1) b c => DoGCD2 x1 x2 () CantSubtract a b c
instance DoGCD a (O x2) c => DoGCD2 x1 x2 CantSubtract () a b c
natGCD :: GCD a b c => a > b > c
natGCD = undefined
 define a bunch of useful naturals
zero :: Zero
one :: One
two :: Two
three :: Three
four :: Four
five :: Five
six :: Six
seven :: Seven
eight :: Eight
nine :: Nine
ten :: Ten
eleven :: Eleven
twelve :: Twelve
thirteen :: Thirteen
fourteen :: Fourteen
fifteen :: Fifteen
sixteen :: Sixteen
seventeen :: Seventeen
eighteen :: Eighteen
nineteen :: Nineteen
twenty :: Add Twenty b c => b > c
twenty_ :: Twenty
thirty :: Add Thirty b c => b > c
thirty_ :: Thirty
fourty :: Add Fourty b c => b > c
fourty_ :: Fourty
fifty :: Add Fifty b c => b > c
fifty_ :: Fifty
sixty :: Add Sixty b c => b > c
sixty_ :: Sixty
seventy :: Add Seventy b c => b > c
seventy_ :: Seventy
eighty :: Add Eighty b c => b > c
eighty_ :: Eighty
ninety :: Add Ninety b c => b > c
ninety_ :: Ninety
hundred :: (Mul Hundred a b,Add b x y) => a > x > y
thousand :: (Mul Thousand a b,Add b x y) => a > x > y
million :: (Mul Million a b,Add b x y) => a > x > y
billion :: (Mul Billion a b,Add b x y) => a > x > y
infixr 5 `billion`
infixr 5 `million`
infixr 5 `thousand`
infix 6 `hundred`
zero = undefined
one = undefined
two = undefined
three = undefined
four = undefined
five = undefined
six = undefined
seven = undefined
eight = undefined
nine = undefined
ten = undefined
eleven = undefined
twelve = undefined
thirteen = undefined
fourteen = undefined
fifteen = undefined
sixteen = undefined
seventeen = undefined
eighteen = undefined
nineteen = undefined
twenty = undefined
thirty = undefined
fourty = undefined
fifty = undefined
sixty = undefined
seventy = undefined
eighty = undefined
ninety = undefined
twenty_ = undefined
thirty_ = undefined
fourty_ = undefined
fifty_ = undefined
sixty_ = undefined
seventy_ = undefined
eighty_ = undefined
ninety_ = undefined
hundred = undefined
thousand = undefined
million = undefined
billion = undefined
typenats0.2source/src/TypeList.hs0000644000076400007640000000143410466473060017014 0ustar robertrobert{

 Copyright 20052006, Robert Dockins.

}
module TypeList where
import TypeNats
data TyTrue
data TyFalse
class TyBool a where toBool :: a > Bool
instance TyBool TyTrue where toBool _ = True
instance TyBool TyFalse where toBool _ = False
data Nil
data Cons a b
class List a
instance List Nil
instance List b => List (Cons a b)
class Take n l w  n l > w
instance Take n Nil Nil
instance ( Take2 n' b p
, NatNormalize n n'
, Trichotomy n Z () Nil (Cons a p) w
) => Take n (Cons a b) w
class Take2 n b p  n b > p
instance Take2 Z b ()
instance (Take (O n) b w) => Take2 (I n) b w
instance ( NatPred n n'
, Take (I n') b w) => Take2 (O n) b w
tyTake :: Take n l w => n > l > w
tyTake = undefined
typenats0.2source/src/TypePrimes.hs0000644000076400007640000000377210466473060017347 0ustar robertrobert{

 Copyright 2006, Robert Dockins.

}
module TypePrimes where
import TypeNats
import TypeList
  Remove all multiples of @p@ from the list @l@
class PrimeSieve p l w  p l > w
instance PrimeSieve p Nil Nil
instance ( PrimeSieve p b w'
, DivMod a p q r
, Trichotomy r Z () w' (Cons a w') w
) => PrimeSieve p (Cons a b) w
primeSieve :: PrimeSieve p l w => p > l > w
primeSieve = undefined
  Generate a list containing all naturals staring with @x@
 and counting upwards to contain @n@ elements.
class FromCount x n l  x n > l
instance FromCount x Z Nil
instance ( NatSucc x x'
, NatPred (O n) (I n')
, NatNormalize (I n') n''
, FromCount x' n'' b
) => FromCount x (O n) (Cons x b)
instance ( NatSucc x x'
, NatPred (I n) (O n)
, NatNormalize (O n) n''
, FromCount x' n'' b
) => FromCount x (I n) (Cons x b)
tyFromCount :: FromCount x n l => x > n > l
tyFromCount = undefined
  Recursivly run the prime sive over the given list @l@.
class RunSieve l w  l > w
instance RunSieve Nil Nil
instance ( PrimeSieve p l l'
, RunSieve l' l''
) => RunSieve (Cons p l) (Cons p l'')
  Generate a list of all primes up to @x@.
class PrimesUpTo x w  x > w
instance ( Sub x One x'
, FromCount Two x' l
, RunSieve l w
) => PrimesUpTo x w
tyPrimesUpTo :: PrimesUpTo x w => x > w
tyPrimesUpTo = undefined
  Check if the given natural @x@ is in the list @l@.
class NumIn x l w  x l > w
instance NumIn x Nil TyFalse
instance ( NumIn x z w'
, Trichotomy y x w' TyTrue TyFalse w
) => NumIn x (Cons y z) w
tyNumIn :: NumIn x l w => x > l > w
tyNumIn = undefined
  Check if @x@ is a prime number. Return @TyTrue@ if so,
 or @TyFalse@ if not. Zero and one are not considered prime.
class IsPrime x w  x > w
instance ( PrimesUpTo x l
, NumIn x l w
) => IsPrime x w
tyIsPrime :: IsPrime x b => x > b
tyIsPrime = undefined
typenats0.2source/Setup.hs0000644000076400007640000000011010466473060015536 0ustar robertrobert#!/usr/bin/env runhaskell
import Distribution.Simple
main = defaultMain
typenats0.2source/TypeNats.cabal0000644000076400007640000000152410466473060016647 0ustar robertrobertName: TypeNats
Version: 0.2
License: BSD3
LicenseFile: LICENSE
Author: Robert Dockins
Synopsis: A library for arithemetic operations on typelevel natural numbers
Category: Other
Stability: Alpha
HsSourceDirs: src
BuildDepends:
base >= 1.0,
HUnit >= 1.0,
QuickCheck >= 1.0,
templatehaskell >= 1.0
Extensions:
MultiParamTypeClasses
FunctionalDependencies
UndecidableInstances
Exposedmodules:
TypeNats
TypeList
TypePrimes
Executable: testSuite
HsSourceDirs: test src
MainIs: Test.hs
Extensions:
MultiParamTypeClasses
FunctionalDependencies
UndecidableInstances
TemplateHaskell
GhcOptions: fcontextstack64 norecomp
 Comment out the following line to build the test suite
Buildable: False
typenats0.2source/LICENSE0000644000076400007640000000237010466473060015121 0ustar robertrobertCopyright 20052006, Robert Dockins.
All Rights Reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
 Redistribution of source code must retain the above copyright notice,
this list of conditions and the following disclamer.
 Redistribution in binary form must reproduce the above copyright notice,
this list of conditions and the following disclamer in the documentation
and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR 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 AUTHOR OR THE 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.
typenats0.2source/README0000644000076400007640000001061610466473060014776 0ustar robertrobert
TypeNats
========================
== What is it?
This package defines typelevel natural numbers and arithmetic operations on
them including addition, subtraction, multiplication, division and GCD. It also
includes a test suite.
Numbers are represented as a list of binary digits, terminated by a distinguished
type Z. Least significant digits are outermost, which makes the numbers littleendian when read.
Because a binary representation is used, reasonably large numbers can be represented and computed
upon. I have performed tests with numbers at the order of 10^15 in GHCi.
Typenats also includes a simple primality test based on the Sieve of Eratosthenes.
== For the sake of all that is good, why?
Good question. After reading a number of the clever papers floating about
which deal with type level programming, I decided to give it a whirl. Several
of the papers developed systems for doing typelevel arithmetic, but only as
a sideline to whatever cleverness what the true goal. I decided to solve the
typelevel arethemtic problem once and for all. This library is the result of
that effort. Let me know if you come up with a useful way to apply this library.
== How is it licensed?
The TypeNats library is available under a BSD3 license. See the LICENSE file for
details.
== How do I build it?
TypeNats uses a Cabal build system. The following commands
assume you have a Haskell interpreter in your system
path named 'runhaskell'. All commands are run from
this directory.
To install for the whole system:
runhaskell Setup.hs configure
runhaskell Setup.hs build
runhaskell Setup.hs install
To install for a single user:
runhaskell Setup.hs configure prefix=/home/
runhaskell Setup.hs build
runhaskell Setup.hs install user
To build the API docs:
runhaskell Setup.hs haddock
== How does this thing work?
Here is an example GHCi session.
$ ghci package TypeNats fcontextstack64
___ ___ _
/ _ \ /\ /\/ __(_)
/ /_\// /_/ / /   GHC Interactive, version 6.4.1, for Haskell 98.
/ /_\\/ __ / /___  http://www.haskell.org/ghc/
\____/\/ /_/\____/_ Type :? for help.
Loading package base1.0 ... linking ... done.
Loading package HUnit1.1 ... linking ... done.
Loading package QuickCheck1.0 ... linking ... done.
Loading package TypeNats0.1 ... linking ... done.
Prelude> :module TypeNats
Prelude TypeNats> :t seven
seven :: Seven
Prelude TypeNats> :i Seven
type Seven = I (I (I Z))  Imported from TypeNats
Prelude TypeNats> :t (add six nine)
(add six nine) :: I (I (I (I Z)))
Prelude TypeNats> :t (sub eight three)
(sub eight three) :: I (O (I (O Z)))
Prelude TypeNats> let x = four `billion` seven `hundred` sixty four `million` eighty_ `thousand` eleven
Prelude TypeNats> :t x
x :: I (I (O (I (O (O (O (I (I (I (I (O (I (O (O (O (O (I (I (O (I (I (I (I (I (I (O (I (I (O (O (O (I (O Z)))))))))))))))))))))))))))))))))
Prelude TypeNats> :t (natDiv x nineteen)
(natDiv x nineteen) :: I (O (I (I (I (I (O (O (I (O (O (O (O (O (O (O (O (I (O (O (I (I (I (I (O (I (I (I (O Z))))))))))))))))))))))))))))
Prelude TypeNats> naturalToIntegral (natDiv x nineteen)
250741053
Prelude TypeNats> (naturalToIntegral (natDiv x nineteen)) * 19 + (naturalToIntegral (natMod x nineteen))
4764080011
Prelude TypeNats> naturalToIntegral x
4764080011
Prelude TypeNats> :t (sub six thirteen)
Top level:
Couldn't match `CantSubtract' against `()'
Expected type: CantSubtract
Inferred type: ()
When using functional dependencies to combine
DoSub Z (I b) () CantSubtract,
arising from the instance declaration at Imported from TypeNats
DoSub Z (I Z) c (), arising from use of `sub' at :1:13
Prelude TypeNats> :t (natDiv ten zero)
Top level:
Couldn't match `DivideByZero' against `(q, r)'
Expected type: DivideByZero
Inferred type: (q, r)
When using functional dependencies to combine
PreDivMod a Z DivideByZero,
arising from the instance declaration at Imported from TypeNats
PreDivMod (I (O (I (O Z)))) Z (q, r),
arising from use of `natDiv' at :1:16
Prelude TypeNats> :quit
Leaving GHCi.
== Anything else I need to know?
Be prepared for the test suite to take a LONG time to compile. You can
enable the test suite by editing 'TypeNats.cabal'.
== Who is responsible for this mess?
You can send bug reports, rants and comments to:
Robert Dockins