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

SCM Repository

[diderot] Diff of /branches/vis15/src/compiler/typechecker/check-expr.sml
ViewVC logotype

Diff of /branches/vis15/src/compiler/typechecker/check-expr.sml

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

revision 3428, Fri Nov 13 17:47:12 2015 UTC revision 3431, Sat Nov 14 14:03:58 2015 UTC
# Line 55  Line 55 
55    (* mark a variable use with its location *)    (* mark a variable use with its location *)
56      fun useVar (cxt : Env.context, x) = (x, #2 cxt)      fun useVar (cxt : Env.context, x) = (x, #2 cxt)
57    
58      (* strip any marks that enclose an expression and return the span and the expression *)
59        fun stripMark (_, PT.E_Mark{span, tree}) = stripMark(span, tree)
60          | stripMark (span, e) = (span, e)
61    
62    (* resolve overloading: we use a simple scheme that selects the first operator in the    (* resolve overloading: we use a simple scheme that selects the first operator in the
63     * list that matches the argument types.     * list that matches the argument types.
64     *)     *)
# Line 272  Line 276 
276                  val eTy1 = check (env, cxt, e1)                  val eTy1 = check (env, cxt, e1)
277                  val eTy2 = check (env, cxt, e2)                  val eTy2 = check (env, cxt, e2)
278                  in                  in
279                    case check(env, cxt, cond)                    case checkAndPrune(env, cxt, cond)
280                     of (cond', Ty.T_Bool) => (case Util.coerceType2(eTy1, eTy2)                     of (cond', Ty.T_Bool) => (case Util.coerceType2(eTy1, eTy2)
281                           of SOME(e1', e2', ty) => (AST.E_Cond(cond', e1', e2', ty), ty)                           of SOME(e1', e2', ty) => (AST.E_Cond(cond', e1', e2', ty), ty)
282                            | NONE => err (cxt, [                            | NONE => err (cxt, [
# Line 281  Line 285 
285                                S "  false branch: ", TY(#2 eTy2)                                S "  false branch: ", TY(#2 eTy2)
286                              ])                              ])
287                          (* end case *))                          (* end case *))
288                        | (_, Ty.T_Error) => bogusExpTy
289                      | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])                      | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])
290                    (* end case *)                    (* end case *)
291                  end                  end
# Line 352  Line 357 
357                    (* end case *)                    (* end case *)
358                  end                  end
359              | PT.E_Apply(e, args) => let              | PT.E_Apply(e, args) => let
                 fun stripMark (_, PT.E_Mark{span, tree}) = stripMark(span, tree)  
                   | stripMark (span, e) = (span, e)  
