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

SCM Repository

[diderot] Diff of /trunk/src/compiler/typechecker/typechecker.sml
ViewVC logotype

Diff of /trunk/src/compiler/typechecker/typechecker.sml

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

revision 173, Sat Jul 24 15:37:50 2010 UTC revision 475, Thu Nov 4 18:57:11 2010 UTC
# Line 1  Line 1 
1  (* typechecker.sml  (* typechecker.sml
2   *   *
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5     *
6   *)   *)
7    
8  structure Typechecker : sig  structure Typechecker : sig
# Line 17  Line 18 
18      structure TU = TypeUtil      structure TU = TypeUtil
19      structure U = Util      structure U = Util
20    
21      type env = {globalScope : bool, env : Env.env}      datatype scope = GlobalScope | ActorScope | MethodScope | InitScope
22    
23        type env = {scope : scope, env : Env.env}
24    
25        fun actorScope {scope, env} = {scope=ActorScope, env=env}
26        fun methodScope {scope, env} = {scope=MethodScope, env=env}
27        fun initScope {scope, env} = {scope=InitScope, env=env}
28    
29        fun inActor {scope=ActorScope, env} = true
30          | inActor {scope=MethodScope, ...} = true
31          | inActor _ = false
32    
33        fun insertLocal ({scope, env}, x, x') = {scope=scope, env=Env.insertLocal(env, x, x')}
34        fun insertGlobal ({scope, env}, x, x') = {scope=scope, env=Env.insertGlobal(env, x, x')}
35    
36      exception Error      exception Error
37    
# Line 136  Line 150 
150                  in                  in
151                    case (ty1, ty2)                    case (ty1, ty2)
152                     of (Ty.T_Bool, Ty.T_Bool) =>                     of (Ty.T_Bool, Ty.T_Bool) =>
153                          (AST.E_Cond(e1', AST.E_Lit(Literal.Bool true), e2'), Ty.T_Bool)                          (AST.E_Cond(e1', AST.E_Lit(Literal.Bool true), e2', Ty.T_Bool), Ty.T_Bool)
154                      | _ => err (cxt, [S "arguments to \"||\" must have bool type"])                      | _ => err (cxt, [S "arguments to \"||\" must have bool type"])
155                    (* end case *)                    (* end case *)
156                  end                  end
# Line 146  Line 160 
160                  in                  in
161                    case (ty1, ty2)                    case (ty1, ty2)
162                     of (Ty.T_Bool, Ty.T_Bool) =>                     of (Ty.T_Bool, Ty.T_Bool) =>
163                          (AST.E_Cond(e1', e2', AST.E_Lit(Literal.Bool false)), Ty.T_Bool)                          (AST.E_Cond(e1', e2', AST.E_Lit(Literal.Bool false), Ty.T_Bool), Ty.T_Bool)
164                      | _ => err (cxt, [S "arguments to \"&&\" must have bool type"])                      | _ => err (cxt, [S "arguments to \"&&\" must have bool type"])
165                    (* end case *)                    (* end case *)
166                  end                  end
167                | PT.E_Cond(e1, cond, e2) => let
168                    val (e1', ty1) = checkExpr(env, cxt, e1)
169                    val (e2', ty2) = checkExpr(env, cxt, e2)
170                    in
171                      case checkExpr(env, cxt, cond)
172                       of (cond', Ty.T_Bool) =>
173                            if U.matchType(ty1, ty2)
174                              then (AST.E_Cond(cond', e1', e2', ty1), ty1)
175                              else err (cxt, [
176                                  S "type do not match in conditional expression\n",
177                                  S "  true branch:  ", TY ty1,
178                                  S "  false branch: ", TY ty2
179                                ])
180                        | (_, ty') => err (cxt, [S "expected bool type, but found ", TY ty'])
181                      (* end case *)
182                    end
183              | PT.E_BinOp(e1, rator, e2) => let              | PT.E_BinOp(e1, rator, e2) => let
184                  val (e1', ty1) = checkExpr(env, cxt, e1)                  val (e1', ty1) = checkExpr(env, cxt, e1)
185                  val (e2', ty2) = checkExpr(env, cxt, e2)                  val (e2', ty2) = checkExpr(env, cxt, e2)
# Line 174  Line 204 
204                  in                  in
205                    case Basis.findOp rator                    case Basis.findOp rator
206                     of [rator] => let                     of [rator] => let
207                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = Util.instantiate(Var.typeOf rator)                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = U.instantiate(Var.typeOf rator)
208                          in                          in
209                            if U.matchType(domTy, ty)                            if U.matchType(domTy, ty)
210                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)                              then (AST.E_Apply(rator, tyArgs, [e'], rngTy), rngTy)
# Line 187  Line 217 
217                      | ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)                      | ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)
218                    (* end case *)                    (* end case *)
219                  end                  end
220                | PT.E_Slice(e, indices) => let
221                    val (e', ty) = checkExpr (env, cxt, e)
222                    fun checkIndex NONE = NONE
223                      | checkIndex (SOME e) = let
224                          val (e', ty) = checkExpr (env, cxt, e)
225                          in
226                            if U.matchType(ty, Ty.T_Int)
227                              then (SOME e')
228                              else err (cxt, [
229                                  S "type error in index expression\n",
230                                  S "  expected int, but found: ", TY ty, S "\n"
231                                ])
232                          end
233                    val indices' = List.map checkIndex indices
234                    val order = List.length indices'
235                    val expectedTy = TU.mkTensorTy order
236                    val resultTy = TU.slice(expectedTy, List.map Option.isSome indices')
237                    in
238                      if U.matchType(ty, expectedTy)
239                        then ()
240                        else err (cxt, [
241                            S "type error in slice operation\n",
242                            S "  expected:  ", S(Int.toString order), S "-order tensor\n",
243                            S "  but found: ", TY ty, S "\n"
244                          ]);
245                      (AST.E_Slice(e', indices', resultTy), resultTy)
246                    end
247              | PT.E_Tuple args => let              | PT.E_Tuple args => let
248                  val (args, tys) = checkExprList (env, cxt, args)                  val (args, tys) = checkExprList (env, cxt, args)
249                  in                  in
# Line 197  Line 254 
254                  in                  in
255                    case Env.findFunc (#env env, f)                    case Env.findFunc (#env env, f)
256                     of SOME f =>                     of SOME f =>
257                          if (#globalScope env) orelse not(Basis.isRestricted f)                          if (inActor env) andalso (Basis.isRestricted f)
258                            then (case Util.instantiate(Var.typeOf f)                            then err(cxt, [S "use of restricted operation ", V f, S " in actor body"])
259                              else (case Util.instantiate(Var.typeOf f)
260                               of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>                               of (tyArgs, Ty.T_Fun(domTy, rngTy)) =>
261                                    if U.matchTypes(domTy, tys)                                    if U.matchTypes(domTy, tys)
262                                      then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)                                      then (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)
# Line 209  Line 267 
267                                        ])                                        ])
268                                | _ => err(cxt, [S "application of non-function ", V f])                                | _ => err(cxt, [S "application of non-function ", V f])
269                              (* end case *))                              (* end case *))
                           else err(cxt, [S "use of restricted operation ", V f, S " in actor body"])  
270                      | NONE => err(cxt, [S "unknown function ", A f])                      | NONE => err(cxt, [S "unknown function ", A f])
271                    (* end case *)                    (* end case *)
272                  end                  end
# Line 217  Line 274 
274                  val (args, ty::tys) = checkExprList (env, cxt, args)                  val (args, ty::tys) = checkExprList (env, cxt, args)
275                  in                  in
276                    case TU.pruneHead ty                    case TU.pruneHead ty
277                     of Ty.T_Tensor shape => let                     of ty as Ty.T_Tensor shape => let
278                            val Ty.Shape dd = TU.pruneShape shape (* NOTE: this may fail if we allow user polymorphism *)
279                          fun chkTy ty' = U.matchType(ty, ty')                          fun chkTy ty' = U.matchType(ty, ty')
280                          val resTy = Ty.T_Tensor(Ty.shapeExt(shape, Ty.DimConst(List.length args)))                          val resTy = Ty.T_Tensor(Ty.Shape(Ty.DimConst(List.length args) :: dd))
281                          in                          in
282                            if List.all chkTy tys                            if List.all chkTy tys
283                              then (AST.E_Cons args, resTy)                              then (AST.E_Cons args, resTy)
# Line 269  Line 327 
327                  end                  end
328            (* end case *))            (* end case *))
329    
     fun checkGlobalExpr (env, cxt, exp) = checkExpr ({globalScope=true, env=env}, cxt, exp)  
     fun checkLocalExpr (env, cxt, exp) = checkExpr ({globalScope=false, env=env}, cxt, exp)  
     fun checkLocalExprList (env, cxt, exp) = checkExprList ({globalScope=false, env=env}, cxt, exp)  
   
330    (* typecheck a statement and translate it to AST *)    (* typecheck a statement and translate it to AST *)
331      fun checkStmt (env, cxt, s) = (case s      fun checkStmt (env, cxt, s) = (case s
332             of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))             of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))
# Line 287  Line 341 
341                    (chk (env, stms, []), env)                    (chk (env, stms, []), env)
342                  end                  end
343              | PT.S_Decl vd => let              | PT.S_Decl vd => let
344                  val (x, x', e) = checkVarDecl ({globalScope=false, env=env}, cxt, Var.LocalVar, vd)                  val (x, x', e) = checkVarDecl (methodScope env, cxt, Var.LocalVar, vd)
345                  in                  in
346                    (AST.S_Decl(AST.VD_Decl(x', e)), Env.insertLocal(env, x, x'))                    (AST.S_Decl(AST.VD_Decl(x', e)), insertLocal(env, x, x'))
347                  end                  end
348              | PT.S_IfThen(e, s) => let              | PT.S_IfThen(e, s) => let
349                  val (e', ty) = checkLocalExpr (env, cxt, e)                  val (e', ty) = checkExpr (env, cxt, e)
350                  val (s', _) = checkStmt (env, cxt, s)                  val (s', _) = checkStmt (env, cxt, s)
351                  in                  in
352                  (* check that condition has bool type *)                  (* check that condition has bool type *)
# Line 303  Line 357 
357                    (AST.S_IfThenElse(e', s', AST.S_Block[]), env)                    (AST.S_IfThenElse(e', s', AST.S_Block[]), env)
358                  end                  end
359              | PT.S_IfThenElse(e, s1, s2) => let              | PT.S_IfThenElse(e, s1, s2) => let
360                  val (e', ty) = checkLocalExpr (env, cxt, e)                  val (e', ty) = checkExpr (env, cxt, e)
361                  val (s1', _) = checkStmt (env, cxt, s1)                  val (s1', _) = checkStmt (env, cxt, s1)
362                  val (s2', _) = checkStmt (env, cxt, s2)                  val (s2', _) = checkStmt (env, cxt, s2)
363                  in                  in
# Line 314  Line 368 
368                    (* end case *);                    (* end case *);
369                    (AST.S_IfThenElse(e', s1', s2'), env)                    (AST.S_IfThenElse(e', s1', s2'), env)
370                  end                  end
371              | PT.S_Assign(x, e) => (case Env.findVar (env, x)              | PT.S_Assign(x, e) => (case Env.findVar (#env env, x)
372                   of NONE => err(cxt, [                   of NONE => err(cxt, [
373                          S "undefined variable ", A x                          S "undefined variable ", A x
374                        ])                        ])
375                    | SOME x' => let                    | SOME x' => let
376  (* FIXME: check for polymorphic variables *)  (* FIXME: check for polymorphic variables *)
377                        val ([], ty) = Var.typeOf x'                        val ([], ty) = Var.typeOf x'
378                        val (e', ty') = checkLocalExpr (env, cxt, e)                        val (e', ty') = checkExpr (env, cxt, e)
379                        in                        in
380                          if U.matchType(ty, ty')                          if U.matchType(ty, ty')
381                            then (x, x', e')                            then (x, x', e')
# Line 344  Line 398 
398                        end                        end
399                  (* end case *))                  (* end case *))
400              | PT.S_New(actor, args) => let              | PT.S_New(actor, args) => let
401                  val argsAndTys' = List.map (fn e => checkLocalExpr(env, cxt, e)) args                  val argsAndTys' = List.map (fn e => checkExpr(env, cxt, e)) args
402                  val (args', tys') = ListPair.unzip argsAndTys'                  val (args', tys') = ListPair.unzip argsAndTys'
403                  in                  in
404                      case #scope env
405                       of MethodScope => ()
406                        | InitScope => ()
407                        | _ => err(cxt, [S "invalid scope for new actor"])
408                      (* end case *);
409  (* FIXME: check that actor is defined and has the argument types match *)  (* FIXME: check that actor is defined and has the argument types match *)
410                    (AST.S_New(actor, args'), env)                    (AST.S_New(actor, args'), env)
411                  end                  end
412              | PT.S_Die => (AST.S_Die, env)              | PT.S_Die => (
413              | PT.S_Stabilize => (AST.S_Stabilize, env)                  case #scope env
414                     of MethodScope => ()
415                      | _ => err(cxt, [S "\"die\" statment outside of method"])
416                    (* end case *);
417                    (AST.S_Die, env))
418                | PT.S_Stabilize => (
419                    case #scope env
420                     of MethodScope => ()
421                      | _ => err(cxt, [S "\"stabilize\" statment outside of method"])
422                    (* end case *);
423                    (AST.S_Stabilize, env))
424            (* end case *))            (* end case *))
425    
426      fun checkParams (env, cxt, params) = let      fun checkParams (env, cxt, params) = let
# Line 360  Line 429 
429                    | PT.P_Param(ty, x) => let                    | PT.P_Param(ty, x) => let
430                        val x' = Var.new(x, AST.ActorParam, checkTy (cxt, ty))                        val x' = Var.new(x, AST.ActorParam, checkTy (cxt, ty))
431                        in                        in
432                          (x', Env.insertLocal(env, x, x'))                          (x', insertLocal(env, x, x'))
433                        end                        end
434                  (* end case *))                  (* end case *))
435            fun chk (param, (xs, env)) = let            fun chk (param, (xs, env)) = let
# Line 376  Line 445 
445      fun checkMethod (env, cxt, meth) = (case meth      fun checkMethod (env, cxt, meth) = (case meth
446             of PT.M_Mark m => checkMethod (withEnvAndContext (env, cxt, m))             of PT.M_Mark m => checkMethod (withEnvAndContext (env, cxt, m))
447              | PT.M_Method(name, body) => let              | PT.M_Method(name, body) => let
448                  val (body, _) = checkStmt(env, cxt, body)                  val (body, _) = checkStmt(methodScope env, cxt, body)
449                  in                  in
450                    AST.M_Method(name, body)                    AST.M_Method(name, body)
451                  end                  end
# Line 389  Line 458 
458            val (vds, env) = let            val (vds, env) = let
459                  fun checkStateVar ((isOut, vd), (vds, env)) = let                  fun checkStateVar ((isOut, vd), (vds, env)) = let
460                        val kind = if isOut then AST.ActorOutputVar else AST.ActorStateVar                        val kind = if isOut then AST.ActorOutputVar else AST.ActorStateVar
461                        val (x, x', e') = checkVarDecl ({globalScope=false, env=env}, cxt, kind, vd)                        val (x, x', e') = checkVarDecl (env, cxt, kind, vd)
462                        in                        in
463                          (AST.VD_Decl(x', e')::vds, Env.insertLocal(env, x, x'))                        (* check that output variables have value types *)
464                            if isOut andalso not(TU.isValueType(Var.monoTypeOf x'))
465                              then err(cxt, [
466                                  S "output variable ", V x', S " has non-value type ",
467                                  TY(Var.monoTypeOf x')
468                                ])
469                              else ();
470                            (AST.VD_Decl(x', e')::vds, insertLocal(env, x, x'))
471                        end                        end
472                  val (vds, env) = List.foldl checkStateVar ([], env) state                  val (vds, env) = List.foldl checkStateVar ([], env) state
473                  in                  in
# Line 405  Line 481 
481    
482      fun checkCreate (env, cxt, PT.C_Mark m) = checkCreate (withEnvAndContext (env, cxt, m))      fun checkCreate (env, cxt, PT.C_Mark m) = checkCreate (withEnvAndContext (env, cxt, m))
483        | checkCreate (env, cxt, PT.C_Create(actor, args)) = let        | checkCreate (env, cxt, PT.C_Create(actor, args)) = let
484            val (args, tys) = checkLocalExprList (env, cxt, args)            val (args, tys) = checkExprList (env, cxt, args)
485            in            in
486  (* FIXME: check against actor definition *)  (* FIXME: check against actor definition *)
487              AST.C_Create(actor, args)              AST.C_Create(actor, args)
# Line 413  Line 489 
489    
490      fun checkIter (env, cxt, PT.I_Mark m) = checkIter (withEnvAndContext (env, cxt, m))      fun checkIter (env, cxt, PT.I_Mark m) = checkIter (withEnvAndContext (env, cxt, m))
491        | checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let        | checkIter (env, cxt, PT.I_Range(x, e1, e2)) = let
492            val (e1', ty1) = checkLocalExpr (env, cxt, e1)            val (e1', ty1) = checkExpr (env, cxt, e1)
493            val (e2', ty2) = checkLocalExpr (env, cxt, e2)            val (e2', ty2) = checkExpr (env, cxt, e2)
494            val x' = Var.new(x, Var.LocalVar, Ty.T_Int)            val x' = Var.new(x, Var.LocalVar, Ty.T_Int)
495            val env' = Env.insertLocal(env, x, x')            val env' = insertLocal(env, x, x')
496            in            in
497              case (ty1, ty2)              case (ty1, ty2)
498               of (Ty.T_Int, Ty.T_Int) => (AST.I_Range(x', e1', e2'), env')               of (Ty.T_Int, Ty.T_Int) => (AST.I_Range(x', e1', e2'), env')
# Line 446  Line 522 
522                  val dcl = (case optExp                  val dcl = (case optExp
523                         of NONE => AST.D_Input(x', NONE)                         of NONE => AST.D_Input(x', NONE)
524                          | SOME e => let                          | SOME e => let
525                              val (e', ty') = checkGlobalExpr (env, cxt, e)                              val (e', ty') = checkExpr (env, cxt, e)
526                              in                              in
527                                if U.matchType (ty, ty')                                if U.matchType (ty, ty')
528                                  then AST.D_Input(x', SOME e')                                  then AST.D_Input(x', SOME e')
# Line 458  Line 534 
534                              end                              end
535                        (* end case *))                        (* end case *))
536                  in                  in
537                    (dcl, Env.insertGlobal(env, x, x'))                  (* check that input variables have value types *)
538                      if not(TU.isValueType ty)
539                        then err(cxt, [S "input variable ", V x', S " has non-value type ", TY ty])
540                        else ();
541                      (dcl, insertGlobal(env, x, x'))
542                  end                  end
543              | PT.D_Var vd => let              | PT.D_Var vd => let
544                  val (x, x', e') = checkVarDecl ({globalScope=true, env=env}, cxt, Var.GlobalVar, vd)                  val (x, x', e') = checkVarDecl (env, cxt, Var.GlobalVar, vd)
545                  in                  in
546                    (AST.D_Var(AST.VD_Decl(x', e')), Env.insertGlobal(env, x, x'))                    (AST.D_Var(AST.VD_Decl(x', e')), insertGlobal(env, x, x'))
547                  end                  end
548              | PT.D_Actor arg => (checkActor(env, cxt, arg), env)              | PT.D_Actor arg => (checkActor(actorScope env, cxt, arg), env)
549              | PT.D_InitialArray(create, iterators) => let              | PT.D_InitialArray(create, iterators) => let
550                    val env = initScope env
551                  val (iterators, env') = checkIters (env, cxt, iterators)                  val (iterators, env') = checkIters (env, cxt, iterators)
552                  val create = checkCreate (env', cxt, create)                  val create = checkCreate (env', cxt, create)
553                  in                  in
554                    (AST.D_InitialArray(create, iterators), env)                    (AST.D_InitialArray(create, iterators), env)
555                  end                  end
556              | PT.D_InitialCollection(create, iterators) => let              | PT.D_InitialCollection(create, iterators) => let
557                    val env = initScope env
558                  val (iterators, env') = checkIters (env, cxt, iterators)                  val (iterators, env') = checkIters (env, cxt, iterators)
559                  val create = checkCreate (env', cxt, create)                  val create = checkCreate (env', cxt, create)
560                  in                  in
# Line 489  Line 571 
571                    chk (env, dcls, dcl'::dcls')                    chk (env, dcls, dcl'::dcls')
572                  end                  end
573            in            in
574              chk (Basis.env, tree, [])              chk ({scope=GlobalScope, env=Basis.env}, tree, [])
575            end            end
576    
577    end    end

Legend:
Removed from v.173  
changed lines
  Added in v.475

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