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 3418, Fri Nov 13 00:00:26 2015 UTC revision 3467, Sun Nov 29 20:45:59 2015 UTC
# Line 16  Line 16 
16    (* type check a list of expressions *)    (* type check a list of expressions *)
17      val checkList : Env.t * Env.context * ParseTree.expr list -> (AST.expr list * Types.ty list)      val checkList : Env.t * Env.context * ParseTree.expr list -> (AST.expr list * Types.ty list)
18    
19      (* type check an iteration expression (i.e., "x 'in' expr"), returning the iterator
20       * and the environment extended with a binding for x.
21       *)
22        val checkIter : Env.t * Env.context * ParseTree.iterator -> ((AST.var * AST.expr) * Env.t)
23    
24    (* type check a dimension that is given by a constant expression *)    (* type check a dimension that is given by a constant expression *)
25      val checkDim : Env.t * Env.context * ParseTree.expr -> IntLit.t option      val checkDim : Env.t * Env.context * ParseTree.expr -> IntLit.t option
26    
# Line 50  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 86  Line 95 
95            end            end
96    
97    (* check the type of a literal *)    (* check the type of a literal *)
98      fun checkLit lit = (case lit      fun checkLit lit = (AST.E_Lit lit, TypeOf.literal lit)
            of (L.Int _) => (AST.E_Lit lit, Ty.T_Int)  
             | (L.Real _) => (AST.E_Lit lit, Ty.realTy)  
             | (L.String s) => (AST.E_Lit lit, Ty.T_String)  
             | (L.Bool _) => (AST.E_Lit lit, Ty.T_Bool)  
           (* end case *))  
