1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2007, Adam Chlipala
4 * This program is free software
; you can redistribute it
and/or
5 * modify it under the terms
of the GNU General Public License
6 * as published by the Free Software Foundation
; either version
2
7 * of the License
, or (at your option
) any later version
.
9 * This program is distributed
in the hope that it will be useful
,
10 * but WITHOUT ANY WARRANTY
; without even the implied warranty
of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
. See the
12 * GNU General Public License for more details
.
14 * You should have received a copy
of the GNU General Public License
15 * along
with this program
; if not
, write to the Free Software
16 * Foundation
, Inc
., 51 Franklin Street
, Fifth Floor
, Boston
, MA
02110-1301, USA
.
19 (* Domtool configuration language unused environment variable setting analysis
*)
21 structure Unused
:> UNUSED
= struct
24 structure SM
= StringMap
25 structure SS
= StringSet
30 (#
1 (SM
.remove (vars
, x
)))
31 handle NotFound
=> vars
34 ErrorMsg
.warning (SOME loc
) ("Unused setting of environment variable " ^ x
)
36 fun writing vars x loc
=
37 (Option
.app (fn loc
' => unused loc
' x
) (SM
.find (vars
, x
));
38 SM
.insert (vars
, x
, loc
))
43 |
EApp (e
, _
) => findHead e
46 fun processTy f default loc t
=
47 case #
1 (Describe
.ununify t
) of
48 TArrow (_
, t
) => processTy f default loc t
49 |
TNested (_
, t
) => processTy f default loc t
51 |
TAction (_
, reads
, writes
) => f (reads
, writes
)
57 ESet (x
, _
) => SS
.singleton x
58 |
EGet (_
, _
, _
, e
) => writes e
59 | ESeq es
=> foldl (fn (e
, s
) => SS
.union (writes e
, s
)) SS
.empty es
60 |
ELocal (_
, e
) => writes e
61 |
EWith (e
, _
) => writes e
64 fun chk (eAll
as (e
, loc
), vars
) =
72 |
ESet (x
, _
) => writing vars x loc
73 |
EGet (_
, _
, x
, e
) => chk (e
, used vars x
)
74 | ESeq es
=> foldl chk vars es
77 val vars
= chk (e2
, chk (e1
, vars
))
78 val writes1
= writes e1
79 val writes2
= writes e2
81 SM
.foldli (fn (x
, _
, vars
') =>
82 if SS
.member (writes1
, x
)
83 andalso not (SS
.member (writes2
, x
)) then
84 SM
.insert (vars
', x
, valOf (SM
.find (vars
, x
)))
88 |
EWith (e1
, e2
) => chk (e2
, chk (e1
, vars
))
94 val processTy
= processTy (fn (reads
, writes
) =>
96 val vars
= SM
.foldli (fn (x
, _
, vars
) => used vars x
) vars reads
98 SM
.foldli (fn (x
, _
, vars
) => writing vars x loc
) vars writes
102 case findHead eAll
of
103 NONE
=> raise Fail
"Couldn't find the head"
105 case Env
.lookupVal G head
of
107 | SOME t
=> processTy loc t
110 SM
.appi (fn (x
, loc
) => unused loc x
) (chk (e
, SM
.empty
))