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

SCM Repository

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

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

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

revision 2154, Mon Feb 18 16:54:22 2013 UTC revision 2155, Mon Feb 18 16:54:49 2013 UTC
# Line 4  Line 4 
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * TODO:   * TODO:
7   *      check for unreachable code and prune it (see simplify/simplify.sml)   *      prun unreachable code?? (see simplify/simplify.sml)
8   *      error recovery so that we can detect multiple errors in a single compile   *      error recovery so that we can detect multiple errors in a single compile
  *      check that functions have a return on all paths  
9   *      check that the args of strand creation have the same type and number as the params   *      check that the args of strand creation have the same type and number as the params
10   *)   *)
11    
# Line 29  Line 28 
28    
29      datatype scope      datatype scope
30        = GlobalScope        = GlobalScope
31        | FunctionScope of Ty.ty        | FunctionScope of Ty.ty * Atom.atom
32        | StrandScope        | StrandScope
33        | MethodScope        | MethodScope of StrandUtil.method_name
34        | InitScope        | InitScope
35    
36      type env = {      type env = {
# Line 44  Line 43 
43    
44    (* start a new scope *)    (* start a new scope *)
45  (* QUESTION: do we want to restrict access to globals from a function? *)  (* QUESTION: do we want to restrict access to globals from a function? *)
46      fun functionScope ({scope, bindings, env}, ty) =      fun functionScope ({scope, bindings, env}, ty, f) =
47            {scope=FunctionScope ty, bindings=AtomMap.empty, env=env}            {scope=FunctionScope(ty, f), bindings=AtomMap.empty, env=env}
48      fun strandScope {scope, bindings, env} =      fun strandScope {scope, bindings, env} =
49            {scope=StrandScope, bindings=AtomMap.empty, env=env}            {scope=StrandScope, bindings=AtomMap.empty, env=env}
50      fun methodScope {scope, bindings, env} =      fun methodScope ({scope, bindings, env}, name) =
51            {scope=MethodScope, bindings=AtomMap.empty, env=env}            {scope=MethodScope name, bindings=AtomMap.empty, env=env}
52      fun initScope {scope, bindings, env} =      fun initScope {scope, bindings, env} =
53            {scope=InitScope, bindings=AtomMap.empty, env=env}            {scope=InitScope, bindings=AtomMap.empty, env=env}
54      fun blockScope {scope, bindings, env} =      fun blockScope {scope, bindings, env} =
55            {scope=scope, bindings=AtomMap.empty, env=env}            {scope=scope, bindings=AtomMap.empty, env=env}
56    
57      fun inStrand {scope=StrandScope, bindings, env} = true      fun inStrand {scope=StrandScope, bindings, env} = true
58        | inStrand {scope=MethodScope, ...} = true        | inStrand {scope=MethodScope _, ...} = true
59        | inStrand _ = false        | inStrand _ = false
60    
61      fun insertFunc ({scope, bindings, env}, cxt, f, f') = {      fun insertFunc ({scope, bindings, env}, cxt, f, f') = {
# Line 80  Line 79 
79      fun withEnvAndContext (env, (errStrm, _), {span, tree}) =      fun withEnvAndContext (env, (errStrm, _), {span, tree}) =
80            (env, (errStrm, span), tree)            (env, (errStrm, span), tree)
81    
     fun error ((errStrm, span), msg) = (  
           Error.errorAt(errStrm, span, msg);  
           raise TypeError)  
   
82      datatype token      datatype token
83        = S of string | A of Atom.atom        = S of string | A of Atom.atom
84        | V of AST.var | TY of Types.ty | TYS of Types.ty list        | V of AST.var | TY of Types.ty | TYS of Types.ty list
85    
86        local
87      fun tysToString tys = String.concat[      fun tysToString tys = String.concat[
88              "(", String.concatWith " * " (List.map TU.toString tys), ")"              "(", String.concatWith " * " (List.map TU.toString tys), ")"
89            ]            ]
   
     fun err (cxt, toks) = let  
90            fun tok2str (S s) = s            fun tok2str (S s) = s
91              | tok2str (A a) = concat["'", Atom.toString a, "'"]              | tok2str (A a) = concat["'", Atom.toString a, "'"]
92              | tok2str (V x) = concat["'", Var.nameOf x, "'"]              | tok2str (V x) = concat["'", Var.nameOf x, "'"]
# Line 101  Line 95 
95              | tok2str (TYS[ty]) = TU.toString ty              | tok2str (TYS[ty]) = TU.toString ty
96              | tok2str (TYS tys) = tysToString tys              | tok2str (TYS tys) = tysToString tys
97            in            in
98              error(cxt, List.map tok2str toks)      fun warn ((errStrm, span), toks) = Error.warningAt(errStrm, span, List.map tok2str toks)
99            end      fun err ((errStrm, span), toks) = (
100              Error.errorAt(errStrm, span, List.map tok2str toks);
101    (* FIXME: add error recovery *)
102              raise TypeError)
103        end (* local *)
104    
105      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)
106             of SOME loc => err (cxt, [             of SOME loc => err (cxt, [
# Line 597  Line 595 
595                  end                  end
596            (* end case *))            (* end case *))
597    
598      (* check for unreachable code and non-return statements in the tail position of a function.
599       * Note that unreachable code is typechecked and included in the AST.  It is pruned away
600       * by simplify.
601       *)
602        fun chkCtlFlow (cxt, scope, stm) = let
603              val (inFun, inUpdate, funName) = (case scope
604                     of FunctionScope(_, f) => (true, false, Atom.toString f)
605                      | MethodScope StrandUtil.Update => (false, true, "")
606                      | _ => (false, false, "")
607                    (* end case *))
608            (* checks a statement for correct control flow; it returns false if control may
609             * flow from the statement to the next in a sequence and true if control cannot
610             * flow to the next statement.
611             *)
612              fun chk ((errStrm, _), hasSucc, isJoin, unreachable, PT.S_Mark{span, tree}) =
613                    chk((errStrm, span), hasSucc, isJoin, unreachable, tree)
614                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_Block(stms as _::_)) = let
615                    fun chk' ([], escapes) = escapes
616                      | chk' ([stm], escapes) =
617                          chk(cxt, hasSucc, isJoin, escapes orelse unreachable, stm) orelse escapes
618                      | chk' (stm::stms, escapes) = let
619                          val escapes = chk(cxt, true, false, escapes orelse unreachable, stm) orelse escapes
620                          in
621                            chk'(stms, escapes)
622                          end
623                    in
624                      chk' (stms, false)
625                    end
626                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_IfThen(_, stm)) = (
627                    if inFun andalso (not hasSucc orelse not unreachable)
628                      then err(cxt, [
629                            S "Missing return statement in tail position of function ", S funName
630                        ])
631                      else ();
632                    ignore (chk (cxt, hasSucc, true, unreachable, stm));
633                    false)
634                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_IfThenElse(_, stm1, stm2)) = let
635                    val escapes = chk (cxt, hasSucc, true, unreachable, stm1)
636                    val escapes = chk (cxt, hasSucc, true, unreachable, stm2) andalso escapes
637                    in
638                      if escapes andalso hasSucc andalso not unreachable
639                        then (
640                          warn(cxt, [S "unreachable statements after \"if-then-else\" statement"]);
641                          true)
642                        else escapes
643                    end
644                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_Die) = (
645                    if not inUpdate
646                      then err(cxt, [S "\"die\" statment outside of update method"])
647                    else if hasSucc andalso not isJoin andalso not unreachable
648                      then warn(cxt, [S "statements following \"die\" statment are unreachable"])
649                      else ();
650                    true)
651                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_Stabilize) = (
652                    if not inUpdate
653                      then err(cxt, [S "\"stabilize\" statment outside of update method"])
654                    else if hasSucc andalso not isJoin andalso not unreachable
655                      then warn(cxt, [S "statements following \"stabilize\" statment are unreachable"])
656                      else ();
657                    true)
658                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_Return _) = (
659                    if not inFun
660                      then err(cxt, [S "\"return\" statment outside of function body"])
661                    else if hasSucc andalso not isJoin andalso not unreachable
662                      then warn(cxt, [S "statements following \"return\" statment are unreachable"])
663                      else ();
664                    true)
665                | chk (cxt, hasSucc, isJoin, unreachable, _) = (
666                    if inFun andalso not hasSucc andalso not unreachable
667                      then err(cxt, [
668                            S "Missing return statement in tail position of function ", S funName
669                        ])
670                      else ();
671                    false)
672              in
673                ignore (chk (cxt, false, false, false, stm))
674              end
675    
676    (* typecheck a statement and translate it to AST *)    (* typecheck a statement and translate it to AST *)
677      fun checkStmt (env, cxt, s) = (case s      fun checkStmt (env : env, cxt : context, stm) = let
678             of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))            fun chkStmt (env : env, cxt : context, s) = (case s
679                     of PT.S_Mark m => chkStmt (withEnvAndContext (env, cxt, m))
680              | PT.S_Block stms => let              | PT.S_Block stms => let
681                  fun chk (_, [], stms) = AST.S_Block(List.rev stms)                  fun chk (_, [], stms) = AST.S_Block(List.rev stms)
682                    | chk (env, s::ss, stms) = let                    | chk (env, s::ss, stms) = let
683                        val (s', env') = checkStmt (env, cxt, s)                              val (s', env') = chkStmt (env, cxt, s)
684                        in                        in
685                          chk (env', ss, s'::stms)                          chk (env', ss, s'::stms)
686                        end                        end
# Line 618  Line 695 
695                  end                  end
696              | PT.S_IfThen(e, s) => let              | PT.S_IfThen(e, s) => let
697                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = checkExpr (env, cxt, e)
698                  val (s', _) = checkStmt (env, cxt, s)                        val (s', _) = chkStmt (env, cxt, s)
699                  in                  in
700                  (* check that condition has bool type *)                  (* check that condition has bool type *)
701                    case ty                    case ty
# Line 629  Line 706 
706                  end                  end
707              | PT.S_IfThenElse(e, s1, s2) => let              | PT.S_IfThenElse(e, s1, s2) => let
708                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = checkExpr (env, cxt, e)
709                  val (s1', _) = checkStmt (env, cxt, s1)                        val (s1', _) = chkStmt (env, cxt, s1)
710                  val (s2', _) = checkStmt (env, cxt, s2)                        val (s2', _) = chkStmt (env, cxt, s2)
711                  in                  in
712                  (* check that condition has bool type *)                  (* check that condition has bool type *)
713                    case ty                    case ty
# Line 687  Line 764 
764                  val (args', tys') = ListPair.unzip argsAndTys'                  val (args', tys') = ListPair.unzip argsAndTys'
765                  in                  in
766                    case #scope env                    case #scope env
767                     of MethodScope => ()                           of MethodScope StrandUtil.Update => ()
768                      | InitScope => ()                      | InitScope => ()
769                      | _ => err(cxt, [S "invalid scope for new strand"])                      | _ => err(cxt, [S "invalid scope for new strand"])
770                    (* end case *);                    (* end case *);
771  (* FIXME: check that strand is defined and has the argument types match *)  (* FIXME: check that strand is defined and has the argument types match *)
772                    (AST.S_New(strand, args'), env)                    (AST.S_New(strand, args'), env)
773                  end                  end
774              | PT.S_Die => (                    | PT.S_Die => (AST.S_Die, env) (* note that scope has already been checked *)
775                  case #scope env                    | PT.S_Stabilize =>(AST.S_Stabilize, env) (* note that scope has already been checked *)
                  of MethodScope => ()  
                   | _ => err(cxt, [S "\"die\" statment outside of method"])  
                 (* end case *);  
                 (AST.S_Die, env))  
             | PT.S_Stabilize => (  
                 case #scope env  
                  of MethodScope => ()  
                   | _ => err(cxt, [S "\"stabilize\" statment outside of method"])  
                 (* end case *);  
                 (AST.S_Stabilize, env))  
776              | PT.S_Return e => let              | PT.S_Return e => let
777                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = checkExpr (env, cxt, e)
778                  in                  in
779                    case #scope env                    case #scope env
780                     of FunctionScope ty' => (case coerceType(ty', ty, e')                           of FunctionScope(ty', f) => (case coerceType(ty', ty, e')
781                           of SOME e' => (AST.S_Return e', env)                           of SOME e' => (AST.S_Return e', env)
782                            | NONE => err(cxt, [                            | NONE => err(cxt, [
783                                  S "type of return expression does not match function's return type\n",                                        S "type of return expression does not match function ",
784                                          A f, S "'s return type\n",
785                                  S "  expected: ", TY ty', S "\n",                                  S "  expected: ", TY ty', S "\n",
786                                  S "  but found: ", TY ty                                  S "  but found: ", TY ty
787                                ])                                ])
788                          (* end case *))                          (* end case *))
789                      | _ => err(cxt, [S "\"return\" statment outside of function"])                            | _ => (AST.S_Return e', env) (* this error condition has already been checked *)
790                    (* end case *)                    (* end case *)
791                  end                  end
792              | PT.S_Print args => let              | PT.S_Print args => let
# Line 737  Line 805 
805                    (AST.S_Print args', env)                    (AST.S_Print args', env)
806                  end                  end
807            (* end case *))            (* end case *))
808              in
809                chkCtlFlow (cxt, #scope env, stm);
810                chkStmt (env, cxt, stm)
811              end (* checkStmt *)
812    
813      fun checkParams (env, cxt, params) = let      fun checkParams (env, cxt, params) = let
814            fun chkParam (env, cxt, param) = (case param            fun chkParam (env, cxt, param) = (case param
# Line 761  Line 833 
833      fun checkMethod (env, cxt, meth) = (case meth      fun checkMethod (env, cxt, meth) = (case meth
834             of PT.M_Mark m => checkMethod (withEnvAndContext (env, cxt, m))             of PT.M_Mark m => checkMethod (withEnvAndContext (env, cxt, m))
835              | PT.M_Method(name, body) => let              | PT.M_Method(name, body) => let
836                  val (body, _) = checkStmt(methodScope env, cxt, body)                  val (body, _) = checkStmt(methodScope (env, name), cxt, body)
837                  in                  in
838                    AST.M_Method(name, body)                    AST.M_Method(name, body)
839                  end                  end
# Line 902  Line 974 
974                                (* end case *)                                (* end case *)
975                              end                              end
976  (* FIXME: we need to check that there is a return on all control-flow paths *)  (* FIXME: we need to check that there is a return on all control-flow paths *)
977                          | PT.FB_Stmt s => #1(checkStmt(functionScope (env', ty'), cxt, s))                          | PT.FB_Stmt s => #1(checkStmt(functionScope (env', ty', f), cxt, s))
978                        (* end case *))                        (* end case *))
979                  val fnTy = Ty.T_Fun(List.map Var.monoTypeOf params', ty')                  val fnTy = Ty.T_Fun(List.map Var.monoTypeOf params', ty')
980                  val f' = Var.new (f, AST.FunVar, fnTy)                  val f' = Var.new (f, AST.FunVar, fnTy)

Legend:
Removed from v.2154  
changed lines
  Added in v.2155

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