transformations-0.2.0.0: examples/MultiRec.hs

{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE EmptyDataDecls        #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE RankNTypes            #-}

module MultiRec where

import Datatypes
import Generics.MultiRec.Transformations.Main
import Generics.MultiRec.Transformations.Path

import Generics.MultiRec hiding ( show )
import Generics.MultiRec.TH

import Control.Monad ( (>=>) )

--------------------------------------------------------------------------------
-- Multirec representations for the example datatypes
--------------------------------------------------------------------------------
data TreeAST :: * -> * where
  Tree :: TreeAST Tree

$(deriveAll ''TreeAST)

data ListAST :: * -> * -> * where
  List :: ListAST a (List a)

$(deriveAll ''ListAST)

data XAST :: * -> * where
  X :: XAST X

$(deriveAll ''XAST)

data ZigZag :: * -> * where
  Zig :: ZigZag Zig
  Zag :: ZigZag Zag

$(deriveAll ''ZigZag)

data AST i where
  BExpr  :: AST BExpr
  AExpr  :: AST AExpr
  Stmt   :: AST Stmt

$(deriveAll ''AST)

--------------------------------------------------------------------------------
-- Examples
--------------------------------------------------------------------------------

type instance Ixs AST = '[ AExpr, BExpr, Stmt ]

deriving instance Ord AExpr
deriving instance Ord BExpr
deriving instance Ord Stmt

test1 :: Transformation AST Stmt
test1 = diff Stmt prog1 prog2

-- Constructor pattern synonyms
pattern Ref' :: Path phi ix top -> HWithRef phi top ix
pattern Ref' x = HIn (Ref x)

pattern Const' :: forall top. Integer -> HWithRef AST top AExpr
pattern Const' i = HIn (InR (R (L (Tag (R (L (C (K i))))))))

pattern BConst' :: forall top. Bool -> HWithRef AST top BExpr
pattern BConst' b = HIn (InR (L (Tag (L (C (K b))))))

pattern And' :: forall top. HWithRef AST top BExpr -> HWithRef AST top BExpr
             -> HWithRef AST top BExpr
pattern And' b1 b2 = HIn (InR (L (Tag (R (R (L (C (I b1 :*: I b2))))))))

pattern GT' :: forall top. HWithRef AST top AExpr -> HWithRef AST top AExpr
            -> HWithRef AST top BExpr
pattern GT' a1 a2 = HIn (InR (L (Tag (R (R (R (C (I a1 :*: I a2))))))))

test2 :: HWithRef AST top BExpr
test2 = BConst' True

test3 :: HWithRef AST top BExpr
test3 = And' test2 test2

-- test6 :: HWithRef AST BExpr BExpr
-- test6 = And' (GT' (Ref' test7) (Const' 2)) (Ref' test4)

-- Path pattern synonyms
pattern End     = Empty
pattern Not_0 p = Push BExpr (CL (CTag (CR (CL (CC CId))))) p

pattern GT_0 :: Path AST top AExpr -> Path AST top BExpr
pattern GT_0  p = Push AExpr (CL (CTag (CR (CR (CR (CC (C1 CId (I (K0 ()))))))))) p

pattern Neg_0 :: Path AST top AExpr -> Path AST top AExpr
pattern Neg_0 p = Push AExpr (CR (CL (CTag (CR (CR (CL (CC CId))))))) p

test4 :: Path AST BExpr BExpr
test4 = Not_0 (Not_0 End)

test5 :: Path AST AExpr BExpr
test5 = Not_0 (GT_0 End)

test7 :: Path AST AExpr AExpr
test7 = Neg_0 End

--
testPrgm = diff Stmt prog1 prog2