99    
100    (* type check a dot product, which has the constraint:    (* type check a dot product, which has the constraint:
101     *     ALL[sigma1, d1, sigma2] . tensor[sigma1, d1] * tensor[d1, sigma2] -> tensor[sigma1, sigma2]     *     ALL[sigma1, d1, sigma2] . tensor[sigma1, d1] * tensor[d1, sigma2] -> tensor[sigma1, sigma2]
# Line 267  Line 271 
271                  val eTy1 = check (env, cxt, e1)                  val eTy1 = check (env, cxt, e1)
272                  val eTy2 = check (env, cxt, e2)                  val eTy2 = check (env, cxt, e2)
273                  in                  in
274                    case check(env, cxt, cond)                    case checkAndPrune(env, cxt, cond)
275                     of (cond', Ty.T_Bool) => (case Util.coerceType2(eTy1, eTy2)                     of (cond', Ty.T_Bool) => (case Util.coerceType2(eTy1, eTy2)
276                           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)
277                            | NONE => err (cxt, [                            | NONE => err (cxt, [
# Line 276  Line 280 
280                                S "  false branch: ", TY(#2 eTy2)                                S "  false branch: ", TY(#2 eTy2)
281                              ])                              ])
282                          (* end case *))                          (* end case *))
283                        | (_, Ty.T_Error) => bogusExpTy
284                      | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])                      | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])
285                    (* end case *)                    (* end case *)
286                  end                  end
# Line 347  Line 352 
352                    (* end case *)                    (* end case *)
353                  end                  end
354              | 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)  
355                  val (args, tys) = checkList (env, cxt, args)                  val (args, tys) = checkList (env, cxt, args)
356                  fun appTyError (f, paramTys, argTys) = err(cxt, [                  fun appTyError (f, paramTys, argTys) = err(cxt, [
357                          S "type error in application of ", V f, S "\n",                          S "type error in application of ", V f, S "\n",
# Line 412  Line 415 
415                      | _ => checkFieldApp (check (env, cxt, e))                      | _ => checkFieldApp (check (env, cxt, e))
416                    (* end case *)                    (* end case *)
417                  end                  end
418              | PT.E_Subscript(e, indices) => (case (check(env, cxt, e), indices)              | PT.E_Subscript(e, indices) => let
419                   of ((e', Ty.T_Sequence(elemTy, _)), [SOME e2]) => raise Fail "FIXME"                  fun expectedTensor ty = err(cxt, [
420                    | ((e', Ty.T_Tensor shape), _) => raise Fail "FIXME"                          S "expected tensor type for slicing, but found ", TY ty
421                    | ((_, ty), _) => err(cxt, [                        ])
422                          S "expected sequence or tensor type for object of subscripting, but found",                  fun chkIndex e = let
423                          TY ty                        val eTy as (_, ty) = check(env, cxt, e)
424                          in
425                            if Unify.equalType(ty, Ty.T_Int)
426                              then eTy
427                              else err (cxt, [
428                                  S "expected type 'int' for index, but found ", TY ty
429                        ])                        ])
430                  (* end case *))                        end
             | PT.E_Select(e, field) => (case check(env, cxt, e)  
                  of (e', Ty.T_Named strand) => (case Env.findStrand(env, strand)  
                        of SOME sEnv => (case StrandEnv.findStateVar(sEnv, field)  
                              of SOME x' => let  
                                   val ty = Var.monoTypeOf x'  
431                                    in                                    in
432                                      (AST.E_Select(e', useVar(cxt, x')), ty)                    case (check(env, cxt, e), indices)
433                       of ((e', Ty.T_Error), _) => (
434                            List.app (ignore o Option.map chkIndex) indices;
435                            bogusExpTy)
436                        | ((e1', ty1 as Ty.T_Sequence(elemTy, optDim)), [SOME e2]) => let
437                            val (e2', ty2) = chkIndex e2
438                            val rator = if isSome optDim
439                                  then BV.subscript
440                                  else BV.dynSubscript
441                            val (tyArgs, Ty.T_Fun(domTy, rngTy)) = TU.instantiate(Var.typeOf rator)
442                            in
443                              if Unify.equalTypes(domTy, [ty1, ty2])
444                                then let
445                                  val exp = AST.E_Prim(rator, tyArgs, [e1', e2'], rngTy)
446                                  in
447                                    (exp, rngTy)
448                                    end                                    end
449                                | NONE => err(cxt, [                              else raise Fail "unexpected unification failure"
450                                      S "strand ", A strand,                          end
451                                      S " does not have state variable ", A field                      | ((e', ty as Ty.T_Sequence _), [NONE]) => expectedTensor ty
452                        | ((e', ty as Ty.T_Sequence _), _) => expectedTensor ty
453                        | ((e', ty as Ty.T_Tensor shape), _) => let
454                            val indices' = List.map (Option.map (#1 o chkIndex)) indices
455                            val order = List.length indices'
456                            val expectedTy = TU.mkTensorTy order
457                            val resultTy = TU.slice(expectedTy, List.map Option.isSome indices')
458                            in
459                              if Unify.equalType(ty, expectedTy)
460                                then (AST.E_Slice(e', indices', resultTy), resultTy)
461                                else err (cxt, [
462                                    S "type error in slice operation\n",
463                                    S "  expected:  ", S(Int.toString order), S "-order tensor\n",
464                                    S "  but found: ", TY ty
465                                  ])
466                            end
467                        | ((_, ty), _) => expectedTensor ty
468                      (* end case *)
469                    end
470                | PT.E_Select(e, field) => (case stripMark(#2 cxt, e)
471                     of (_, PT.E_Var x) => (case E.findStrand (env, x)
472                           of SOME _ => if E.inGlobalUpdate env
473                                then (case E.findSetFn (env, field)
474                                   of SOME setFn => let
475                                        val (mvs, ty) = TU.instantiate (Var.typeOf setFn)
476                                        val resTy = Ty.T_Sequence(Ty.T_Named x, NONE)
477                                        in
478                                          E.recordProp (env, Properties.StrandSets);
479                                          if Unify.equalType(ty, Ty.T_Fun([], resTy))
480                                            then (AST.E_Prim(setFn, mvs, [], resTy), resTy)
481                                            else raise Fail "impossible"
482                                        end
483                                    | _ => err (cxt, [
484                                          S "unknown strand-set specifier ", A field
485                                    ])                                    ])
486                              (* end case *))                              (* end case *))
487                          | NONE => err(cxt, [S "unknown strand ", A strand])                              else err (cxt, [
488                        (* end case *))                                  S "illegal strand set specification in ",
489                    | (_, ty) => err (cxt, [                                  S(E.scopeToString(E.currentScope env))
                         S "expected strand type, but found ", TY ty,  
                         S " in selection of ", A field  
490                        ])                        ])
491                            | _ => checkSelect (env, cxt, e, field)
492                  (* end case *))                  (* end case *))
493              | PT.E_Real e => (case check (env, cxt, e)                    | _ => checkSelect (env, cxt, e, field)
494                    (* end case *))
495                | PT.E_Real e => (case checkAndPrune (env, cxt, e)
496                   of (e', Ty.T_Int) =>                   of (e', Ty.T_Int) =>
497                        (AST.E_Prim(BV.i2r, [], [e'], Ty.realTy), Ty.realTy)                        (AST.E_Prim(BV.i2r, [], [e'], Ty.realTy), Ty.realTy)
498                      | (e', Ty.T_Error) => bogusExpTy
499                    | (_, ty) => err(cxt, [                    | (_, ty) => err(cxt, [
500                          S "argument of 'real' must have type 'int', but found ",                          S "argument of 'real' must have type 'int', but found ",
501                          TY ty                          TY ty
# Line 468  Line 521 
521                   of SOME x' => (AST.E_Var(useVar(cxt, x')), Var.monoTypeOf x')                   of SOME x' => (AST.E_Var(useVar(cxt, x')), Var.monoTypeOf x')
522                    | NONE => err(cxt, [S "undeclared variable ", A x])                    | NONE => err(cxt, [S "undeclared variable ", A x])
523                  (* end case *))                  (* end case *))
524              | PT.E_Kernel(kern, dim) => raise Fail "FIXME"              | PT.E_Kernel(kern, dim) => (case E.findVar (env, kern)
525                     of SOME kern' => (case Var.monoTypeOf kern'
526                           of ty as Ty.T_Kernel(Ty.DiffConst k) => let
527                                val k' = Int.fromLarge dim handle Overflow => 1073741823
528                                val e = AST.E_Var(useVar(cxt, kern'))
529                                in
530                                  if (k = k')
531                                    then (e, ty)
532                                    else let
533                                      val ty' = Ty.T_Kernel(Ty.DiffConst k')
534                                      in
535                                        (AST.E_Coerce{srcTy = ty, dstTy = ty', e = e}, ty')
536                                      end
537                                end
538                            | _ => err(cxt, [S "expected kernel, but found ", S(Var.kindToString kern')])
539                          (* end case *))
540                      | NONE => err(cxt, [S "unknown kernel ", A kern])
541                    (* end case *))
542              | PT.E_Lit lit => checkLit lit              | PT.E_Lit lit => checkLit lit
543              | PT.E_Id d => let              | PT.E_Id d => let
544                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
# Line 494  Line 564 
564                      then (AST.E_Prim(BV.nan, tyArgs, [], rngTy), rngTy)                      then (AST.E_Prim(BV.nan, tyArgs, [], rngTy), rngTy)
565                      else raise Fail "impossible"                      else raise Fail "impossible"
566                  end                  end
567              | PT.E_Sequence exps => raise Fail "FIXME"              | PT.E_Sequence exps => (case checkList (env, cxt, exps)
568              | PT.E_SeqComp comp => raise Fail "FIXME"  (* FIXME: need kind for concrete types here! *)
569                     of ([], _) => let
570                          val ty = Ty.T_Sequence(Ty.T_Var(MetaVar.newTyVar()), SOME(Ty.DimConst 0))
571                          in
572                            (AST.E_Seq([], ty), ty)
573                          end
574                      | (args, tys) => (case Util.coerceTypes(List.map TU.pruneHead tys)
575                           of SOME ty => if TU.isValueType ty
576                                then let
577                                  fun doExp eTy = valOf(Util.coerceType (ty, eTy))
578                                  val resTy = Ty.T_Sequence(ty, SOME(Ty.DimConst(List.length args)))
579                                  val args = ListPair.map doExp (args, tys)
580                                  in
581                                    (AST.E_Seq(args, resTy), resTy)
582                                  end
583                                else err(cxt, [S "sequence expression of non-value argument type"])
584                            | NONE => err(cxt, [S "arguments of sequence expression must have same type"])
585                          (* end case *))
586                    (* end case *))
587                | PT.E_SeqComp comp => chkComprehension (env, cxt, comp)
588              | PT.E_Cons args => let              | PT.E_Cons args => let
589                (* Note that we are guaranteed that args is non-empty *)                (* Note that we are guaranteed that args is non-empty *)
590                  val (args, tys) = checkList (env, cxt, args)                  val (args, tys) = checkList (env, cxt, args)
# Line 533  Line 622 
622                  check (env, cxt, e))                  check (env, cxt, e))
623            (* end case *))            (* end case *))
624    
625      (* typecheck and the prune the result *)
626        and checkAndPrune (env, cxt, e) = let
627              val (e, ty) = check (env, cxt, e)
628              in
629                (e, TU.prune ty)
630              end
631    
632    (* check a conditional operator (e.g., || or &&) *)    (* check a conditional operator (e.g., || or &&) *)
633      and checkCondOp (env, cxt, e1, rator, e2, mk) = (      and checkCondOp (env, cxt, e1, rator, e2, mk) = (
634            case (check(env, cxt, e1), check(env, cxt, e2))            case (check(env, cxt, e1), check(env, cxt, e2))
# Line 547  Line 643 
643                  ])                  ])
644            (* end case *))            (* end case *))
645    
646      (* check a field select that is _not_ a strand-set *)
647        and checkSelect (env, cxt, e, field) = (case checkAndPrune (env, cxt, e)
648               of (e', Ty.T_Named strand) => (case Env.findStrand(env, strand)
649                     of SOME sEnv => (case StrandEnv.findStateVar(sEnv, field)
650                           of SOME x' => let
651                                val ty = Var.monoTypeOf x'
652                                in
653                                  (AST.E_Select(e', useVar(cxt, x')), ty)
654                                end
655                            | NONE => err(cxt, [
656                                  S "strand ", A strand,
657                                  S " does not have state variable ", A field
658                                ])
659                          (* end case *))
660                      | NONE => err(cxt, [S "unknown strand ", A strand])
661                    (* end case *))
662                | (_, Ty.T_Error) => bogusExpTy
663                | (_, ty) => err (cxt, [
664                      S "expected strand type, but found ", TY ty,
665                      S " in selection of ", A field
666                    ])
667              (* end case *))
668    
669        and chkComprehension (env, cxt, PT.COMP_Mark m) =
670              chkComprehension(E.withEnvAndContext(env, cxt, m))
671          | chkComprehension (env, cxt, PT.COMP_Comprehension(e, [iter])) = let
672              val (iter', env') = checkIter (E.blockScope env, cxt, iter)
673              val (e', ty) = check (env', cxt, e)
674              val resTy = Ty.T_Sequence(ty, NONE)
675              in
676                case iter'
677                 of (x, AST.E_Prim(f, _, [], _)) =>
678                      if Basis.isStrandSet f
679                      andalso not(Env.inGlobalInit env orelse Env.inGlobalUpdate env)
680                        then err (cxt, [
681                            S "use of strand set ", V f,
682                            S " outside of global initialization or update"
683                          ])
684                        else (AST.E_ParallelMap(e', x, f, resTy), resTy)
685                  | _ => (AST.E_Comprehension(e', iter', resTy), resTy)
686                (* end case *)
687              end
688          | chkComprehension _ = raise Fail "impossible"
689    
690        and checkIter (env, cxt, PT.I_Mark m) = checkIter (E.withEnvAndContext (env, cxt, m))
691          | checkIter (env, cxt, PT.I_Iterator({span, tree=x}, e)) = (
692              case checkAndPrune (env, cxt, e)
693               of (e', ty as Ty.T_Sequence(elemTy, _)) => let
694                    val x' = Var.new(x, Error.location(#1 cxt, span), Var.LocalVar, elemTy)
695                    in
696                      ((x', e'), E.insertLocal(env, cxt, x, x'))
697                    end
698                | (e', ty) => let
699                    val x' = Var.new(x, Error.UNKNOWN, Var.IterVar, Ty.T_Error)
700                    in
701                      if TU.isErrorType ty
702                        then ()
703                        else TypeError.error (cxt, [
704                            S "expected sequence type in iteration, but found '", TY ty, S "'"
705                          ]);
706                      ((x', bogusExp), E.insertLocal(env, cxt, x, x'))
707                    end
708              (* end case *))
709    
710    (* typecheck a list of expressions returning a list of AST expressions and a list    (* typecheck a list of expressions returning a list of AST expressions and a list
711     * of the types of the expressions.     * of the types of the expressions.
712     *)     *)
713      and checkList (env, cxt, exprs) = let      and checkList (env, cxt, exprs) = let
714            fun chk (e, (es, tys)) = let            fun chk (e, (es, tys)) = let
715                  val (e, ty) = check (env, cxt, e)                  val (e, ty) = checkAndPrune (env, cxt, e)
716                  in                  in
717                    (e::es, ty::tys)                    (e::es, ty::tys)
718                  end                  end
# Line 563  Line 723 
723    (* check a string that is specified as a constant expression *)    (* check a string that is specified as a constant expression *)
724      and chkStringConstExpr (env, cxt, PT.E_Mark m) =      and chkStringConstExpr (env, cxt, PT.E_Mark m) =
725            chkStringConstExpr (E.withEnvAndContext (env, cxt, m))            chkStringConstExpr (E.withEnvAndContext (env, cxt, m))
726        | chkStringConstExpr (env, cxt, e) = (case check (env, cxt, e)        | chkStringConstExpr (env, cxt, e) = (case checkAndPrune (env, cxt, e)
727             of (e', Ty.T_String) => (case ConstExpr.eval (cxt, e')             of (e', Ty.T_String) => (case CheckConst.eval (cxt, false, e')
728                   of SOME(ConstExpr.String s) => SOME s                   of SOME(ConstExpr.String s) => SOME s
729                    | SOME(ConstExpr.Expr e) => raise Fail "FIXME"                    | SOME(ConstExpr.Expr e) => raise Fail "FIXME"
730                    | NONE => NONE                    | NONE => NONE
731                    | _ => raise Fail "impossible: wrong type for constant expr"                    | _ => raise Fail "impossible: wrong type for constant expr"
732                  (* end case *))                  (* end case *))
733                | (_, Ty.T_Error) => NONE
734              | (_, ty) => (              | (_, ty) => (
735                  TypeError.error (cxt, [                  TypeError.error (cxt, [
736                      S "expected constant expression of type 'string', but found '",                      S "expected constant expression of type 'string', but found '",
# Line 579  Line 740 
740            (* end case *))            (* end case *))
741    
742    (* check a dimension that is given by a constant expression *)    (* check a dimension that is given by a constant expression *)
743      and checkDim (env, cxt, dim) = (case check (env, cxt, dim)      and checkDim (env, cxt, dim) = (case checkAndPrune (env, cxt, dim)
744             of (e', Ty.T_Int) => (case ConstExpr.eval (cxt, e')             of (e', Ty.T_Int) => (case CheckConst.eval (cxt, false, e')
745                   of SOME(ConstExpr.Int d) => SOME d                   of SOME(ConstExpr.Int d) => SOME d
746                    | SOME(ConstExpr.Expr e) => (                    | SOME(ConstExpr.Expr e) => (
747                        TypeError.error (cxt, [S "unable to evaluate constant dimension expression"]);                        TypeError.error (cxt, [S "unable to evaluate constant dimension expression"]);
# Line 588  Line 749 
749                    | NONE => NONE                    | NONE => NONE
750                    | _ => raise Fail "impossible: wrong type for constant expr"                    | _ => raise Fail "impossible: wrong type for constant expr"
751                  (* end case *))                  (* end case *))
752                | (_, Ty.T_Error) => NONE
753              | (_, ty) => (              | (_, ty) => (
754                  TypeError.error (cxt, [                  TypeError.error (cxt, [
755                      S "expected constant expression of type 'int', but found '",                      S "expected constant expression of type 'int', but found '",

Legend:
Removed from v.3418  
changed lines
  Added in v.3467

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