Subject: Re: Monad.Reader 8: Haskell, the new C++ Newsgroups: gmane.comp.lang.haskell.cafe Date: Thursday 13th September 2007 14:38:15 UTC (over 10 years ago) > 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} |
|||