1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
{-# LANGUAGE DeriveDataTypeable #-}
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.Tasty.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"]
|
