fixed-point type

FixT.hs

{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}
module FixT where

data Expr = Val
          | Divide Expr Expr
          | Times Expr Expr
          deriving Show

flipDivide :: Expr -> Expr
flipDivide Val = Val
flipDivide (Divide a b) = Divide (flipDivide b) (flipDivide a)
flipDivide (Times a b) = Times (flipDivide a) (flipDivide b)


data FExpr a = FVal Int
             | FDivide a a
             | FTimes a a
             deriving Show

instance Functor FExpr where
  fmap f (FDivide a b) = FDivide (f a) (f b)
  fmap f (FTimes a b) = FTimes (f a ) (f b)
  fmap _ (FVal x) = FVal x

data Fix a = Fix { unFix :: a (Fix a) }

flipFDivide :: Fix FExpr -> Fix FExpr
flipFDivide (Fix (FDivide a b)) = Fix (FDivide (flipFDivide b) (flipFDivide a))
flipFDivide (Fix x) = Fix $ fmap flipFDivide x

instance Show (Fix FExpr) where
  show (Fix x) = "Fix (" ++ (show x) ++ ")"

main :: IO ()
main = return ()