{-# OPTIONS -fglasgow-exts #-} module FreeNames (tests) where {- This example illustrates the kind of traversals that naturally show up in language processing. That is, the free names (say, variables) are derived for a given program fragment. To this end, we need several worker functions that extract declaring and referencing occurrences from given program fragments; see "decsExpr", "decsEqua", etc. below. Then, we need a traversal "freeNames" that traverses over the program fragment in a bottom-up manner so that free names from subterms do not escape to the top when corresponding declarations are provided. The "freeNames" algorithm uses set operations "union" and "//" to compute sets of free names from the declared and referenced names of the root term and free names of the immediate subterms. Contributed by Ralf Laemmel, ralf@cwi.nl -} import Test.HUnit import Data.Generics import Data.List data System = S [Function] deriving (Typeable, Data) data Function = F Name [Equation] deriving (Typeable, Data) data Equation = E [Pattern] Expression System deriving (Typeable, Data) data Pattern = PVar Name | PTerm Name [Pattern] deriving (Typeable, Data) data Expression = Var Name | App Expression Expression | Lambda Name Expression deriving (Typeable, Data) type Name = String -- A little sample program sys1 = S [f1,f2] f1 = F "f1" [e11] f2 = F "f2" [e21,e22] e11 = E [] (Var "id") (S []) e21 = E [ PTerm "C" [ PVar "x" ] ] (Var "x") (S []) e22 = E [] (Var "id") (S []) -- Names declared in an expression decsExpr :: Expression -> [Name] decsExpr (Lambda n _) = [n] decsExpr _ = [] -- Names declared in an equation decsEqua :: Equation -> [Name] decsEqua (E ps _ _) = everything union ([] `mkQ` pvar) ps where pvar (PVar n) = [n] pvar _ = [] -- Names declared in a system decsSyst :: System -> [Name] decsSyst (S l) = nub $ map (\(F n _) -> n) l -- Names referenced in an expression refsExpr :: Expression -> [Name] refsExpr (Var n) = [n] -- Names referenced in an equation refsEqua :: Equation -> [Name] refsEqua (E ps _ _) = everything union ([] `mkQ` pterm) ps where pterm (PTerm n _) = [n] pterm _ = [] -- Combine the above type-specific cases to obtain -- generic functions that find declared and referenced names -- decsFun :: Data a => a -> [Name] decsFun = const [] `extQ` decsExpr `extQ` decsEqua `extQ` decsSyst refsFun :: Data a => a -> [Name] refsFun = const [] `extQ` refsExpr `extQ` refsEqua {- Free name analysis: Take the union of free names obtained from the immediate subterms (via gmapQ) and the names being referred to at the root of the present term, but subtract all the names that are declared at the root. -} freeNames :: Data a => a -> [Name] freeNames x = ( (refsFun x) `union` (nub . concat . gmapQ freeNames) x ) \\ decsFun x {- Print the free names for the sample program sys1; see module FunDatatypes.hs. This should print the list ["id","C"] because the "Prelude" function "id" is used in the sample program, and also the term constructor "C" occurs in a pattern; we assume a language without explicit datatype declarations ;-) -} tests = freeNames sys1 ~=? output output = ["id","C"]