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 3407, Wed Nov 11 18:53:18 2015 UTC revision 3424, Fri Nov 13 15:44:42 2015 UTC
# Line 13  Line 13 
13    (* type check an expression *)    (* type check an expression *)
14      val check : Env.t * Env.context * ParseTree.expr -> (AST.expr * Types.ty)      val check : Env.t * Env.context * ParseTree.expr -> (AST.expr * Types.ty)
15    
16      (* type check a list of expressions *)
17        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 *)
25        val checkDim : Env.t * Env.context * ParseTree.expr -> IntLit.t option
26    
27      (* type check a tensor shape, where the dimensions are given by constant expressions *)
28        val checkShape : Env.t * Env.context * ParseTree.expr list -> Types.shape
29    
30    (* `resolveOverload (cxt, rator, tys, args, candidates)` resolves the application of    (* `resolveOverload (cxt, rator, tys, args, candidates)` resolves the application of
31     * the overloaded operator `rator` to `args`, where `tys` are the types of the arguments     * the overloaded operator `rator` to `args`, where `tys` are the types of the arguments
32     * and `candidates` is the list of candidate definitions.     * and `candidates` is the list of candidate definitions.
# Line 20  Line 34 
34      val resolveOverload : Env.context * Atom.atom * Types.ty list * AST.expr list * Var.t list      val resolveOverload : Env.context * Atom.atom * Types.ty list * AST.expr list * Var.t list
35            -> (AST.expr * Types.ty)            -> (AST.expr * Types.ty)
36    
   (* check a dimension that is given by a constant expression *)  
     val checkDim : Env.t * Env.context * ParseTree.expr -> IntLit.t option  
   
   (* check a tensor shape, where the dimensions are given by constant expressions *)  
     val checkShape : Env.t * Env.context * ParseTree.expr list -> Types.shape  
   
37    end = struct    end = struct
38    
39      structure PT = ParseTree      structure PT = ParseTree
# Line 45  Line 53 
53      datatype token = datatype TypeError.token      datatype token = datatype TypeError.token
54    
55    (* mark a variable use with its location *)    (* mark a variable use with its location *)
56      fun useVar (cxt, x) = (x, Error.location cxt)      fun useVar (cxt : Env.context, x) = (x, #2 cxt)
57    
58    (* 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
59     * list that matches the argument types.     * list that matches the argument types.
# Line 312  Line 320 
320                                case Unify.matchArgs(domTy, [e1', e2'], [ty1, ty2])                                case Unify.matchArgs(domTy, [e1', e2'], [ty1, ty2])
321                                 of SOME args => (AST.E_Prim(rator, tyArgs, args, rngTy), rngTy)                                 of SOME args => (AST.E_Prim(rator, tyArgs, args, rngTy), rngTy)
322                                  | NONE => err (cxt, [                                  | NONE => err (cxt, [
323                                        S "type error for binary operator '", V rator, S "'\n",                                        S "type error for binary operator ", V rator, S "\n",
324                                        S "  expected:  ", TYS domTy, S "\n",                                        S "  expected:  ", TYS domTy, S "\n",
325                                        S "  but found: ", TYS[ty1, ty2]                                        S "  but found: ", TYS[ty1, ty2]
326                                      ])                                      ])
# Line 331  Line 339 
339                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = TU.instantiate(Var.typeOf rator)                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = TU.instantiate(Var.typeOf rator)
340                          in                          in
341                            case Util.coerceType (domTy, eTy)                            case Util.coerceType (domTy, eTy)
342                             of SOME(e', ty) => (AST.E_Prim(rator, tyArgs, [e'], rngTy), rngTy)                             of SOME e' => (AST.E_Prim(rator, tyArgs, [e'], rngTy), rngTy)
343                              | NONE => err (cxt, [                              | NONE => err (cxt, [
344                                    S "type error for unary operator \"", V rator, S "\"\n",                                    S "type error for unary operator ", V rator, S "\n",
345                                    S "  expected:  ", TY domTy, S "\n",                                    S "  expected:  ", TY domTy, S "\n",
346                                    S "  but found: ", TY (#2 eTy)                                    S "  but found: ", TY (#2 eTy)
347                                  ])                                  ])
# Line 385  Line 393 
393                              in                              in
394                                if Unify.equalType(fldTy, ty1)                                if Unify.equalType(fldTy, ty1)
395                                  then (case Util.coerceType(domTy, (e2', ty2))                                  then (case Util.coerceType(domTy, (e2', ty2))
396                                     of SOME(e2', _) => (AST.E_Prim(BV.op_probe, tyArgs, [e1', e2'], rngTy), rngTy)                                     of SOME e2' => (AST.E_Prim(BV.op_probe, tyArgs, [e1', e2'], rngTy), rngTy)
397                                      | NONE => tyError()                                      | NONE => tyError()
398                                    (* end case *))                                    (* end case *))
399                                  else tyError()                                  else tyError()
# Line 409  Line 417 
417                      | _ => checkFieldApp (check (env, cxt, e))                      | _ => checkFieldApp (check (env, cxt, e))
418                    (* end case *)                    (* end case *)
419                  end                  end
420              | PT.E_Subscript(e, indices) => (case (check(env, cxt, e), indices)              | PT.E_Subscript(e, indices) => let
421                   of ((e', Ty.T_Sequence(elemTy, _)), [SOME e2]) => raise Fail "FIXME"                  fun expectedTensor ty = err(cxt, [
422                    | ((e', Ty.T_Tensor shape), _) => raise Fail "FIXME"                          S "expected tensor type for slicing, but found ", TY ty
423                    | ((_, ty), _) => err(cxt, [                        ])
424                          S "expected sequence or tensor type for object of subscripting, but found",                  fun chkIndex e = let
425                          TY ty                        val eTy as (_, ty) = check(env, cxt, e)
426                          in
427                            if Unify.equalType(ty, Ty.T_Int)
428                              then eTy
429                              else err (cxt, [
430                                  S "expected type 'int' for index, but found ", TY ty
431                        ])                        ])
432                  (* end case *))                        end
433                    in
434                      case (check(env, cxt, e), indices)
435                       of ((e', Ty.T_Error), _) => (
436                            List.app (ignore o Option.map chkIndex) indices;
437                            bogusExpTy)
438                        | ((e1', ty1 as Ty.T_Sequence(elemTy, optDim)), [SOME e2]) => let
439                            val (e2', ty2) = chkIndex e2
440                            val rator = if isSome optDim
441                                  then BV.subscript
442                                  else BV.dynSubscript
443                            val (tyArgs, Ty.T_Fun(domTy, rngTy)) = TU.instantiate(Var.typeOf rator)
444                            in
445                              if Unify.equalTypes(domTy, [ty1, ty2])
446                                then let
447                                  val exp = AST.E_Prim(rator, tyArgs, [e1', e2'], rngTy)
448                                  in
449                                    (exp, rngTy)
450                                  end
451                                else raise Fail "unexpected unification failure"
452                            end
453                        | ((e', ty as Ty.T_Sequence _), [NONE]) => expectedTensor ty
454                        | ((e', ty as Ty.T_Sequence _), _) => expectedTensor ty
455                        | ((e', Ty.T_Tensor shape), _) => raise Fail "FIXME: tensor slicing"
456                        | ((_, ty), _) => expectedTensor ty
457                      (* end case *)
458                    end
459              | PT.E_Select(e, field) => (case check(env, cxt, e)              | PT.E_Select(e, field) => (case check(env, cxt, e)
460                   of (e', Ty.T_Named strand) => (case Env.findStrand(env, strand)                   of (e', Ty.T_Named strand) => (case Env.findStrand(env, strand)
461                         of SOME sEnv => (case StrandEnv.findStateVar(sEnv, field)                         of SOME sEnv => (case StrandEnv.findStateVar(sEnv, field)
# Line 426  Line 465 
465                                      (AST.E_Select(e', useVar(cxt, x')), ty)                                      (AST.E_Select(e', useVar(cxt, x')), ty)
466                                    end                                    end
467                                | NONE => err(cxt, [                                | NONE => err(cxt, [
468                                      S "strand '", A strand,                                      S "strand ", A strand,
469                                      S "' does not have state variable '", A field, S "'"                                      S " does not have state variable ", A field
470                                    ])                                    ])
471                              (* end case *))                              (* end case *))
472                          | NONE => err(cxt, [S "unknown strand '", A strand, S "'"])                          | NONE => err(cxt, [S "unknown strand ", A strand])
473                        (* end case *))                        (* end case *))
474                    | (_, ty) => err (cxt, [                    | (_, ty) => err (cxt, [
475                          S "expected strand type, but found ", TY ty,                          S "expected strand type, but found ", TY ty,
476                          S " in selection of '", A field, S "'"                          S " in selection of ", A field
477                        ])                        ])
478                  (* end case *))                  (* end case *))
479              | PT.E_Real e => (case check (env, cxt, e)              | PT.E_Real e => (case check (env, cxt, e)
# Line 446  Line 485 
485                        ])                        ])
486                  (* end case *))                  (* end case *))
487              | PT.E_Load nrrd => let              | PT.E_Load nrrd => let
488                  val (tyArgs, Ty.T_Fun(_, rngTy)) = TU.instantiate(Var.typeOf(BV.fn_image))                  val (tyArgs, Ty.T_Fun(_, rngTy)) = TU.instantiate(Var.typeOf(BV.fn_load))
489                  in                  in
490                    case chkStringConstExpr (env, cxt, nrrd)                    case chkStringConstExpr (env, cxt, nrrd)
491                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)
# Line 454  Line 493 
493                    (* end case *)                    (* end case *)
494                  end                  end
495              | PT.E_Image nrrd => let              | PT.E_Image nrrd => let
496                  val (tyArgs, Ty.T_Fun(_, rngTy)) = TU.instantiate(Var.typeOf(BV.fn_load))                  val (tyArgs, Ty.T_Fun(_, rngTy)) = TU.instantiate(Var.typeOf(BV.fn_image))
497                  in                  in
498                    case chkStringConstExpr (env, cxt, nrrd)                    case chkStringConstExpr (env, cxt, nrrd)
499                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)
# Line 465  Line 504 
504                   of SOME x' => (AST.E_Var(useVar(cxt, x')), Var.monoTypeOf x')                   of SOME x' => (AST.E_Var(useVar(cxt, x')), Var.monoTypeOf x')
505                    | NONE => err(cxt, [S "undeclared variable ", A x])                    | NONE => err(cxt, [S "undeclared variable ", A x])
506                  (* end case *))                  (* end case *))
507              | PT.E_Kernel(kern, dim) => raise Fail "FIXME"              | PT.E_Kernel(kern, dim) => (case E.findVar (env, kern)
508                     of SOME kern' => (case Var.monoTypeOf kern'
509                           of ty as Ty.T_Kernel(Ty.DiffConst k) => let
510                                val k' = Int.fromLarge dim handle Overflow => 1073741823
511                                val e = AST.E_Var(useVar(cxt, kern'))
512                                in
513                                  if (k = k')
514                                    then (e, ty)
515                                    else let
516                                      val ty' = Ty.T_Kernel(Ty.DiffConst k')
517                                      in
518                                        (AST.E_Coerce{srcTy = ty, dstTy = ty', e = e}, ty')
519                                      end
520                                end
521                            | _ => err(cxt, [S "expected kernel, but found ", S(Var.kindToString kern')])
522                          (* end case *))
523                      | NONE => err(cxt, [S "unknown kernel ", A kern])
524                    (* end case *))
525              | PT.E_Lit lit => checkLit lit              | PT.E_Lit lit => checkLit lit
526              | PT.E_Id d => let              | PT.E_Id d => let
527                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
# Line 491  Line 547 
547                      then (AST.E_Prim(BV.nan, tyArgs, [], rngTy), rngTy)                      then (AST.E_Prim(BV.nan, tyArgs, [], rngTy), rngTy)
548                      else raise Fail "impossible"                      else raise Fail "impossible"
549                  end                  end
550              | PT.E_Sequence exps => raise Fail "FIXME"              | PT.E_Sequence exps => (case checkList (env, cxt, exps)
551    (* FIXME: need kind for concrete types here! *)
552                     of ([], _) => let
553                          val ty = Ty.T_Sequence(Ty.T_Var(MetaVar.newTyVar()), SOME(Ty.DimConst 0))
554                          in
555                            (AST.E_Seq([], ty), ty)
556                          end
557                      | (args, tys) => (case Util.coerceTypes(List.map TU.pruneHead tys)
558                           of SOME ty => if TU.isValueType ty
559                                then let
560                                  fun doExp eTy = valOf(Util.coerceType (ty, eTy))
561                                  val resTy = Ty.T_Sequence(ty, SOME(Ty.DimConst(List.length args)))
562                                  val args = ListPair.map doExp (args, tys)
563                                  in
564                                    (AST.E_Seq(args, resTy), resTy)
565                                  end
566                                else err(cxt, [S "sequence expression of non-value argument type"])
567                            | NONE => err(cxt, [S "arguments of sequence expression must have same type"])
568                          (* end case *))
569                    (* end case *))
570              | PT.E_SeqComp comp => raise Fail "FIXME"              | PT.E_SeqComp comp => raise Fail "FIXME"
571              | PT.E_Cons args => let              | PT.E_Cons args => let
572                (* Note that we are guaranteed that args is non-empty *)                (* Note that we are guaranteed that args is non-empty *)
# Line 507  Line 582 
582                        val resTy = Ty.T_Tensor(Ty.Shape(Ty.DimConst(List.length args) :: dd))                        val resTy = Ty.T_Tensor(Ty.Shape(Ty.DimConst(List.length args) :: dd))
583                        fun chkArgs (arg::args, argTy::tys, args') = (                        fun chkArgs (arg::args, argTy::tys, args') = (
584                              case Util.coerceType(ty, (arg, argTy))                              case Util.coerceType(ty, (arg, argTy))
585                               of SOME(arg', _) => chkArgs (args, tys, arg'::args')                               of SOME arg' => chkArgs (args, tys, arg'::args')
586                                | NONE => (                                | NONE => (
587                                    TypeError.error(cxt, [                                    TypeError.error(cxt, [
588                                        S "arguments of tensor construction must have same type"                                        S "arguments of tensor construction must have same type"
589                                      ]);                                      ]);
590                                    chkArgs (args, tys, bogusExp::args'))                                    chkArgs (args, tys, bogusExp::args'))
591                              (* end case *))                              (* end case *))
592                          | chkArgs ([], [], args') = (AST.E_Tensor(List.rev args', resTy), resTy)                          | chkArgs (_, _, args') = (AST.E_Tensor(List.rev args', resTy), resTy)
593                        in                        in
594                          chkArgs (args, tys, [])                          chkArgs (args, tys, [])
595                        end                        end
# Line 544  Line 619 
619                  ])                  ])
620            (* end case *))            (* end case *))
621    
622        and chkComprehension (env, cxt, PT.COMP_Mark m) =
623              chkComprehension(E.withEnvAndContext(env, cxt, m))
624          | chkComprehension (env, cxt, PT.COMP_Comprehension(e, [iter])) = let
625              val (iter', env') = checkIter (E.blockScope env, cxt, iter)
626              val (e', ty) = check (env', cxt, e)
627              val resTy = Ty.T_Sequence(ty, NONE)
628              in
629                (AST.E_Comprehension(e', iter', resTy), resTy)
630              end
631          | chkComprehension _ = raise Fail "impossible"
632    
633        and checkIter (env, cxt, PT.I_Mark m) = checkIter (E.withEnvAndContext (env, cxt, m))
634          | checkIter (env, cxt, PT.I_Iterator({span, tree=x}, e)) = (
635              case check (env, cxt, e)
636               of (e', ty as Ty.T_Sequence(elemTy, _)) => let
637                    val x' = Var.new(x, Error.location(#1 cxt, span), Var.LocalVar, elemTy)
638                    in
639                      ((x', e'), E.insertLocal(env, cxt, x, x'))
640                    end
641                | (e', ty) => let
642                    val x' = Var.new(x, Error.UNKNOWN, Var.IterVar, Ty.T_Error)
643                    in
644                      TypeError.error (cxt, [
645                          S "expected sequence type in iteration, but found '", TY ty, S "'"
646                        ]);
647                      ((x', bogusExp), E.insertLocal(env, cxt, x, x'))
648                    end
649              (* end case *))
650    
651    (* 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
652     * of the types of the expressions.     * of the types of the expressions.
653     *)     *)

Legend:
Removed from v.3407  
changed lines
  Added in v.3424

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