content: {-# LANGUAGE UndecidableInstances, FlexibleInstances, TypeOperators, FlexibleContexts,
               MultiParamTypeClasses, FunctionalDependencies, DatatypeContexts #-}
  
  -- This one crashed GHC 6.3 due to an error in GHC.Tc.Solver.add_ors
  
  module Foo where
  
  data Zero   = Zero deriving Show
  data One    = One deriving Show
  infixl 9 :@
  data (Number a, Digit b) => a :@ b = a :@ b deriving Show
  
  class Digit a
  instance Digit Zero
  instance Digit One
  
  class Number a
  instance Number Zero
  instance Number One
  instance (Number a, Digit b) => Number (a :@ b)
  
  --- Pretty printing of numbers ---
  class PrettyNum a where
      prettyNum   :: a -> String
  
  instance PrettyNum Zero where
      prettyNum _ = "0"
  
  instance PrettyNum One where
      prettyNum _ = "1"
  
  instance (Number a, Digit b, PrettyNum a, PrettyNum b)
        => PrettyNum (a :@ b) where
      prettyNum ~(a:@b)
                  = prettyNum a ++ prettyNum b
  
  --- Digit addition ---
  class (Number a, Digit b, Number c)
     => AddDigit a b c | a b -> c where
      addDigit    :: a -> b -> c
      addDigit    = undefined
  
  instance Number a => AddDigit a Zero a
  instance AddDigit Zero One One
  instance AddDigit One One (One:@Zero)
  instance Number a => AddDigit (a:@Zero) One (a:@One)
  instance AddDigit a One a'
        => AddDigit (a:@One) One (a':@Zero)
  
  --- Addition ---
  class (Number a, Number b, Number c)
     => Add a b c | a b -> c where
      add     :: a -> b -> c
      add     = undefined
  
  instance Number n => Add n Zero n
  instance Add Zero One One
  instance Add One One (One:@One)
  instance Number n
        => Add (n:@Zero) One (n:@One)
  instance AddDigit n One r'
        => Add (n:@One) One (r':@Zero)
  instance ( Number n1, Digit d1, Number n2, Digit n2
           , Add n1 n2 nr', AddDigit (d1:@nr') d2 r
           , Number r)  -- Added when fixing #20666
                        -- Because (AddDigit (d1:@nr') d2 r) is not
                        -- Paterson-smaller than the instance head
        => Add (n1:@d1) (n2:@d2) r
  
  foo = show $ add (One:@Zero) (One:@One)
  
  
  -- Add (One:@Zero) (One:@One) c, Show c
  -- ==> Number One, Digit Zero, Number One, Digit One
  --     Add One One nr', AddDigit (Zero:@nr') One c, Show c
  --
  -- ==> Add One One nr', AddDigit (Zero:@nr') One c, Show c
  --
  -- ==> Add One One (One:@One), AddDigit (Zero:@(One:@One)) One c, Show c
  --
  -- ==> AddDigit (Zero:@(One:@One)) One c, Show c
  