Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

Sharing in GADTs

By: a guest on Sep 1st, 2012  |  syntax: Haskell  |  size: 1.96 KB  |  views: 40  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. {-# LANGUAGE GADTs, FlexibleInstances, TypeFamilies, StandaloneDeriving, ScopedTypeVariables #-}
  2.  
  3. import Data.Maybe
  4. import Data.Reify
  5. import Data.Reify.Graph
  6. import Data.Typeable
  7. import Control.Applicative
  8.  
  9. data Ast e where
  10.   IntLit :: Int -> Ast Int
  11.   Add :: Ast Int -> Ast Int -> Ast Int
  12.   BoolLit :: Bool -> Ast Bool
  13.   IfThenElse :: Ast Bool -> Ast e -> Ast e -> Ast e
  14.  
  15. data AstNode s where
  16.   IntLitN :: Int -> AstNode s
  17.   AddN :: s -> s -> AstNode s
  18.   BoolLitN :: Bool -> AstNode s
  19.   IfThenElseN :: TypeRep -> s -> s -> s -> AstNode s
  20.  
  21. data Ast2 e where
  22.   IntLit2 :: Int -> Ast2 Int
  23.   Add2 :: Unique -> Unique -> Ast2 Int
  24.   BoolLit2 :: Bool -> Ast2 Bool
  25.   IfThenElse2 :: Unique -> Unique -> Unique -> Ast2 e
  26.  
  27. deriving instance Show (Ast e)    
  28. deriving instance Show (AstNode Int)  
  29. deriving instance Show (Ast2 e)
  30.  
  31. instance Typeable e => MuRef (Ast e) where
  32.   type DeRef (Ast e) = AstNode
  33.   mapDeRef f (IntLit a) = pure $ IntLitN a
  34.   mapDeRef f (Add a b) = AddN <$> f a <*> f b
  35.   mapDeRef f (BoolLit a) = pure $ BoolLitN a
  36.   mapDeRef f (IfThenElse a b c :: Ast e) = IfThenElseN (typeOf (undefined::e)) <$> f a <*> f b <*> f c
  37.  
  38. data Graph2 = Graph2 [(Unique, Ast2 Int)] [(Unique, Ast2 Bool)] Unique deriving Show
  39.  
  40. recoverTypes :: Graph AstNode -> Graph2
  41. recoverTypes (Graph xs x) = Graph2 (catMaybes $ map (f toAst2Int) xs) (catMaybes $ map (f toAst2Bool) xs) x where
  42.   f g (u,an) = do a2 <- g an
  43.                   return (u,a2)
  44.                  
  45.   toAst2Int (IntLitN a) = Just $ IntLit2 a
  46.   toAst2Int (AddN a b) = Just $ Add2 a b
  47.   toAst2Int (IfThenElseN t a b c) | t == typeOf (undefined :: Int) = Just $ IfThenElse2 a b c
  48.   toAst2Int _ = Nothing
  49.  
  50.   toAst2Bool (BoolLitN a) = Just $ BoolLit2 a
  51.   toAst2Bool (IfThenElseN t a b c) | t == typeOf (undefined :: Bool) = Just $ IfThenElse2 a b c
  52.   toAst2Bool _ = Nothing
  53.  
  54.  
  55. expr = Add (IntLit 42) expr  
  56.  
  57. test = do
  58.   graph <- reifyGraph expr
  59.   print graph
  60.   print $ recoverTypes graph