Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : ghc-7.2
http://hackage.haskell.org/trac/ghc/changeset/c222282066ad9fecbe07f1bd3a9094aacc1568d1 >--------------------------------------------------------------- commit c222282066ad9fecbe07f1bd3a9094aacc1568d1 Author: Simon Peyton Jones <[email protected]> Date: Mon Jul 18 11:28:19 2011 +0100 Test Trac #5329 >--------------------------------------------------------------- .../ghc-regress/simplCore/should_compile/T5329.hs | 129 ++++++++++++++++++++ tests/ghc-regress/simplCore/should_compile/all.T | 2 + 2 files changed, 131 insertions(+), 0 deletions(-) diff --git a/tests/ghc-regress/simplCore/should_compile/T5329.hs b/tests/ghc-regress/simplCore/should_compile/T5329.hs new file mode 100644 index 0000000..cf65911 --- /dev/null +++ b/tests/ghc-regress/simplCore/should_compile/T5329.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE UnicodeSyntax #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} + +module T5329 where + +data PZero +data PSucc p + +data Peano n where + PZero â· Peano PZero + PSucc â· IsPeano p â Peano p â Peano (PSucc p) + +class IsPeano n where + peano â· Peano n + +instance IsPeano PZero where + peano = PZero + +instance IsPeano p â IsPeano (PSucc p) where + peano = PSucc peano + +class (n ~ PSucc (PPred n)) â PHasPred n where + type PPred n + +instance PHasPred (PSucc p) where + type PPred (PSucc p) = p + +pPred â· Peano (PSucc p) â Peano p +pPred (PSucc p) = p + +infixl 6 :+: + +class (IsPeano n, IsPeano m, IsPeano (n :+: m), (n :+: m) ~ (m :+: n)) + â PAdd n m where + type n :+: m + +instance PAdd PZero PZero where + type PZero :+: PZero = PZero + +instance IsPeano p â PAdd PZero (PSucc p) where + type PZero :+: (PSucc p) = PSucc p + +instance IsPeano p â PAdd (PSucc p) PZero where + type (PSucc p) :+: PZero = PSucc p + +instance (IsPeano n, IsPeano m, PAdd n m) â PAdd (PSucc n) (PSucc m) where + type (PSucc n) :+: (PSucc m) = PSucc (PSucc (n :+: m)) + +data PAddResult n m r where + PAddResult â· (PAdd n m, PAdd m n, (n :+: m) ~ r) + â PAddResult n m r + +pAddLeftZero â· â n . IsPeano n â PAddResult PZero n n +pAddLeftZero = case peano â· Peano n of + PZero â PAddResult + PSucc _ â PAddResult + +pAddRightZero â· â n . IsPeano n â PAddResult n PZero n +pAddRightZero = case peano â· Peano n of + PZero â PAddResult + PSucc _ â PAddResult + +data PAddSucc n m where + PAddSucc â· (PAdd n m, PAdd m n, + PAdd (PSucc n) m, PAdd m (PSucc n), + PAdd n (PSucc m), PAdd (PSucc m) n, + (PSucc n :+: m) ~ PSucc (n :+: m), + (n :+: PSucc m) ~ PSucc (n :+: m)) + â PAddSucc n m + +pAddSucc â· â n m . (IsPeano n, IsPeano m) â PAddSucc n m +pAddSucc = case (peano â· Peano n, peano â· Peano m) of + (PZero, PZero) â PAddSucc + (PZero, PSucc _) â case pAddLeftZero â· PAddResult n (PPred m) (PPred m) of + PAddResult â PAddSucc + (PSucc _, PZero) â case pAddRightZero â· PAddResult (PPred n) m (PPred n) of + PAddResult â PAddSucc + (PSucc _, PSucc _) â case pAddSucc â· PAddSucc (PPred n) (PPred m) of + PAddSucc â PAddSucc + +data PAdd2 n m where + PAdd2 â· (PAdd n m, PAdd m n) â PAdd2 n m + +pAdd2 â· â n m . (IsPeano n, IsPeano m) â PAdd2 n m +pAdd2 = case (peano â· Peano n, peano â· Peano m) of + (PZero, PZero) â PAdd2 + (PZero, PSucc _) â PAdd2 + (PSucc _, PZero) â PAdd2 + (PSucc _, PSucc _) â case pAdd2 â· PAdd2 (PPred n) (PPred m) of + PAdd2 â PAdd2 + +data PAdd3 n m k where + PAdd3 â· (PAdd n m, PAdd m k, PAdd m n, PAdd k m, PAdd n k, PAdd k n, + PAdd (n :+: m) k, PAdd k (m :+: n), + PAdd n (m :+: k), PAdd (m :+: k) n, + PAdd (n :+: k) m, PAdd m (n :+: k), + ((n :+: m) :+: k) ~ (n :+: (m :+: k)), + (m :+: (n :+: k)) ~ ((m :+: n) :+: k)) + â PAdd3 n m k + +pAdd3 â· â n m k . (IsPeano n, IsPeano m, IsPeano k) â PAdd3 n m k +pAdd3 = case (peano â· Peano n, peano â· Peano m, peano â· Peano k) of + (PZero, PZero, PZero) â PAdd3 + (PZero, PZero, PSucc _) â PAdd3 + (PZero, PSucc _, PZero) â PAdd3 + (PSucc _, PZero, PZero) â PAdd3 + (PZero, PSucc _, PSucc _) â + case pAdd2 â· PAdd2 (PPred m) (PPred k) of + PAdd2 â PAdd3 + (PSucc _, PZero, PSucc _) â + case pAdd2 â· PAdd2 (PPred n) (PPred k) of + PAdd2 â PAdd3 + (PSucc _, PSucc _, PZero) â + case pAdd2 â· PAdd2 (PPred n) (PPred m) of + PAdd2 â PAdd3 + (PSucc _, PSucc _, PSucc _) â + case pAdd3 â· PAdd3 (PPred n) (PPred m) (PPred k) of + PAdd3 â case pAddSucc â· PAddSucc (PPred n :+: PPred m) (PPred k) of + PAddSucc â case pAddSucc â· PAddSucc (PPred n :+: PPred k) (PPred m) of + PAddSucc â case pAddSucc â· PAddSucc (PPred m :+: PPred k) (PPred n) of + PAddSucc â PAdd3 + diff --git a/tests/ghc-regress/simplCore/should_compile/all.T b/tests/ghc-regress/simplCore/should_compile/all.T index f7a15a3..2705d8f 100644 --- a/tests/ghc-regress/simplCore/should_compile/all.T +++ b/tests/ghc-regress/simplCore/should_compile/all.T @@ -121,3 +121,5 @@ test('T5168', normal, run_command, ['$MAKE -s --no-print-directory T5168']) + +test('T5329', normal, compile, [''])
_______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
