For a taste, see Instant Insanity transliterated in this functional language:

http://hpaste.org/2689


I thought I'd better paste here the code for Instant Insanity with Type Families. Otherwise it will vanish in a short time.
I took the opportunity to clean it up a bit.

Although AT are not a supported feature, the code works in a 6.8.1 snapshot. But note that you cannot actually see the solution, as there is no way to ask
GHCi to display the normalized types.

My favorite bit is:
*>  type instance Map f Nil = Nil
*>  type instance Map f (x:::xs) = Apply f x ::: Map f xs

\begin{code}
  import Prelude hiding (all, flip, map, filter)
  u = undefined

  data R  -- Red
  data G  -- Green
  data B  -- Blue
  data W  -- White

  data Cube u f r b l d

  type CubeRed = Cube R R R R R R
  type CubeBlue = Cube B B B B B B
  type Cube1 = Cube B G W G B R
  type Cube2 = Cube W G B W R R
  type Cube3 = Cube G W R B R R
  type Cube4 = Cube B R G G W W

  data True
  data False

  type family And b1 b2
  type instance And True  True = True
  type instance And True  False= False
  type instance And False True = False
  type instance And False False= False

  data Nil
  data Cons x xs
  data x ::: xs
  infixr 5 :::

  type family ListConcat l1 l2
  type instance ListConcat Nil l = l
  type instance ListConcat (x:::xs) ys = x:::(ListConcat xs ys)

  type family Apply f a

  data Rotation
  data Twist
  data Flip
  type instance Apply Rotation (Cube u f r b l d) = Cube u r b l f d
  type instance Apply Twist    (Cube u f r b l d) = Cube f r u l d b
  type instance Apply Flip     (Cube u f r b l d) = Cube d l b r f u

  type family Map f xs
  type instance Map f Nil = Nil
  type instance Map f (x:::xs) = Apply f x ::: Map f xs

  type family Filter f xs
  type instance Filter f Nil = Nil
type instance Filter f (x:::xs) = AppendIf (Apply f x) x (Filter f xs)

  type family AppendIf b x ys
  type instance AppendIf True x ys  = x ::: ys
  type instance AppendIf False x ys = ys

  type family MapAppend f xs
  type instance MapAppend f Nil = Nil
type instance MapAppend f (x:::xs) = ListConcat (x:::xs) (Map f (x:::xs))

  type family MapAppend2 f xs
  type instance MapAppend2 f Nil = Nil
type instance MapAppend2 f (x:::xs) = ListConcat (x:::xs) (MapAppend f (Map f (x:::xs)))

  type family MapAppend3 f xs
  type instance MapAppend3 f Nil = Nil
type instance MapAppend3 f (x:::xs) = ListConcat xs (MapAppend2 f (Map f (x:::xs)))


  data Orientations
  type instance Apply Orientations c = MapAppend3 Rotation (
                                       MapAppend2 Twist (
                                       MapAppend Flip (c:::Nil)))
  type family NE x y
  type instance NE R R = False
  type instance NE R G = True
  type instance NE R B = True
  type instance NE R W = True
  type instance NE G R = True
  type instance NE G G = False
  type instance NE G B = True
  type instance NE G W = True
  type instance NE B R = True
  type instance NE B G = True
  type instance NE B B = False
  type instance NE B W = True
  type instance NE W R = True
  type instance NE W G = True
  type instance NE W B = True
  type instance NE W W = False

  type family All l
  type instance All Nil = True
  type instance All (False ::: xs) = False
  type instance All (True ::: xs)  = All xs

  type family Compatible c1 c2
type instance Compatible (Cube u1 f1 r1 b1 l1 d1) (Cube u2 f2 r2 b2 l2 d2) =
      All (NE f1 f2 ::: NE r1 r2 ::: NE b1 b2 ::: NE l1 l2)

  type family Allowed c cs
  type instance Allowed c Nil = True
type instance Allowed c (y ::: ys) = And (Compatible c y) (Allowed c ys)

  type family Solutions cs
  type instance Solutions Nil = (Nil ::: Nil)
type instance Solutions (c ::: cs) = AllowedCombinations (Apply Orientations c) (Solutions cs)

  type family AllowedCombinations os sols
  type instance AllowedCombinations os Nil = Nil
  type instance AllowedCombinations os (s ::: sols) =
ListConcat (AllowedCombinations os sols) (MatchingOrientations os s)

  type family MatchingOrientations os sol
  type instance MatchingOrientations Nil sol = Nil
  type instance MatchingOrientations (o ::: os) sol =
      AppendIf (Allowed o sol) (o:::sol) (MatchingOrientations os sol)

  type Cubes = (Cube1 ::: Cube2 ::: Cube3 ::: Cube4 ::: Nil)
  solution = u :: Solutions Cubes

\end{code}
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to