360                  val (args, tys) = checkList (env, cxt, args)                  val (args, tys) = checkList (env, cxt, args)
361                  fun appTyError (f, paramTys, argTys) = err(cxt, [                  fun appTyError (f, paramTys, argTys) = err(cxt, [
362                          S "type error in application of ", V f, S "\n",                          S "type error in application of ", V f, S "\n",
# Line 469  Line 472 
472                      | ((_, ty), _) => expectedTensor ty                      | ((_, ty), _) => expectedTensor ty
473                    (* end case *)                    (* end case *)
474                  end                  end
475              | PT.E_Select(e, field) => (case check(env, cxt, e)              | PT.E_Select(e, field) => (case stripMark(#2 cxt, e)
476                   of (e', Ty.T_Named strand) => (case Env.findStrand(env, strand)                   of (_, PT.E_Var x) => (case E.findStrand (env, x)
477                         of SOME sEnv => (case StrandEnv.findStateVar(sEnv, field)                         of SOME _ => if E.inGlobalUpdate env
478                               of SOME x' => let                              then (case E.findSetFn (env, field)
479                                    val ty = Var.monoTypeOf x'                                 of SOME setFn => let
480                                    in                                      val (mvs, ty) = TU.instantiate (Var.typeOf setFn)
481                                      (AST.E_Select(e', useVar(cxt, x')), ty)                                      val resTy = Ty.T_Sequence(Ty.T_Named x, NONE)
482                                        in
483                                          E.recordProp (env, Properties.StrandSets);
484                                          if Unify.equalType(ty, Ty.T_Fun([], resTy))
485                                            then (AST.E_Prim(setFn, mvs, [], resTy), resTy)
486                                            else raise Fail "impossible"
487                                    end                                    end
488                                | NONE => err(cxt, [                                  | _ => err (cxt, [
489                                      S "strand ", A strand,                                        S "unknown strand-set specifier ", A field
                                     S " does not have state variable ", A field  
490                                    ])                                    ])
491                              (* end case *))                              (* end case *))
492                          | NONE => err(cxt, [S "unknown strand ", A strand])                              else err (cxt, [
493                        (* end case *))                                  S "illegal strand set specification in ",
494                    | (e', Ty.T_Error) => bogusExpTy                                  S(E.scopeToString(E.currentScope env))
                   | (_, ty) => err (cxt, [  
                         S "expected strand type, but found ", TY ty,  
                         S " in selection of ", A field  
495                        ])                        ])
496                            | _ => checkSelect (env, cxt, e, field)
497                  (* end case *))                  (* end case *))
498              | PT.E_Real e => (case check (env, cxt, e)                    | _ => checkSelect (env, cxt, e, field)
499                    (* end case *))
500                | PT.E_Real e => (case checkAndPrune (env, cxt, e)
501                   of (e', Ty.T_Int) =>                   of (e', Ty.T_Int) =>
502                        (AST.E_Prim(BV.i2r, [], [e'], Ty.realTy), Ty.realTy)                        (AST.E_Prim(BV.i2r, [], [e'], Ty.realTy), Ty.realTy)
503                    | (e', Ty.T_Error) => bogusExpTy                    | (e', Ty.T_Error) => bogusExpTy
# Line 620  Line 627 
627                  check (env, cxt, e))                  check (env, cxt, e))
628            (* end case *))            (* end case *))
629    
630      (* typecheck and the prune the result *)
631        and checkAndPrune (env, cxt, e) = let
632              val (e, ty) = check (env, cxt, e)
633              in
634                (e, TU.prune ty)
635              end
636    
637    (* check a conditional operator (e.g., || or &&) *)    (* check a conditional operator (e.g., || or &&) *)
638      and checkCondOp (env, cxt, e1, rator, e2, mk) = (      and checkCondOp (env, cxt, e1, rator, e2, mk) = (
639            case (check(env, cxt, e1), check(env, cxt, e2))            case (check(env, cxt, e1), check(env, cxt, e2))
# Line 634  Line 648 
648                  ])                  ])
649            (* end case *))            (* end case *))
650    
651      (* check a field select that is _not_ a strand-set *)
652        and checkSelect (env, cxt, e, field) = (case checkAndPrune (env, cxt, e)
653               of (e', Ty.T_Named strand) => (case Env.findStrand(env, strand)
654                     of SOME sEnv => (case StrandEnv.findStateVar(sEnv, field)
655                           of SOME x' => let
656                                val ty = Var.monoTypeOf x'
657                                in
658                                  (AST.E_Select(e', useVar(cxt, x')), ty)
659                                end
660                            | NONE => err(cxt, [
661                                  S "strand ", A strand,
662                                  S " does not have state variable ", A field
663                                ])
664                          (* end case *))
665                      | NONE => err(cxt, [S "unknown strand ", A strand])
666                    (* end case *))
667                | (_, Ty.T_Error) => bogusExpTy
668                | (_, ty) => err (cxt, [
669                      S "expected strand type, but found ", TY ty,
670                      S " in selection of ", A field
671                    ])
672              (* end case *))
673    
674      and chkComprehension (env, cxt, PT.COMP_Mark m) =      and chkComprehension (env, cxt, PT.COMP_Mark m) =
675            chkComprehension(E.withEnvAndContext(env, cxt, m))            chkComprehension(E.withEnvAndContext(env, cxt, m))
676        | chkComprehension (env, cxt, PT.COMP_Comprehension(e, [iter])) = let        | chkComprehension (env, cxt, PT.COMP_Comprehension(e, [iter])) = let
# Line 647  Line 684 
684    
685      and checkIter (env, cxt, PT.I_Mark m) = checkIter (E.withEnvAndContext (env, cxt, m))      and checkIter (env, cxt, PT.I_Mark m) = checkIter (E.withEnvAndContext (env, cxt, m))
686        | checkIter (env, cxt, PT.I_Iterator({span, tree=x}, e)) = (        | checkIter (env, cxt, PT.I_Iterator({span, tree=x}, e)) = (
687            case check (env, cxt, e)            case checkAndPrune (env, cxt, e)
688             of (e', ty as Ty.T_Sequence(elemTy, _)) => let             of (e', ty as Ty.T_Sequence(elemTy, _)) => let
689                  val x' = Var.new(x, Error.location(#1 cxt, span), Var.LocalVar, elemTy)                  val x' = Var.new(x, Error.location(#1 cxt, span), Var.LocalVar, elemTy)
690                  in                  in
# Line 656  Line 693 
693              | (e', ty) => let              | (e', ty) => let
694                  val x' = Var.new(x, Error.UNKNOWN, Var.IterVar, Ty.T_Error)                  val x' = Var.new(x, Error.UNKNOWN, Var.IterVar, Ty.T_Error)
695                  in                  in
696                    TypeError.error (cxt, [                    if TU.isErrorType ty
697                        then ()
698                        else TypeError.error (cxt, [
699                        S "expected sequence type in iteration, but found '", TY ty, S "'"                        S "expected sequence type in iteration, but found '", TY ty, S "'"
700                      ]);                      ]);
701                    ((x', bogusExp), E.insertLocal(env, cxt, x, x'))                    ((x', bogusExp), E.insertLocal(env, cxt, x, x'))
# Line 668  Line 707 
707     *)     *)
708      and checkList (env, cxt, exprs) = let      and checkList (env, cxt, exprs) = let
709            fun chk (e, (es, tys)) = let            fun chk (e, (es, tys)) = let
710                  val (e, ty) = check (env, cxt, e)                  val (e, ty) = checkAndPrune (env, cxt, e)
711                  in                  in
712                    (e::es, ty::tys)                    (e::es, ty::tys)
713                  end                  end
# Line 679  Line 718 
718    (* check a string that is specified as a constant expression *)    (* check a string that is specified as a constant expression *)
719      and chkStringConstExpr (env, cxt, PT.E_Mark m) =      and chkStringConstExpr (env, cxt, PT.E_Mark m) =
720            chkStringConstExpr (E.withEnvAndContext (env, cxt, m))            chkStringConstExpr (E.withEnvAndContext (env, cxt, m))
721        | chkStringConstExpr (env, cxt, e) = (case check (env, cxt, e)        | chkStringConstExpr (env, cxt, e) = (case checkAndPrune (env, cxt, e)
722             of (e', Ty.T_String) => (case ConstExpr.eval (cxt, e')             of (e', Ty.T_String) => (case ConstExpr.eval (cxt, e')
723                   of SOME(ConstExpr.String s) => SOME s                   of SOME(ConstExpr.String s) => SOME s
724                    | SOME(ConstExpr.Expr e) => raise Fail "FIXME"                    | SOME(ConstExpr.Expr e) => raise Fail "FIXME"
725                    | NONE => NONE                    | NONE => NONE
726                    | _ => raise Fail "impossible: wrong type for constant expr"                    | _ => raise Fail "impossible: wrong type for constant expr"
727                  (* end case *))                  (* end case *))
728                | (_, Ty.T_Error) => NONE
729              | (_, ty) => (              | (_, ty) => (
730                  TypeError.error (cxt, [                  TypeError.error (cxt, [
731                      S "expected constant expression of type 'string', but found '",                      S "expected constant expression of type 'string', but found '",
# Line 695  Line 735 
735            (* end case *))            (* end case *))
736    
737    (* check a dimension that is given by a constant expression *)    (* check a dimension that is given by a constant expression *)
738      and checkDim (env, cxt, dim) = (case check (env, cxt, dim)      and checkDim (env, cxt, dim) = (case checkAndPrune (env, cxt, dim)
739             of (e', Ty.T_Int) => (case ConstExpr.eval (cxt, e')             of (e', Ty.T_Int) => (case ConstExpr.eval (cxt, e')
740                   of SOME(ConstExpr.Int d) => SOME d                   of SOME(ConstExpr.Int d) => SOME d
741                    | SOME(ConstExpr.Expr e) => (                    | SOME(ConstExpr.Expr e) => (
# Line 704  Line 744 
744                    | NONE => NONE                    | NONE => NONE
745                    | _ => raise Fail "impossible: wrong type for constant expr"                    | _ => raise Fail "impossible: wrong type for constant expr"
746                  (* end case *))                  (* end case *))
747                | (_, Ty.T_Error) => NONE
748              | (_, ty) => (              | (_, ty) => (
749                  TypeError.error (cxt, [                  TypeError.error (cxt, [
750                      S "expected constant expression of type 'int', but found '",                      S "expected constant expression of type 'int', but found '",

Legend:
Removed from v.3428  
changed lines
  Added in v.3431

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