[Haskell-cafe] Monad.Reader 8: Haskell, the new C++
Pepe Iborra
mnislaih at gmail.com
Thu Sep 13 10:38:15 EDT 2007
> 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}
More information about the Haskell-Cafe
mailing list