[Haskell-cafe] A Show instance for simple functions
Benja Fallenstein
benja.fallenstein at gmail.com
Tue Dec 18 13:41:48 EST 2007
Hi all,
Below is a program that implements Show for functions whose type is
composed of only (->) and type variables (or, more precisely, of (->)
and (State Int Term), but any type composed of (->) and type variables
can obviously be specialized to that).
(-fglasgow-exts is needed only for the convenience of being able to
declare "instance MkTerm (State Int Term)" -- if we'd wrap the State
Int Term in a newtype, as far as I can see this would be H98.)
- Benja
{-# OPTIONS_GHC -fglasgow-exts #-}
import Control.Monad
import Control.Monad.State
import Data.Char
data Term = Var Int | App Term Term | Lam Int Term
showVar i = [chr (ord 'a' + i)]
showTerm :: Term -> String
showTerm (Var i) = showVar i
showTerm (Lam i x) = "\\" ++ showVar i ++ " -> " ++ showTerm x
showTerm (App f x) = showTerm f ++ " " ++ showArg x where
showArg (Var i) = showVar i; showArg x = "(" ++ showTerm x ++ ")"
class MkTerm a where
argument :: State Int Term -> a
mkTerm :: a -> State Int Term
instance MkTerm (State Int Term) where
argument = id
mkTerm = id
instance (MkTerm a, MkTerm b) => MkTerm (a -> b) where
argument f x = argument $ liftM2 App f (mkTerm x)
mkTerm f = do i <- get; modify (+1)
body <- mkTerm (f (argument (return (Var i))))
return $ Lam i body
instance (MkTerm a, MkTerm b) => Show (a -> b) where
show f = showTerm $ evalState (mkTerm f) 0
type X = State Int Term
main = do print (id :: X -> X)
print (id :: (X -> X) -> (X -> X))
print ((.) :: (X -> X) -> (X -> X) -> (X -> X))
print ((\x y -> y x) :: X -> (X -> X) -> X)
print ((\f x -> f x x) :: (X -> X -> X) -> X -> X)
print ((\f -> f id id) :: ((X -> X) -> (X -> X) -> X) -> X)
More information about the Haskell-Cafe
mailing list