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 3421, Fri Nov 13 13:05:06 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 a dimension that is given by a constant expression *)
20        val checkDim : Env.t * Env.context * ParseTree.expr -> IntLit.t option
21    
22      (* type check a tensor shape, where the dimensions are given by constant expressions *)
23        val checkShape : Env.t * Env.context * ParseTree.expr list -> Types.shape
24    
25    (* `resolveOverload (cxt, rator, tys, args, candidates)` resolves the application of    (* `resolveOverload (cxt, rator, tys, args, candidates)` resolves the application of
26     * 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
27     * and `candidates` is the list of candidate definitions.     * and `candidates` is the list of candidate definitions.
# Line 20  Line 29 
29      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
30            -> (AST.expr * Types.ty)            -> (AST.expr * Types.ty)
31    
   (* 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  
   
32    end = struct    end = struct
33    
34      structure PT = ParseTree      structure PT = ParseTree
# Line 45  Line 48 
48      datatype token = datatype TypeError.token      datatype token = datatype TypeError.token
49    
50    (* mark a variable use with its location *)    (* mark a variable use with its location *)
51      fun useVar (cxt, x) = (x, Error.location cxt)      fun useVar (cxt : Env.context, x) = (x, #2 cxt)
52    
53    (* 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
54     * list that matches the argument types.     * list that matches the argument types.
# Line 312  Line 315 
315                                case Unify.matchArgs(domTy, [e1', e2'], [ty1, ty2])                                case Unify.matchArgs(domTy, [e1', e2'], [ty1, ty2])
316                                 of SOME args => (AST.E_Prim(rator, tyArgs, args, rngTy), rngTy)                                 of SOME args => (AST.E_Prim(rator, tyArgs, args, rngTy), rngTy)
317                                  | NONE => err (cxt, [                                  | NONE => err (cxt, [
318                                        S "type error for binary operator '", V rator, S "'\n",                                        S "type error for binary operator ", V rator, S "\n",
319                                        S "  expected:  ", TYS domTy, S "\n",                                        S "  expected:  ", TYS domTy, S "\n",
320                                        S "  but found: ", TYS[ty1, ty2]                                        S "  but found: ", TYS[ty1, ty2]
321                                      ])                                      ])
# Line 331  Line 334 
334                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = TU.instantiate(Var.typeOf rator)                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = TU.instantiate(Var.typeOf rator)
335                          in                          in
336                            case Util.coerceType (domTy, eTy)                            case Util.coerceType (domTy, eTy)
337                             of SOME(e', ty) => (AST.E_Prim(rator, tyArgs, [e'], rngTy), rngTy)                             of SOME e' => (AST.E_Prim(rator, tyArgs, [e'], rngTy), rngTy)
338                              | NONE => err (cxt, [                              | NONE => err (cxt, [
339                                    S "type error for unary operator \"", V rator, S "\"\n",                                    S "type error for unary operator ", V rator, S "\n",
340                                    S "  expected:  ", TY domTy, S "\n",                                    S "  expected:  ", TY domTy, S "\n",
341                                    S "  but found: ", TY (#2 eTy)                                    S "  but found: ", TY (#2 eTy)
342                                  ])                                  ])
# Line 385  Line 388 
388                              in                              in
389                                if Unify.equalType(fldTy, ty1)                                if Unify.equalType(fldTy, ty1)
390                                  then (case Util.coerceType(domTy, (e2', ty2))                                  then (case Util.coerceType(domTy, (e2', ty2))
391                                     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)
392                                      | NONE => tyError()                                      | NONE => tyError()
393                                    (* end case *))                                    (* end case *))
394                                  else tyError()                                  else tyError()
# Line 426  Line 429 
429                                      (AST.E_Select(e', useVar(cxt, x')), ty)                                      (AST.E_Select(e', useVar(cxt, x')), ty)
430                                    end                                    end
431                                | NONE => err(cxt, [                                | NONE => err(cxt, [
432                                      S "strand '", A strand,                                      S "strand ", A strand,
433                                      S "' does not have state variable '", A field, S "'"                                      S " does not have state variable ", A field
434                                    ])                                    ])
435                              (* end case *))                              (* end case *))
436                          | NONE => err(cxt, [S "unknown strand '", A strand, S "'"])                          | NONE => err(cxt, [S "unknown strand ", A strand])
437                        (* end case *))                        (* end case *))
438                    | (_, ty) => err (cxt, [                    | (_, ty) => err (cxt, [
439                          S "expected strand type, but found ", TY ty,                          S "expected strand type, but found ", TY ty,
440                          S " in selection of '", A field, S "'"                          S " in selection of ", A field
441                        ])                        ])
442                  (* end case *))                  (* end case *))
443              | PT.E_Real e => (case check (env, cxt, e)              | PT.E_Real e => (case check (env, cxt, e)
# Line 446  Line 449 
449                        ])                        ])
450                  (* end case *))                  (* end case *))
451              | PT.E_Load nrrd => let              | PT.E_Load nrrd => let
452                  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))
453                  in                  in
454                    case chkStringConstExpr (env, cxt, nrrd)                    case chkStringConstExpr (env, cxt, nrrd)
455                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)
# Line 454  Line 457 
457                    (* end case *)                    (* end case *)
458                  end                  end
459              | PT.E_Image nrrd => let              | PT.E_Image nrrd => let
460                  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))
461                  in                  in
462                    case chkStringConstExpr (env, cxt, nrrd)                    case chkStringConstExpr (env, cxt, nrrd)
463                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)                     of SOME nrrd => (AST.E_LoadNrrd(tyArgs, nrrd, rngTy), rngTy)
# Line 465  Line 468 
468                   of SOME x' => (AST.E_Var(useVar(cxt, x')), Var.monoTypeOf x')                   of SOME x' => (AST.E_Var(useVar(cxt, x')), Var.monoTypeOf x')
469                    | NONE => err(cxt, [S "undeclared variable ", A x])                    | NONE => err(cxt, [S "undeclared variable ", A x])
470                  (* end case *))                  (* end case *))
471              | PT.E_Kernel(kern, dim) => raise Fail "FIXME"              | PT.E_Kernel(kern, dim) => (case E.findVar (env, kern)
472                     of SOME kern' => (case Var.monoTypeOf kern'
473                           of ty as Ty.T_Kernel(Ty.DiffConst k) => let
474                                val k' = Int.fromLarge dim handle Overflow => 1073741823
475                                val e = AST.E_Var(useVar(cxt, kern'))
476                                in
477                                  if (k = k')
478                                    then (e, ty)
479                                    else let
480                                      val ty' = Ty.T_Kernel(Ty.DiffConst k')
481                                      in
482                                        (AST.E_Coerce{srcTy = ty, dstTy = ty', e = e}, ty')
483                                      end
484                                end
485                            | _ => err(cxt, [S "expected kernel, but found ", S(Var.kindToString kern')])
486                          (* end case *))
487                      | NONE => err(cxt, [S "unknown kernel ", A kern])
488                    (* end case *))
489              | PT.E_Lit lit => checkLit lit              | PT.E_Lit lit => checkLit lit
490              | PT.E_Id d => let              | PT.E_Id d => let
491                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
# Line 507  Line 527 
527                        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))
528                        fun chkArgs (arg::args, argTy::tys, args') = (                        fun chkArgs (arg::args, argTy::tys, args') = (
529                              case Util.coerceType(ty, (arg, argTy))                              case Util.coerceType(ty, (arg, argTy))
530                               of SOME(arg', _) => chkArgs (args, tys, arg'::args')                               of SOME arg' => chkArgs (args, tys, arg'::args')
531                                | NONE => (                                | NONE => (
532                                    TypeError.error(cxt, [                                    TypeError.error(cxt, [
533                                        S "arguments of tensor construction must have same type"                                        S "arguments of tensor construction must have same type"
534                                      ]);                                      ]);
535                                    chkArgs (args, tys, bogusExp::args'))                                    chkArgs (args, tys, bogusExp::args'))
536                              (* end case *))                              (* end case *))
537                          | chkArgs ([], [], args') = (AST.E_Tensor(List.rev args', resTy), resTy)                          | chkArgs (_, _, args') = (AST.E_Tensor(List.rev args', resTy), resTy)
538                        in                        in
539                          chkArgs (args, tys, [])                          chkArgs (args, tys, [])
540                        end                        end

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

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