optimusprime-0.0.1.20091114: Optimus/Uniplate.hs

-- |This module provides a Uniplate instance for the f-lite syntax. It also
-- re-exports the Uniplate library.
module Optimus.Uniplate(
			module Data.Generics.Uniplate,
			extract
		) where
	
	import Flite.Syntax
	import Flite.Writer

	import Data.Generics.Uniplate
	
	instance Uniplate Exp where
		uniplate (Case x as) = (x:ys,	\(x:ys) -> Case x (zip ps ys))
			where
				(ps, ys) = unzip as
		uniplate (Let bs x)	= (x:ys,	\(x:ys)	-> Let (zip vs ys) x)
			where
				(vs, ys) = unzip bs
		uniplate (App x ys) = (x:ys,	\(x:ys) -> App x ys)
		uniplate (Var i) 	= ([],		\[]		-> Var i)
		uniplate (Con i)	= ([],		\[]		-> Con i)
		uniplate (Fun i) 	= ([],		\[]		-> Fun i)
		uniplate (Int i) 	= ([],		\[]		-> Int i)
		uniplate (Bottom) 	= ([],		\[]		-> Bottom)
		
	-- |Given a 'Uniplate' traversable tree and a function that extracts information
	-- from tree nodes, extract all the information in the tree.
	extract :: Uniplate a => (a -> [b]) -> a -> [b]
	extract f = fst . runWriter . descendM (\a -> writeMany (f a) >> return a)