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 3427, Fri Nov 13 17:07:04 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 412  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 as Ty.T_Tensor shape), _) => let
456                            val indices' = List.map (Option.map (#1 o chkIndex)) indices
457                            val order = List.length indices'
458                            val expectedTy = TU.mkTensorTy order
459                            val resultTy = TU.slice(expectedTy, List.map Option.isSome indices')
460                            in
461                              if Unify.equalType(ty, expectedTy)
462                                then (AST.E_Slice(e', indices', resultTy), resultTy)
463                                else err (cxt, [
464                                    S "type error in slice operation\n",
465                                    S "  expected:  ", S(Int.toString order), S "-order tensor\n",
466                                    S "  but found: ", TY ty
467                                  ])
468                            end
469                        | ((_, ty), _) => expectedTensor ty
470                      (* end case *)
471                    end
472              | PT.E_Select(e, field) => (case check(env, cxt, e)              | PT.E_Select(e, field) => (case check(env, cxt, e)
473                   of (e', Ty.T_Named strand) => (case Env.findStrand(env, strand)                   of (e', Ty.T_Named strand) => (case Env.findStrand(env, strand)
474                         of SOME sEnv => (case StrandEnv.findStateVar(sEnv, field)                         of SOME sEnv => (case StrandEnv.findStateVar(sEnv, field)
# Line 468  Line 517 
517                   of SOME x' => (AST.E_Var(useVar(cxt, x')), Var.monoTypeOf x')                   of SOME x' => (AST.E_Var(useVar(cxt, x')), Var.monoTypeOf x')
518                    | NONE => err(cxt, [S "undeclared variable ", A x])                    | NONE => err(cxt, [S "undeclared variable ", A x])
519                  (* end case *))                  (* end case *))
520              | PT.E_Kernel(kern, dim) => raise Fail "FIXME"              | PT.E_Kernel(kern, dim) => (case E.findVar (env, kern)
521                     of SOME kern' => (case Var.monoTypeOf kern'
522                           of ty as Ty.T_Kernel(Ty.DiffConst k) => let
523                                val k' = Int.fromLarge dim handle Overflow => 1073741823
524                                val e = AST.E_Var(useVar(cxt, kern'))
525                                in
526                                  if (k = k')
527                                    then (e, ty)
528                                    else let
529                                      val ty' = Ty.T_Kernel(Ty.DiffConst k')
530                                      in
531                                        (AST.E_Coerce{srcTy = ty, dstTy = ty', e = e}, ty')
532                                      end
533                                end
534                            | _ => err(cxt, [S "expected kernel, but found ", S(Var.kindToString kern')])
535                          (* end case *))
536                      | NONE => err(cxt, [S "unknown kernel ", A kern])
537                    (* end case *))
538              | PT.E_Lit lit => checkLit lit              | PT.E_Lit lit => checkLit lit
539              | PT.E_Id d => let              | PT.E_Id d => let
540                  val (tyArgs, Ty.T_Fun(_, rngTy)) =                  val (tyArgs, Ty.T_Fun(_, rngTy)) =
# Line 494  Line 560 
560                      then (AST.E_Prim(BV.nan, tyArgs, [], rngTy), rngTy)                      then (AST.E_Prim(BV.nan, tyArgs, [], rngTy), rngTy)
561                      else raise Fail "impossible"                      else raise Fail "impossible"
562                  end                  end
563              | PT.E_Sequence exps => raise Fail "FIXME"              | PT.E_Sequence exps => (case checkList (env, cxt, exps)
564    (* FIXME: need kind for concrete types here! *)
565                     of ([], _) => let
566                          val ty = Ty.T_Sequence(Ty.T_Var(MetaVar.newTyVar()), SOME(Ty.DimConst 0))
567                          in
568                            (AST.E_Seq([], ty), ty)
569                          end
570                      | (args, tys) => (case Util.coerceTypes(List.map TU.pruneHead tys)
571                           of SOME ty => if TU.isValueType ty
572                                then let
573                                  fun doExp eTy = valOf(Util.coerceType (ty, eTy))
574                                  val resTy = Ty.T_Sequence(ty, SOME(Ty.DimConst(List.length args)))
575                                  val args = ListPair.map doExp (args, tys)
576                                  in
577                                    (AST.E_Seq(args, resTy), resTy)
578                                  end
579                                else err(cxt, [S "sequence expression of non-value argument type"])
580                            | NONE => err(cxt, [S "arguments of sequence expression must have same type"])
581                          (* end case *))
582                    (* end case *))
583              | PT.E_SeqComp comp => raise Fail "FIXME"              | PT.E_SeqComp comp => raise Fail "FIXME"
584              | PT.E_Cons args => let              | PT.E_Cons args => let
585                (* Note that we are guaranteed that args is non-empty *)                (* Note that we are guaranteed that args is non-empty *)
# Line 547  Line 632 
632                  ])                  ])
633            (* end case *))            (* end case *))
634    
635        and chkComprehension (env, cxt, PT.COMP_Mark m) =
636              chkComprehension(E.withEnvAndContext(env, cxt, m))
637          | chkComprehension (env, cxt, PT.COMP_Comprehension(e, [iter])) = let
638              val (iter', env') = checkIter (E.blockScope env, cxt, iter)
639              val (e', ty) = check (env', cxt, e)
640              val resTy = Ty.T_Sequence(ty, NONE)
641              in
642                (AST.E_Comprehension(e', iter', resTy), resTy)
643              end
644          | chkComprehension _ = raise Fail "impossible"
645    
646        and checkIter (env, cxt, PT.I_Mark m) = checkIter (E.withEnvAndContext (env, cxt, m))
647          | checkIter (env, cxt, PT.I_Iterator({span, tree=x}, e)) = (
648              case check (env, cxt, e)
649               of (e', ty as Ty.T_Sequence(elemTy, _)) => let
650                    val x' = Var.new(x, Error.location(#1 cxt, span), Var.LocalVar, elemTy)
651                    in
652                      ((x', e'), E.insertLocal(env, cxt, x, x'))
653                    end
654                | (e', ty) => let
655                    val x' = Var.new(x, Error.UNKNOWN, Var.IterVar, Ty.T_Error)
656                    in
657                      TypeError.error (cxt, [
658                          S "expected sequence type in iteration, but found '", TY ty, S "'"
659                        ]);
660                      ((x', bogusExp), E.insertLocal(env, cxt, x, x'))
661                    end
662              (* end case *))
663          | checkIter (env, cxt, PT.I_Deprecate(msg, iter)) = (
664              warn (cxt, [S msg]);
665              checkIter (env, cxt, iter))
666    
667    (* 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
668     * of the types of the expressions.     * of the types of the expressions.
669     *)     *)

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

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