(* HCoop Domtool (http://hcoop.sourceforge.net/)
* Copyright (c) 2007, Adam Chlipala
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
* as published by the Free Software Foundation; either version 2
* of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
*)
(* Domtool configuration language unused environment variable setting analysis *)
structure Unused :> UNUSED = struct
open Ast
structure SM = StringMap
structure SS = StringSet
fun check G e =
let
fun used vars x =
(#1 (SM.remove (vars, x)))
handle NotFound => vars
fun unused loc x =
ErrorMsg.warning (SOME loc) ("Unused setting of environment variable " ^ x)
fun writing vars x loc =
(Option.app (fn loc' => unused loc' x) (SM.find (vars, x));
SM.insert (vars, x, loc))
fun findHead (e, _) =
case e of
EVar x => SOME x
| EApp (e, _) => findHead e
| _ => NONE
fun processTy f default loc t =
case #1 (Describe.ununify t) of
TArrow (_, t) => processTy f default loc t
| TNested (_, t) => processTy f default loc t
| TAction (_, reads, writes) => f (reads, writes)
| _ => default
fun writes (e, _) =
case e of
ESet (x, _) => SS.singleton x
| EGet (_, _, _, e) => writes e
| ESeq es => foldl (fn (e, s) => SS.union (writes e, s)) SS.empty es
| ELocal (_, e) => writes e
| EWith (e, _) => writes e
| _ => SS.empty
fun chk (eAll as (e, loc), vars) =
case e of
EInt _ => vars
| EString _ => vars
| EList es => vars
| ELam _ => vars
| ESkip => vars
| ESet (x, _) => writing vars x loc
| EGet (_, _, x, e) => chk (e, used vars x)
| ESeq es => foldl chk vars es
| ELocal (e1, e2) =>
let
val vars = chk (e2, chk (e1, vars))
val writes1 = writes e1
val writes2 = writes e2
in
SM.foldli (fn (x, _, vars') =>
if SS.member (writes1, x)
andalso not (SS.member (writes2, x)) then
SM.insert (vars', x, valOf (SM.find (vars, x)))
else
vars') vars vars
end
| EWith (e1, e2) => chk (e2, chk (e1, vars))
| EALam _ => vars
| EIf _ => vars
| _ =>
let
val processTy = processTy (fn (reads, writes) =>
let
val vars = SM.foldli (fn (x, _, vars) => used vars x) vars reads
in
SM.foldli (fn (x, _, vars) => writing vars x loc) vars writes
end)
vars
in
case findHead eAll of
NONE => raise Fail "Couldn't find the head"
| SOME head =>
case Env.lookupVal G head of
NONE => vars
| SOME t => processTy loc t
end
in
SM.appi (fn (x, loc) => unused loc x) (chk (e, SM.empty))
end
end