Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Diff of /branches/staging/src/compiler/typechecker/typechecker.sml
ViewVC logotype

Diff of /branches/staging/src/compiler/typechecker/typechecker.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2658, Fri May 30 14:30:43 2014 UTC revision 2659, Fri May 30 14:32:52 2014 UTC
# Line 26  Line 26 
26     *)     *)
27      exception TypeError      exception TypeError
28    
29      (* variable properties to support unused variable warning *)
30        val {getFn=isUsed, setFn=markUsed} = Var.newFlag()
31        val {setFn=(setLoc : AST.var * Error.location -> unit), getFn=getLoc, ...} =
32              Var.newProp(fn x => raise Fail("no location for " ^ Var.nameOf x))
33    
34      datatype scope      datatype scope
35        = GlobalScope        = GlobalScope
36        | FunctionScope of Ty.ty * Atom.atom        | FunctionScope of Ty.ty * Atom.atom
# Line 40  Line 45 
45        | scopeToString InitScope = "initialization"        | scopeToString InitScope = "initialization"
46    
47      type env = {      type env = {
48          scope : scope,          scope : scope,                          (* current scope *)
49          bindings : Error.location AtomMap.map,          bindings : Error.location AtomMap.map,  (* map from atoms to innermost binding location *)
50          env : Env.env          env : Env.env                           (* variable environment *)
51        }        }
52    
53      type context = Error.err_stream * Error.span      type context = Error.err_stream * Error.span
# Line 73  Line 78 
78              bindings = AtomMap.insert(bindings, f, Error.location cxt),              bindings = AtomMap.insert(bindings, f, Error.location cxt),
79              env=Env.insertFunc(env, f, Env.UserFun f')              env=Env.insertFunc(env, f, Env.UserFun f')
80            }            }
81      fun insertLocal ({scope, bindings, env}, cxt, x, x') = {      fun insertLocal ({scope, bindings, env}, cxt, x, x') = let
82              val loc = Error.location cxt
83              in
84                setLoc(x', loc);
85                {
86              scope=scope,              scope=scope,
87              bindings = AtomMap.insert(bindings, x, Error.location cxt),              bindings = AtomMap.insert(bindings, x, Error.location cxt),
88              env=Env.insertLocal(env, x, x')              env=Env.insertLocal(env, x, x')
89            }            }
90      fun insertGlobal ({scope, bindings, env}, cxt, x, x') = {            end
91        fun insertGlobal ({scope, bindings, env}, cxt, x, x') = let
92              val loc = Error.location cxt
93              in
94                setLoc(x', loc);
95                {
96              scope=scope,              scope=scope,
97              bindings = AtomMap.insert(bindings, x, Error.location cxt),                bindings = AtomMap.insert(bindings, x, loc),
98              env=Env.insertGlobal(env, x, x')              env=Env.insertGlobal(env, x, x')
99            }            }
100              end
101    
102      fun withContext ((errStrm, _), {span, tree}) =      fun withContext ((errStrm, _), {span, tree}) =
103            ((errStrm, span), tree)            ((errStrm, span), tree)
# Line 112  Line 127 
127            raise TypeError)            raise TypeError)
128      end (* local *)      end (* local *)
129    
130      (* check for redefinition of an identifier in the same scope *)
131    (* TODO: check for shadowing too? *)
132      fun checkForRedef (env : env, cxt : context, x) = (case AtomMap.find(#bindings env,x)      fun checkForRedef (env : env, cxt : context, x) = (case AtomMap.find(#bindings env,x)
133             of SOME loc => err (cxt, [             of SOME loc => err (cxt, [
134                    S "redefinition of ", A x, S ", previous definition at ",                    S "redefinition of ", A x, S ", previous definition at ",
# Line 239  Line 256 
256      fun checkExpr (env : env, cxt, e) = (case e      fun checkExpr (env : env, cxt, e) = (case e
257             of PT.E_Mark m => checkExpr (withEnvAndContext (env, cxt, m))             of PT.E_Mark m => checkExpr (withEnvAndContext (env, cxt, m))
258              | PT.E_Var x => (case Env.findVar (#env env, x)              | PT.E_Var x => (case Env.findVar (#env env, x)
259                   of SOME x' => (AST.E_Var x', Var.monoTypeOf x')                   of SOME x' => (
260                          markUsed (x', true);
261                          (AST.E_Var x', Var.monoTypeOf x'))
262                    | NONE => err(cxt, [S "undeclared variable ", A x])                    | NONE => err(cxt, [S "undeclared variable ", A x])
263                  (* end case *))                  (* end case *))
264              | PT.E_Lit lit => checkLit lit              | PT.E_Lit lit => checkLit lit
# Line 1053  Line 1072 
1072                  end                  end
1073            (* end case *))            (* end case *))
1074    
1075      (* check AST for unused variables *)
1076        fun checkForUnused cxt dcl = let
1077              fun chkVar x = if not(isUsed x)
1078                    then warn (cxt, [
1079                        S(Var.kindToString x), S " ", V x, S " declared at ",
1080                        S(Error.locToString(getLoc x)), S " is unused"
1081                      ])
1082                    else ()
1083              fun chkVDcl (AST.VD_Decl(x, _)) = chkVar x
1084              fun chkStm stm = (case stm
1085                     of AST.S_Block stms => List.app chkStm stms
1086                      | AST.S_Decl vd => chkVDcl vd
1087                      | AST.S_IfThenElse(_, s1, s2) => (chkStm s1; chkStm s2)
1088                      | _ => ()
1089                    (* end case *))
1090              in
1091                case dcl
1092                 of AST.D_Input(x, _, _) => chkVar x
1093                  | AST.D_Var vd => chkVDcl vd
1094                  | AST.D_Func(f, params, body) => (
1095                      chkVar f;
1096                      List.app chkVar params;
1097                      chkStm body)
1098                  | AST.D_Strand(AST.Strand{state, methods, ...}) => let
1099                      fun chkMeth (AST.M_Method(_, body)) = chkStm body
1100                      in
1101    (* FIXME: should skip output variables! *)
1102                        List.app chkVDcl state;
1103                        List.app chkMeth methods
1104                      end
1105                  | AST.D_InitialArray _ => ()
1106                  | AST.D_InitialCollection _ => ()
1107                (* end case *)
1108              end
1109    
1110    (* reorder the declarations so that the input variables come first *)    (* reorder the declarations so that the input variables come first *)
1111      fun reorderDecls dcls = let      fun reorderDecls dcls = let
1112            fun isInput (AST.D_Input _) = true            fun isInput (AST.D_Input _) = true
# Line 1074  Line 1128 
1128            val dcls' = chk ({scope=GlobalScope, bindings=AtomMap.empty, env=env}, tree, [])            val dcls' = chk ({scope=GlobalScope, bindings=AtomMap.empty, env=env}, tree, [])
1129                  handle TypeError => []                  handle TypeError => []
1130            in            in
1131                List.app (checkForUnused cxt) dcls';
1132              AST.Program{              AST.Program{
1133                  props = Env.properties env,                  props = Env.properties env,
1134                  decls = dcls'                  decls = dcls'

Legend:
Removed from v.2658  
changed lines
  Added in v.2659

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0