1{-# OPTIONS -fglasgow-exts #-}
2
3module FreeNames (tests) where
4
5{-
6
7This example illustrates the kind of traversals that naturally show up
8in language processing. That is, the free names (say, variables) are
9derived for a given program fragment. To this end, we need several
10worker functions that extract declaring and referencing occurrences
11from given program fragments; see "decsExpr", "decsEqua",
12etc. below. Then, we need a traversal "freeNames" that traverses over
13the program fragment in a bottom-up manner so that free names from
14subterms do not escape to the top when corresponding declarations are
15provided. The "freeNames" algorithm uses set operations "union" and
16"//" to compute sets of free names from the declared and referenced
17names of the root term and free names of the immediate subterms.
18
19Contributed by Ralf Laemmel, ralf@cwi.nl
20
21-}
22
23import Test.HUnit
24
25import Data.Generics
26import Data.List
27
28data System     = S [Function]                     deriving (Typeable, Data)
29
30data Function   = F Name [Equation]                deriving (Typeable, Data)
31
32data Equation   = E [Pattern] Expression System    deriving (Typeable, Data)
33
34data Pattern    = PVar Name
35                | PTerm Name [Pattern]             deriving (Typeable, Data)
36
37data Expression = Var Name
38                | App Expression Expression
39                | Lambda Name Expression           deriving (Typeable, Data)
40
41type Name       = String
42
43-- A little sample program
44
45sys1   = S [f1,f2]
46f1     = F "f1" [e11]
47f2     = F "f2" [e21,e22]
48e11    = E [] (Var "id") (S [])
49e21    = E [ PTerm "C" [ PVar "x" ] ] (Var "x") (S [])
50e22    = E [] (Var "id") (S [])
51
52
53-- Names declared in an expression
54decsExpr :: Expression -> [Name]
55decsExpr (Lambda n _) = [n]
56decsExpr _            = []
57
58-- Names declared in an equation
59decsEqua :: Equation -> [Name]
60decsEqua (E ps _ _) = everything union ([] `mkQ` pvar) ps
61  where
62    pvar (PVar n) = [n]
63    pvar _        = []
64
65-- Names declared in a system
66decsSyst :: System -> [Name]
67decsSyst (S l) = nub $ map (\(F n _) -> n) l
68
69-- Names referenced in an expression
70refsExpr :: Expression -> [Name]
71refsExpr (Var n) = [n]
72
73-- Names referenced in an equation
74refsEqua :: Equation -> [Name]
75refsEqua (E ps _ _) = everything union ([] `mkQ` pterm) ps
76  where
77    pterm (PTerm n _) = [n]
78    pterm _           = []
79
80-- Combine the above type-specific cases to obtain
81-- generic functions that find declared and referenced names
82--
83decsFun :: Data a => a -> [Name]
84decsFun =  const [] `extQ` decsExpr `extQ` decsEqua `extQ` decsSyst
85
86refsFun :: Data a => a -> [Name]
87refsFun =  const [] `extQ` refsExpr `extQ` refsEqua
88
89
90
91{-
92
93Free name analysis: Take the union of free names obtained from the
94immediate subterms (via gmapQ) and the names being referred to at the
95root of the present term, but subtract all the names that are declared
96at the root.
97
98-}
99
100freeNames :: Data a => a -> [Name]
101freeNames x = ( (refsFun x)
102                `union`
103                (nub . concat . gmapQ freeNames) x
104              ) \\ decsFun x
105
106{-
107
108Print the free names for the sample program sys1; see module
109FunDatatypes.hs. This should print the list ["id","C"] because the
110"Prelude" function "id" is used in the sample program, and also the
111term constructor "C" occurs in a pattern; we assume a language without
112explicit datatype declarations ;-)
113
114-}
115
116tests = freeNames sys1 ~=? output
117
118output = ["id","C"]
119