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

SCM Repository

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

Diff of /branches/lamont/src/compiler/typechecker/typechecker.sml

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

revision 2297, Fri Mar 15 22:05:31 2013 UTC revision 2298, Fri Mar 15 22:18:22 2013 UTC
# Line 1  Line 1 
1  (* typechecker.sml  (* typechecker.sml
2   *   *
3   * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)   * COPYRIGHT (c) 2013 The Diderot Project (http://diderot-language.cs.uchicago.edu)
4   * All rights reserved.   * All rights reserved.
5   *   *
6   * TODO:   * TODO:
7   *      check that variables are not redefined in the same scope   *      prune unreachable code?? (see simplify/simplify.sml)
8   *      int --> real type promotion   *      error recovery so that we can detect multiple errors in a single compile
9   *      sequence operations   *      check that the args of strand creation have the same type and number as the params
10   *)   *)
11    
12  structure Typechecker : sig  structure Typechecker : sig
13    
     exception Error  
   
14      val check : Error.err_stream -> ParseTree.program -> AST.program      val check : Error.err_stream -> ParseTree.program -> AST.program
15    
16    end = struct    end = struct
# Line 23  Line 21 
21      structure TU = TypeUtil      structure TU = TypeUtil
22      structure U = Util      structure U = Util
23    
24      datatype scope = GlobalScope | StrandScope | MethodScope | InitScope    (* exception to abort typechecking when we hit an error.  Eventually, we should continue
25       * checking for more errors and not use this.
26       *)
27        exception TypeError
28    
29        datatype scope
30          = GlobalScope
31          | FunctionScope of Ty.ty * Atom.atom
32          | StrandScope
33          | MethodScope of StrandUtil.method_name
34          | InitScope
35    
36        fun scopeToString GlobalScope = "global scope"
37          | scopeToString (FunctionScope(_, f)) = "function " ^ Atom.toString f
38          | scopeToString StrandScope = "strand initialization"
39          | scopeToString (MethodScope m) = "method " ^ StrandUtil.nameToString m
40          | scopeToString InitScope = "initialization"
41    
42      type env = {      type env = {
43          scope : scope,          scope : scope,
# Line 34  Line 48 
48      type context = Error.err_stream * Error.span      type context = Error.err_stream * Error.span
49    
50    (* start a new scope *)    (* start a new scope *)
51        fun functionScope ({scope, bindings, env}, ty, f) =
52              {scope=FunctionScope(ty, f), bindings=AtomMap.empty, env=env}
53      fun strandScope {scope, bindings, env} =      fun strandScope {scope, bindings, env} =
54            {scope=StrandScope, bindings=AtomMap.empty, env=env}            {scope=StrandScope, bindings=AtomMap.empty, env=env}
55      fun methodScope {scope, bindings, env} =      fun methodScope ({scope, bindings, env}, name) =
56            {scope=MethodScope, bindings=AtomMap.empty, env=env}            {scope=MethodScope name, bindings=AtomMap.empty, env=env}
     fun globalScope {scope, bindings, env} =  
           {scope=GlobalScope, bindings=AtomMap.empty, env=env}  
57      fun initScope {scope, bindings, env} =      fun initScope {scope, bindings, env} =
58            {scope=InitScope, bindings=AtomMap.empty, env=env}            {scope=InitScope, bindings=AtomMap.empty, env=env}
59      fun blockScope {scope, bindings, env} =      fun blockScope {scope, bindings, env} =
60            {scope=scope, bindings=AtomMap.empty, env=env}            {scope=scope, bindings=AtomMap.empty, env=env}
61    
62      fun inStrand {scope=StrandScope, bindings, env} = true      fun inStrand {scope=StrandScope, bindings, env} = true
63        | inStrand {scope=MethodScope, ...} = true        | inStrand {scope=MethodScope _, ...} = true
64        | inStrand _ = false        | inStrand _ = false
65    
66        fun insertStrand ({scope, bindings, env}, cxt, s as AST.Strand{name, ...}) = {
67                scope=scope,
68                bindings = AtomMap.insert(bindings, name, Error.location cxt),
69                env=Env.insertStrand(env, s)
70              }
71        fun insertFunc ({scope, bindings, env}, cxt, f, f') = {
72                scope=scope,
73                bindings = AtomMap.insert(bindings, f, Error.location cxt),
74                env=Env.insertFunc(env, f, Env.UserFun f')
75              }
76      fun insertLocal ({scope, bindings, env}, cxt, x, x') = {      fun insertLocal ({scope, bindings, env}, cxt, x, x') = {
77              scope=scope,              scope=scope,
78              bindings = AtomMap.insert(bindings, x, Error.location cxt),              bindings = AtomMap.insert(bindings, x, Error.location cxt),
# Line 60  Line 84 
84              env=Env.insertGlobal(env, x, x')              env=Env.insertGlobal(env, x, x')
85            }            }
86    
     exception Error  
   
87      fun withContext ((errStrm, _), {span, tree}) =      fun withContext ((errStrm, _), {span, tree}) =
88            ((errStrm, span), tree)            ((errStrm, span), tree)
89      fun withEnvAndContext (env, (errStrm, _), {span, tree}) =      fun withEnvAndContext (env, (errStrm, _), {span, tree}) =
90            (env, (errStrm, span), tree)            (env, (errStrm, span), tree)
91    
     fun error ((errStrm, span), msg) = (  
           Error.errorAt(errStrm, span, msg);  
           raise Error)  
   
92      datatype token      datatype token
93        = S of string | A of Atom.atom        = S of string | A of Atom.atom
94        | V of AST.var | TY of Types.ty | TYS of Types.ty list        | V of AST.var | TY of Types.ty | TYS of Types.ty list
95    
96        local
97      fun tysToString tys = String.concat[      fun tysToString tys = String.concat[
98              "(", String.concatWith " * " (List.map TU.toString tys), ")"              "(", String.concatWith " * " (List.map TU.toString tys), ")"
99            ]            ]
   
     fun err (cxt, toks) = let  
100            fun tok2str (S s) = s            fun tok2str (S s) = s
101              | tok2str (A a) = concat["'", Atom.toString a, "'"]              | tok2str (A a) = concat["'", Atom.toString a, "'"]
102              | tok2str (V x) = concat["'", Var.nameOf x, "'"]              | tok2str (V x) = concat["'", Var.nameOf x, "'"]
# Line 88  Line 105 
105              | tok2str (TYS[ty]) = TU.toString ty              | tok2str (TYS[ty]) = TU.toString ty
106              | tok2str (TYS tys) = tysToString tys              | tok2str (TYS tys) = tysToString tys
107            in            in
108              error(cxt, List.map tok2str toks)      fun warn ((errStrm, span), toks) = Error.warningAt(errStrm, span, List.map tok2str toks)
109            end      fun err ((errStrm, span), toks) = (
110              Error.errorAt(errStrm, span, List.map tok2str toks);
111    (* FIXME: add error recovery *)
112              raise TypeError)
113        end (* local *)
114    
115      fun checkForRedef (env : env, cxt : context, x) = (case AtomMap.find(#bindings env,x)      fun checkForRedef (env : env, cxt : context, x) = (case AtomMap.find(#bindings env,x)
116             of SOME loc => err (cxt, [             of SOME loc => err (cxt, [
# Line 108  Line 129 
129         | PT.SS_Active=> AST.SS_Active         | PT.SS_Active=> AST.SS_Active
130         | PT.SS_Stable => AST.SS_Stable         | PT.SS_Stable => AST.SS_Stable
131          (* end case *))          (* end case *))
132    
133      (* checks the reduction operation *)      (* checks the reduction operation *)
134      fun checkReductionOp(env : env, cxt,r) = (case r      fun checkReductionOp(env : env, cxt,r) = (case r
135        of PT.R_Mark m => checkReductionOp (withEnvAndContext (env, cxt, m))        of PT.R_Mark m => checkReductionOp (withEnvAndContext (env, cxt, m))
# Line 118  Line 140 
140         | PT.R_Product => AST.R_Product         | PT.R_Product => AST.R_Product
141         | PT.R_Mean => AST.R_Mean         | PT.R_Mean => AST.R_Mean
142         | PT.R_Variance => AST.R_Variance         | PT.R_Variance => AST.R_Variance
143         | PT.R_Sum => AST.R_Sum)              | PT.R_Sum => AST.R_Sum
144              (* end case *))
145    
146    (* check a differentiation level, which muse be >= 0 *)    (* check a differentiation level, which must be >= 0 *)
147      fun checkDiff (cxt, k) =      fun checkDiff (cxt, k) =
148            if (k < 0)            if (k < 0)
149              then err (cxt, [S "differentiation must be >= 0"])              then err (cxt, [S "differentiation must be >= 0"])
150              else Ty.DiffConst(IntInf.toInt k)              else Ty.DiffConst(IntInf.toInt k)
151    
152      (* check a sequence dimension, which must be > 0 *)
153        fun checkSeqDim (cxt, d) =
154              if (d < 0)
155                then err (cxt, [S "invalid dimension; must be positive"])
156                else Ty.DimConst(IntInf.toInt d)
157    
158    (* check a dimension, which must be 1, 2 or 3 *)    (* check a dimension, which must be 1, 2 or 3 *)
159      fun checkDim (cxt, d) =      fun checkDim (cxt, d) =
160            if (d < 1) orelse (3 < d)            if (d < 1) orelse (3 < d)
# Line 149  Line 177 
177              | PT.T_Bool => Ty.T_Bool              | PT.T_Bool => Ty.T_Bool
178              | PT.T_Int => Ty.T_Int              | PT.T_Int => Ty.T_Int
179              | PT.T_Real => Ty.realTy              | PT.T_Real => Ty.realTy
180    (* FIXME: should look up the strand name in the environment! *)
181          | PT.T_Strand n => Ty.T_Strand n          | PT.T_Strand n => Ty.T_Strand n
182              | PT.T_String => Ty.T_String              | PT.T_String => Ty.T_String
183              | PT.T_Vec n => (* NOTE: the parser guarantees that 2 <= n <= 4 *)              | PT.T_Vec n => (* NOTE: the parser guarantees that 2 <= n <= 4 *)
# Line 168  Line 197 
197                  val ty = checkTy(cxt, ty)                  val ty = checkTy(cxt, ty)
198                  in                  in
199                    if TU.isFixedSizeType ty                    if TU.isFixedSizeType ty
200                      then Ty.T_Sequence(ty, checkDim (cxt, dim))                      then Ty.T_Sequence(ty, checkSeqDim (cxt, dim))
201                      else err(cxt, [S "elements of sequence types must be fixed-size types"])                      else err(cxt, [S "elements of sequence types must be fixed-size types"])
202                  end                  end
203              | PT.T_DynSeq ty => let              | PT.T_DynSeq ty => let
# Line 187  Line 216 
216              | (Literal.Bool _) => (AST.E_Lit lit, Ty.T_Bool)              | (Literal.Bool _) => (AST.E_Lit lit, Ty.T_Bool)
217            (* end case *))            (* end case *))
218    
219      fun coerceType (ty1, ty2, e) = (case U.matchType(ty1, ty2)      fun coerceExp (Ty.T_Tensor(Ty.Shape[]), Ty.T_Int, AST.E_Lit(Literal.Int n)) =
220              AST.E_Lit(Literal.Float(FloatLit.fromInt n))
221          | coerceExp (ty1, ty2, e) = AST.E_Coerce{srcTy=ty2, dstTy=ty1, e=e}
222    
223        fun coerceType (dstTy, srcTy, e) = (case U.matchType(dstTy, srcTy)
224             of U.EQ => SOME e             of U.EQ => SOME e
225              | U.COERCE => SOME(AST.E_Coerce{srcTy=ty2, dstTy=ty1, e=e})              | U.COERCE => SOME(coerceExp (dstTy, srcTy, e))
226              | U.FAIL => NONE              | U.FAIL => NONE
227            (* end case *))            (* end case *))
228    
# Line 209  Line 242 
242   *)   *)
243          (* try to match candidates while allowing type coercions *)          (* try to match candidates while allowing type coercions *)
244            fun tryMatchCandidates [] = err(cxt, [            fun tryMatchCandidates [] = err(cxt, [
245                    S "unable to resolve overloaded operator \"", A rator, S "\"\n",                    S "unable to resolve overloaded operator ", A rator, S "\n",
246                    S "  argument type is: ", TYS argTys, S "\n"                    S "  argument type is: ", TYS argTys, S "\n"
247                  ])                  ])
248              | tryMatchCandidates (x::xs) = let              | tryMatchCandidates (x::xs) = let
# Line 269  Line 302 
302                          if U.equalType(ty1, ty2)                          if U.equalType(ty1, ty2)
303                            then (AST.E_Cond(cond', e1', e2', ty1), ty1)                            then (AST.E_Cond(cond', e1', e2', ty1), ty1)
304                            else err (cxt, [                            else err (cxt, [
305                                S "type do not match in conditional expression\n",                                S "types do not match in conditional expression\n",
306                                S "  true branch:  ", TY ty1, S "\n",                                S "  true branch:  ", TY ty1, S "\n",
307                                S "  false branch: ", TY ty2                                S "  false branch: ", TY ty2
308                              ])                              ])
# Line 339  Line 372 
372                              ])                              ])
373                        (* end case *))                        (* end case *))
374                      else (case Env.findFunc (#env env, rator)                      else (case Env.findFunc (#env env, rator)
375                         of [rator] => let                         of Env.PrimFun[rator] => let
376                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf rator)                              val (tyArgs, Ty.T_Fun(domTy, rngTy)) = Util.instantiate(Var.typeOf rator)
377                              in                              in
378                                case U.matchArgs(domTy, [e1', e2'], [ty1, ty2])                                case U.matchArgs(domTy, [e1', e2'], [ty1, ty2])
# Line 351  Line 384 
384                                      ])                                      ])
385                                (* end case *)                                (* end case *)
386                              end                              end
387                          | ovldList => resolveOverload (cxt, rator, [ty1, ty2], [e1', e2'], ovldList)                          | Env.PrimFun ovldList =>
388                                resolveOverload (cxt, rator, [ty1, ty2], [e1', e2'], ovldList)
389                            | _ => raise Fail "impossible"
390                        (* end case *))                        (* end case *))
391                  end                  end
392              | PT.E_UnaryOp(rator, e) => let              | PT.E_UnaryOp(rator, e) => let
393                  val (e', ty) = checkExpr(env, cxt, e)                  val (e', ty) = checkExpr(env, cxt, e)
394                  in                  in
395                    case Env.findFunc (#env env, rator)                    case Env.findFunc (#env env, rator)
396                     of [rator] => let                     of Env.PrimFun[rator] => let
397                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = U.instantiate(Var.typeOf rator)                          val (tyArgs, Ty.T_Fun([domTy], rngTy)) = U.instantiate(Var.typeOf rator)
398                          in                          in
399                            case coerceType (domTy, ty, e')                            case coerceType (domTy, ty, e')
# Line 370  Line 405 
405                                  ])                                  ])
406                            (* end case *)                            (* end case *)
407                          end                          end
408                      | ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)                      | Env.PrimFun ovldList => resolveOverload (cxt, rator, [ty], [e'], ovldList)
409                        | _ => raise Fail "impossible"
410                    (* end case *)                    (* end case *)
411                  end                  end
412              | PT.E_Slice(e, indices) => let              | PT.E_Slice(e, indices) => let
# Line 400  Line 436 
436                        ]);                        ]);
437                    (AST.E_Slice(e', indices', resultTy), resultTy)                    (AST.E_Slice(e', indices', resultTy), resultTy)
438                  end                  end
439                | PT.E_Selector(x, field) => (case checkExpr(env, cxt, x)
440    (* FIXME: the use of T_DynSequence here is a hack to get around something that needs to be fixed elsewhere *)
441                     of (e', Ty.T_Strand strand) => (case Env.findStrand(#env env, strand)
442                           of SOME(AST.Strand{name, state, ...}) => let
443                                fun isField (AST.VD_Decl(AST.V{name, ...}, _)) = Atom.same(name, field)
444                                in
445                                  case List.find isField state
446                                   of SOME(AST.VD_Decl(x', _)) => let
447                                        val ty = Var.monoTypeOf x'
448                                        in
449                                          (AST.E_Selector(e', field, ty), ty)
450                                        end
451                                    | NONE => err(cxt, [
452                                          S "strand ", A name,
453                                          S " does not have state variable ", A field
454                                        ])
455                                  (* end case *)
456                                end
457                            | NONE => err(cxt, [S "unknown strand ", A strand])
458                          (* end case *))
459                      | (_, ty) => err (cxt, [
460                            S "expected strand type, but found ", TY ty,
461                            S " in selection of ", A field
462                          ])
463                    (* end case *))
464    (*
465          | PT.E_Selector(x,field) => (case (checkExpr(env,cxt,x), Env.findVar (#env env, field))          | PT.E_Selector(x,field) => (case (checkExpr(env,cxt,x), Env.findVar (#env env, field))
466             of ((AST.E_Var x',_), NONE) =>  err(cxt, [             of ((AST.E_Var x',_), NONE) =>  err(cxt, [
467                           S "undefined strand state variable ", A field                           S "undefined strand state variable ", A field
# Line 408  Line 470 
470                 val ty = Var.typeOf x'                 val ty = Var.typeOf x'
471                 val (_,ty') = Util.instantiate(Var.typeOf f')                 val (_,ty') = Util.instantiate(Var.typeOf f')
472                        in                        in
473                              ((case (Var.kindOf f')                          case (Var.kindOf f')
474                              of Var.StrandStateVar => ()                              of Var.StrandStateVar => ()
475                   | Var.StrandOutputVar => ()                   | Var.StrandOutputVar => ()
476                               | _=> err(cxt, [                               | _=> err(cxt, [
477                                    A field, S " is not a strand state variable"                                    A field, S " is not a strand state variable"
478                                ])                                ])
479                          (* end case *));                          (* end case *);
480                  (AST.E_Selector(AST.E_Var x',field, Var.monoTypeOf f'), Var.monoTypeOf f'))                          (AST.E_Selector(AST.E_Var x', field, Var.monoTypeOf f'), Var.monoTypeOf f')
481                  end                  end
482              |  (_,_) => err(cxt, [                    |  _  => err(cxt, [
483               S "type error in selector. lvalue is not variable",               S "type error in selector. lvalue is not variable",
484                           S " and undefined strand state variable ", A field                           S " and undefined strand state variable ", A field
485                        ])                        ])
486             (*end of case *))                  (* end case *))
487    *)
488          | PT.E_Reduction(r,vd) => let          | PT.E_Reduction(r,vd) => let
489              val (x, x',e',ty,argTy,s') = checkSetDecl(env, cxt, Var.StrandStateVar, vd)              val (x, x',e',ty,argTy,s') = checkSetDecl(env, cxt, Var.StrandStateVar, vd)
490              in              in
# Line 465  Line 528 
528                  fun stripMark (PT.E_Mark{tree, ...}) = stripMark tree                  fun stripMark (PT.E_Mark{tree, ...}) = stripMark tree
529                    | stripMark e = e                    | stripMark e = e
530                  val (args, tys) = checkExprList (env, cxt, args)                  val (args, tys) = checkExprList (env, cxt, args)
531                    fun checkFunApp f = (case Util.instantiate(Var.typeOf f)
532                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) => (
533                                case U.matchArgs (domTy, args, tys)
534                                 of SOME args => (AST.E_Apply(f, tyArgs, args, rngTy), rngTy)
535                                  | NONE => err(cxt, [
536                                        S "type error in application of ", V f, S "\n",
537                                        S "  expected:  ", TYS domTy, S "\n",
538                                        S "  but found: ", TYS tys
539                                      ])
540                                (* end case *))
541                            | _ => err(cxt, [S "application of non-function ", V f])
542                          (* end case *))
543                  fun checkFieldApp (e1', ty1) = (case (args, tys)                  fun checkFieldApp (e1', ty1) = (case (args, tys)
544                         of ([e2'], [ty2]) => let                         of ([e2'], [ty2]) => let
545                              val (tyArgs, Ty.T_Fun([fldTy, domTy], rngTy)) =                              val (tyArgs, Ty.T_Fun([fldTy, domTy], rngTy)) =
# Line 538  Line 613 
613                     of PT.E_Var f => (case Env.findVar (#env env, f)                     of PT.E_Var f => (case Env.findVar (#env env, f)
614                           of SOME f' => checkFieldApp (AST.E_Var f', Var.monoTypeOf f')                           of SOME f' => checkFieldApp (AST.E_Var f', Var.monoTypeOf f')
615                            | NONE => (case Env.findFunc (#env env, f)                            | NONE => (case Env.findFunc (#env env, f)
616                                 of [] => err(cxt, [S "unknown function ", A f])                                 of Env.PrimFun[] => err(cxt, [S "unknown function ", A f])
617                                  | [f] =>                                  | Env.PrimFun[f'] =>
618                                      if (inStrand env) andalso (Basis.isRestricted f)                                      if (inStrand env) andalso (Basis.isRestricted f')
619                                        then err(cxt, [                                        then err(cxt, [
620                                            S "use of restricted operation ", V f,                                            S "use of restricted operation ", V f',
621                                            S " in strand body"                                            S " in strand body"
622                                          ])                                          ])
623                                        else (case Util.instantiate(Var.typeOf f)                                        else checkFunApp f'
624                                           of (tyArgs, Ty.T_Fun(domTy, rngTy)) => (                                  | Env.PrimFun ovldList =>
625                                                case U.matchArgs (domTy, args, tys)                                      resolveOverload (cxt, f, tys, args, ovldList)
626                                                 of SOME args => (checkQuery(f);(AST.E_Apply(f, tyArgs, args, rngTy), rngTy))                                  | Env.UserFun f' => checkFunApp f'
                                                 | NONE => err(cxt, [  
                                                       S "type error in application of ", V f, S "\n",  
                                                       S "  expected:  ", TYS domTy, S "\n",  
                                                       S "  but found: ", TYS tys  
                                                     ])  
                                               (* end case *))  
                                           | _ => err(cxt, [S "application of non-function ", V f])  
                                         (* end case *))  
                                 | ovldList => resolveOverload (cxt, f, tys, args, ovldList)  
627                                (* end case *))                                (* end case *))
628                            (* end case *))                            (* end case *))
629                      | _ => checkFieldApp (checkExpr (env, cxt, e))                      | _ => checkFieldApp (checkExpr (env, cxt, e))
# Line 646  Line 712 
712              List.foldr chk ([], []) exprs              List.foldr chk ([], []) exprs
713            end            end
714    
715    (* FIXME: this code is bogus *)
716      and checkSetDecl (env,cxt,kind,d) = (case d      and checkSetDecl (env,cxt,kind,d) = (case d
717        of PT.VD_Mark m => checkSetDecl (env, (#1 cxt, #span m), kind, #tree m)        of PT.VD_Mark m => checkSetDecl (env, (#1 cxt, #span m), kind, #tree m)
718         | PT.VD_SDecl (x,setTypes,e) => let         | PT.VD_SDecl (x,setTypes,e) => let
719              fun checkSetTypes([]) = []              fun checkSetTypes([]) = []
720                | checkSetTypes((ty,set)::xs) = case checkTy(cxt,ty)                    | checkSetTypes ((ty, set)::xs) = (case checkTy(cxt, ty)
721                        of Ty.T_Strand n => checkStrandSet(env,cxt,set)::checkSetTypes(xs)                        of Ty.T_Strand n => checkStrandSet(env,cxt,set)::checkSetTypes(xs)
722                |  _ =>                          |  _ => err(cxt, [
723                       err(cxt, [                                S "reduction set is invalid. Needs to be a set of (all/active/stable) strands."
724                       S "reduction set is invalid. Needs to be a set of (all/active/stable) strands."])                              ])
725              fun getStrandType ([]) = err(cxt, [                        (* end case *))
726                       S "invalid strand name for reduction sets."])                  fun getStrandType [] = err(cxt, [S "invalid strand name for reduction sets."])
727                | getStrandType((ty,set)::xs) = ty                | getStrandType((ty,set)::xs) = ty
728    (* FIXME: the type of x' should be the strand type *)
729               val ty' = Ty.T_DynSequence (checkTy(cxt,getStrandType(setTypes)))                  val ty' = Ty.T_DynSequence (checkTy(cxt, getStrandType setTypes))
730               val x' = Var.new (x,kind,ty')               val x' = Var.new (x,kind,ty')
731               val env' = (checkForRedef (env, cxt, x);                  val env' = (checkForRedef (env, cxt, x); insertLocal(env, cxt, x, x'))
              insertLocal(env, cxt, x, x'))  
732               val (e',ty) = checkExpr(env',cxt,e)               val (e',ty) = checkExpr(env',cxt,e)
   
733               in               in
734                  (x,x',e',ty',ty,checkSetTypes(setTypes))                  (x,x',e',ty',ty,checkSetTypes(setTypes))
735              end              end
736          | _ => err(cxt, [              | _ => err(cxt, [S "invalid set declaration."])
737              S "invalid set declaration."]))            (* end case *))
   
738    
739      fun checkVarDecl (env, cxt, kind, d) = (case d      fun checkVarDecl (env, cxt, kind, d) = (case d
740             of PT.VD_Mark m => checkVarDecl (env, (#1 cxt, #span m), kind, #tree m)             of PT.VD_Mark m => checkVarDecl (env, (#1 cxt, #span m), kind, #tree m)
741          | PT.VD_Decl(ty, x, e) => let          | PT.VD_Decl(ty, x, e) => let
742                  val ty = checkTy (cxt, ty)                  val ty = checkTy (cxt, ty)
743                  val x' = Var.new (x, kind, ty)                  val x' = Var.new (x, kind, ty)
         val xTy = Var.monoTypeOf x'  
744                  val (e', ty') = checkExpr (env, cxt, e)                  val (e', ty') = checkExpr (env, cxt, e)
745                  in                  in
746             (case coerceType (ty, ty', e')                    case coerceType (ty, ty', e')
747                     of SOME e' => (x, x', e')                     of SOME e' => (x, x', e')
748                      | NONE => err(cxt, [                      | NONE => err(cxt, [
749                          S "type of variable ", A x,                          S "type of variable ", A x,
# Line 688  Line 751 
751                          S "  expected: ", TY ty, S "\n",                          S "  expected: ", TY ty, S "\n",
752                          S "  but found: ", TY ty'                          S "  but found: ", TY ty'
753                        ])                        ])
754                    (* end case *))                    (* end case *)
755                  end                  end
756            (* end case *))            (* end case *))
757    
758      (* check for unreachable code and non-return statements in the tail position of a function.
759       * Note that unreachable code is typechecked and included in the AST.  It is pruned away
760       * by simplify.
761       *)
762        fun chkCtlFlow (cxt, scope, stm) = let
763              val (inFun, inUpdate, funName) = (case scope
764                     of FunctionScope(_, f) => (true, false, Atom.toString f)
765                      | MethodScope StrandUtil.Update => (false, true, "")
766                      | _ => (false, false, "")
767                    (* end case *))
768            (* checks a statement for correct control flow; it returns false if control may
769             * flow from the statement to the next in a sequence and true if control cannot
770             * flow to the next statement.
771             *)
772              fun chk ((errStrm, _), hasSucc, isJoin, unreachable, PT.S_Mark{span, tree}) =
773                    chk((errStrm, span), hasSucc, isJoin, unreachable, tree)
774                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_Block(stms as _::_)) = let
775                    fun chk' ([], escapes) = escapes
776                      | chk' ([stm], escapes) =
777                          chk(cxt, hasSucc, isJoin, escapes orelse unreachable, stm) orelse escapes
778                      | chk' (stm::stms, escapes) = let
779                          val escapes = chk(cxt, true, false, escapes orelse unreachable, stm) orelse escapes
780                          in
781                            chk'(stms, escapes)
782                          end
783                    in
784                      chk' (stms, false)
785                    end
786                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_IfThen(_, stm)) = (
787                    if inFun andalso not hasSucc andalso not unreachable
788                      then err(cxt, [
789                            S "Missing return statement in tail position of function ", S funName
790                        ])
791                      else ();
792                    ignore (chk (cxt, hasSucc, true, unreachable, stm));
793                    false)
794                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_IfThenElse(_, stm1, stm2)) = let
795                    val escapes = chk (cxt, hasSucc, true, unreachable, stm1)
796                    val escapes = chk (cxt, hasSucc, true, unreachable, stm2) andalso escapes
797                    in
798                      if escapes andalso hasSucc andalso not unreachable
799                        then (
800                          warn(cxt, [S "unreachable statements after \"if-then-else\" statement"]);
801                          true)
802                        else escapes
803                    end
804                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_Die) = (
805                    if not inUpdate
806                      then err(cxt, [S "\"die\" statment outside of update method"])
807                    else if hasSucc andalso not isJoin andalso not unreachable
808                      then warn(cxt, [S "statements following \"die\" statment are unreachable"])
809                      else ();
810                    true)
811                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_Stabilize) = (
812                    if not inUpdate
813                      then err(cxt, [S "\"stabilize\" statment outside of update method"])
814                    else if hasSucc andalso not isJoin andalso not unreachable
815                      then warn(cxt, [S "statements following \"stabilize\" statment are unreachable"])
816                      else ();
817                    true)
818                | chk (cxt, hasSucc, isJoin, unreachable, PT.S_Return _) = (
819                    if not inFun
820                      then err(cxt, [S "\"return\" statment outside of function body"])
821                    else if hasSucc andalso not isJoin andalso not unreachable
822                      then warn(cxt, [S "statements following \"return\" statment are unreachable"])
823                      else ();
824                    true)
825                | chk (cxt, hasSucc, isJoin, unreachable, _) = (
826                    if inFun andalso not hasSucc andalso not unreachable
827                      then err(cxt, [
828                            S "Missing return statement in tail position of function ", S funName
829                        ])
830                      else ();
831                    false)
832              in
833                ignore (chk (cxt, false, false, false, stm))
834              end
835    
836      (* check the creation of a new strand; either in a "new" statement or in an "initially"
837       * block.
838       *)
839        fun checkStrandCreate (env, cxt, strand, args) = let
840              val argsAndTys' = List.map (fn e => checkExpr(env, cxt, e)) args
841              val (args', tys') = ListPair.unzip argsAndTys'
842              in
843              (* check that strand is defined and that the argument types match *)
844                case Env.findStrand (#env env, strand)
845                 of SOME(AST.Strand{params, ...}) => let
846                      val paramTys = List.map Var.monoTypeOf params
847                      in
848                        case U.matchArgs (paramTys, args', tys')
849                         of SOME args' => (strand, args', env)
850                          | NONE => err(cxt, [
851                              S "type error in new ", A strand, S "\n",
852                              S "  expected:  ", TYS paramTys, S "\n",
853                              S "  but found: ", TYS tys'
854                            ])
855                        (* end case *)
856                      end
857                  | NONE => err(cxt, [S "unknown strand ", A strand])
858                (* end case *)
859              end
860    
861    (* typecheck a statement and translate it to AST *)    (* typecheck a statement and translate it to AST *)
862      fun checkStmt (env, cxt, s) = (case s      fun checkStmt (env : env, cxt : context, stm) = let
863             of PT.S_Mark m => checkStmt (withEnvAndContext (env, cxt, m))            fun chkStmt (env : env, cxt : context, s) = (case s
864                     of PT.S_Mark m => chkStmt (withEnvAndContext (env, cxt, m))
865              | PT.S_Block stms => let              | PT.S_Block stms => let
866                  fun chk (_, [], stms) = AST.S_Block(List.rev stms)                  fun chk (_, [], stms) = AST.S_Block(List.rev stms)
867                    | chk (env, s::ss, stms) = let                    | chk (env, s::ss, stms) = let
868                        val (s', env') = checkStmt (env, cxt, s)                              val (s', env') = chkStmt (env, cxt, s)
869                        in                        in
870                          chk (env', ss, s'::stms)                          chk (env', ss, s'::stms)
871                        end                        end
# Line 713  Line 880 
880                  end                  end
881              | PT.S_IfThen(e, s) => let              | PT.S_IfThen(e, s) => let
882                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = checkExpr (env, cxt, e)
883                  val (s', _) = checkStmt (env, cxt, s)                        val (s', _) = chkStmt (env, cxt, s)
884                  in                  in
885                  (* check that condition has bool type *)                  (* check that condition has bool type *)
886                    case ty                    case ty
# Line 724  Line 891 
891                  end                  end
892              | PT.S_IfThenElse(e, s1, s2) => let              | PT.S_IfThenElse(e, s1, s2) => let
893                  val (e', ty) = checkExpr (env, cxt, e)                  val (e', ty) = checkExpr (env, cxt, e)
894                  val (s1', _) = checkStmt (env, cxt, s1)                        val (s1', _) = chkStmt (env, cxt, s1)
895                  val (s2', _) = checkStmt (env, cxt, s2)                        val (s2', _) = chkStmt (env, cxt, s2)
896                  in                  in
897                  (* check that condition has bool type *)                  (* check that condition has bool type *)
898                    case ty                    case ty
# Line 746  Line 913 
913                  in                  in
914                    checkForRedef(env,cxt,x);                    checkForRedef(env,cxt,x);
915            (* checks to make sure "pos" is defined*)            (* checks to make sure "pos" is defined*)
916            (case Env.findVar (#env env, Atom.atom "pos")                          case Env.findVar (#env env, Atom.atom "pos")
917              of SOME f' => (case (Var.kindOf f')              of SOME f' => (case (Var.kindOf f')
918                                      of Var.StrandStateVar => ()                                      of Var.StrandStateVar => ()
919                                      | _=> err(cxt, [                                 | _ => err(cxt, [S "pos needs to be a strand state variable"])
                                              S "pos needs to be a strand state variable"  
                                          ])  
920                                      (* end case *))                                      (* end case *))
   
921               | NONE => err(cxt, [               | NONE => err(cxt, [
922                                               S "pos needs to be defined as a strand state variable inorder to use the foreach statment."                                               S "pos needs to be defined as a strand state variable inorder to use the foreach statment."
923                                           ])                                           ])
924                  (* end case *));                          (* end case *);
925                    (AST.S_Foreach(x'',ty',e,s'),env')                    (AST.S_Foreach(x'',ty',e,s'),env')
926          end          end
927              | PT.S_Assign(x, e) => (case Env.findVar (#env env, x)              | PT.S_Assign(x, e) => (case Env.findVar (#env env, x)
# Line 779  Line 943 
943                                    ])                                    ])
944                              (* end case *))                              (* end case *))
945                        in                        in
   
946                        (* check that x' is mutable *)                        (* check that x' is mutable *)
947                          case Var.kindOf x'                          case Var.kindOf x'
948                           of Var.StrandStateVar => ()                           of Var.StrandStateVar => ()
# Line 787  Line 950 
950                            | Var.LocalVar => ()                            | Var.LocalVar => ()
951                            | _ => (case #scope env                            | _ => (case #scope env
952                              of GlobalScope => ()                              of GlobalScope => ()
953                               | _ => err(cxt, [                                        | scp => err(cxt, [
954                                          S "assignment to immutable variable ", A x                                              S "assignment to immutable variable ", A x,
955                                                S " in ", S(scopeToString scp)
956                                      ])                                      ])
957                      (*end case *))                      (*end case *))
958                          (* end case *);                          (* end case *);
959              (* check that if e' is a reduction that its only being assigned in a global scope *)  (* this check should be in checkExpr!  Not here! *)
960                                (* check that if e' is a reduction that it is only being assigned in a global scope *)
961                case e'                case e'
962                 of AST.E_Reduction(_,_,_,_,_,_) => (case #scope env                 of AST.E_Reduction(_,_,_,_,_,_) => (case #scope env
963                                      of GlobalScope => ()                                      of GlobalScope => ()
964                                       | _ => err(cxt, [                                       | _ => err(cxt, [
965                                                  S "assignment of variable ", A x, S " to a reduction expression only allowed in global scope"                                            S "assignment of variable ", A x,
966                                              S " to a reduction expression only allowed in global scope"
967                                      ])                                      ])
968                      (*end case *))                      (*end case *))
969                  | _ => ();                                  | _ => ()
970                                  (* end case *);
971                          (AST.S_Assign(x', e'), env)                          (AST.S_Assign(x', e'), env)
972                        end                        end
973                  (* end case *))                  (* end case *))
# Line 810  Line 976 
976                        val e1' = AST.E_Var x'                        val e1' = AST.E_Var x'
977                        val ty1 = Var.monoTypeOf x'                        val ty1 = Var.monoTypeOf x'
978                        val (e2', ty2) = checkExpr(env, cxt, e)                        val (e2', ty2) = checkExpr(env, cxt, e)
979                        val ovldList = Env.findFunc (#env env, rator)                              val Env.PrimFun ovldList = Env.findFunc (#env env, rator)
980                        val (rhs, _) = resolveOverload (cxt, rator, [ty1, ty2], [e1', e2'], ovldList)                        val (rhs, _) = resolveOverload (cxt, rator, [ty1, ty2], [e1', e2'], ovldList)
981                        in                        in
982                                (* check that x' is mutable *)
983                                  case Var.kindOf x'
984                                   of Var.StrandStateVar => ()
985                                    | Var.StrandOutputVar => ()
986                                    | Var.LocalVar => ()
987                                    | _ => (case #scope env
988                                         of GlobalScope => ()
989                                          | scp => err(cxt, [
990                                                S "assignment to immutable variable ", A x,
991                                                S " in ", S(scopeToString scp)
992                                              ])
993                                        (* end case *))
994                                  (* end case *);
995                          (AST.S_Assign(x', rhs), env)                          (AST.S_Assign(x', rhs), env)
996                        end                        end
997                    | NONE => err(cxt, [S "undeclared variable ", A x, S " on lhs of ", A rator])                    | NONE => err(cxt, [S "undeclared variable ", A x, S " on lhs of ", A rator])
998                  (* end case *))                  (* end case *))
999              | PT.S_New(strand, args) => let              | PT.S_New(strand, args) => let
1000                  val argsAndTys' = List.map (fn e => checkExpr(env, cxt, e)) args                        val (strand, args, env) = checkStrandCreate (env, cxt, strand, args)
                 val (args', tys') = ListPair.unzip argsAndTys'  
1001                  in                  in
1002                    case #scope env                    case #scope env
1003                     of MethodScope => ()                           of MethodScope StrandUtil.Update => ()
1004                      | InitScope => ()                      | InitScope => ()
1005                      | _ => err(cxt, [S "invalid scope for new strand"])                      | _ => err(cxt, [S "invalid scope for new strand"])
1006                    (* end case *);                    (* end case *);
1007  (* FIXME: check that strand is defined and has the argument types match *)                          (AST.S_New(strand, args), env)
                   (AST.S_New(strand, args'), env)  
1008                  end                  end
1009              | PT.S_Die => (                    | PT.S_Die => (AST.S_Die, env) (* note that scope has already been checked *)
1010                  case #scope env                    | PT.S_Stabilize => (AST.S_Stabilize, env) (* note that scope has already been checked *)
1011                   of MethodScope => ()                    | PT.S_Return e => let
1012                    | _ => err(cxt, [S "\"die\" statment outside of method"])                        val (e', ty) = checkExpr (env, cxt, e)
1013                  (* end case *);                        in
                 (AST.S_Die, env))  
             | PT.S_Stabilize => (  
1014                  case #scope env                  case #scope env
1015                   of MethodScope => ()                           of FunctionScope(ty', f) => (case coerceType(ty', ty, e')
1016                    | _ => err(cxt, [S "\"stabilize\" statment outside of method"])                                 of SOME e' => (AST.S_Return e', env)
1017                  (* end case *);                                  | NONE => err(cxt, [
1018                  (AST.S_Stabilize, env))                                        S "type of return expression does not match return type of function ",
1019                                          A f, S "\n",
1020                                          S "  expected: ", TY ty', S "\n",
1021                                          S "  but found: ", TY ty
1022                                        ])
1023                                  (* end case *))
1024                              | _ => (AST.S_Return e', env) (* this error condition has already been checked *)
1025                            (* end case *)
1026                          end
1027              | PT.S_Print args => let              | PT.S_Print args => let
1028                  fun chkArg e = let                  fun chkArg e = let
1029                        val (e', ty) = checkExpr (env, cxt, e)                        val (e', ty) = checkExpr (env, cxt, e)
# Line 857  Line 1040 
1040                    (AST.S_Print args', env)                    (AST.S_Print args', env)
1041                  end                  end
1042            (* end case *))            (* end case *))
1043              in
1044                chkCtlFlow (cxt, #scope env, stm);
1045                chkStmt (env, cxt, stm)
1046              end (* checkStmt *)
1047    
1048      fun checkParams (env, cxt, params) = let      fun checkParams (env, cxt, params) = let
1049            fun chkParam (env, cxt, param) = (case param            fun chkParam (env, cxt, param) = (case param
# Line 874  Line 1061 
1061                    (x::xs, env)                    (x::xs, env)
1062                  end                  end
1063            in            in
 (* FIXME: need to check for multiple occurences of the same parameter name! *)  
1064              List.foldr chk ([], env) params              List.foldr chk ([], env) params
1065            end            end
1066    
1067      fun checkMethod (env, cxt, meth) = (case meth      fun checkMethod (env, cxt, meth) = (case meth
1068             of PT.M_Mark m => checkMethod (withEnvAndContext (env, cxt, m))             of PT.M_Mark m => checkMethod (withEnvAndContext (env, cxt, m))
1069              | PT.M_Method(name, body) => let              | PT.M_Method(name, body) => let
1070                  val (body, _) = checkStmt(methodScope env, cxt, body)                  val (body, _) = checkStmt(methodScope (env, name), cxt, body)
1071                  in                  in
1072                    AST.M_Method(name, body)                    AST.M_Method(name, body)
1073                  end                  end
1074            (* end case *))            (* end case *))
1075    
1076    (* FIXME: to handle "new" inside the body of the strand, we need to add it to the environment before it is defined! *)
1077      fun checkStrand (env, cxt, {name, params, state, methods}) = let      fun checkStrand (env, cxt, {name, params, state, methods}) = let
1078          (* check the strand parameters *)          (* check the strand parameters *)
1079            val (params, env) = checkParams (env, cxt, params)            val (params, env) = checkParams (strandScope env, cxt, params)
1080          (* check the strand state variable definitions *)          (* check the strand state variable definitions *)
1081            val (vds, env) = let            val (vds, hasOutput, env) = let
1082                  fun checkStateVar ((isOut, vd), (vds, env)) = let                  fun checkStateVar ((isOut, vd), (vds, hasOut, env)) = let
1083                        val kind = if isOut then AST.StrandOutputVar else AST.StrandStateVar                        val kind = if isOut then AST.StrandOutputVar else AST.StrandStateVar
1084                        val (x, x', e') = checkVarDecl (env, cxt, kind, vd)                        val (x, x', e') = checkVarDecl (env, cxt, kind, vd)
1085                        in                        in
# Line 904  Line 1091 
1091                              ])                              ])
1092                            else ();                            else ();
1093                          checkForRedef (env, cxt, x);                          checkForRedef (env, cxt, x);
1094                          (AST.VD_Decl(x', e')::vds, insertLocal(env, cxt, x, x'))                          (AST.VD_Decl(x', e')::vds, hasOut orelse isOut, insertLocal(env, cxt, x, x'))
1095                        end                        end
1096                  val (vds, env) = List.foldl checkStateVar ([], env) state                  val (vds, hasOutput, env) = List.foldl checkStateVar ([], false, env) state
1097                  in                  in
1098                    (List.rev vds, env)                    (List.rev vds, hasOutput, env)
1099                    end
1100            (* define a dummy strand definition so that recursive mentions of this strand will
1101             * typecheck.
1102             *)
1103              val env = let
1104                    val strand = AST.Strand{name = name, params = params, state = vds, methods = []}
1105                    in
1106                      insertStrand(env, cxt, strand)
1107                  end                  end
1108          (* check the strand methods *)          (* check the strand methods *)
1109            val methods = List.map (fn m => checkMethod (env, cxt, m)) methods            val methods = List.map (fn m => checkMethod (env, cxt, m)) methods
# Line 919  Line 1114 
1114                  then methods                  then methods
1115                  else methods @ [AST.M_Method(StrandUtil.Stabilize, AST.S_Block[])]                  else methods @ [AST.M_Method(StrandUtil.Stabilize, AST.S_Block[])]
1116            in            in
1117    (* FIXME: once there are global outputs, then it should be okay to have not strand outputs! *)
1118            (* check that there is at least one output variable *)
1119                if not hasOutput
1120                  then err(cxt, [S "strand ", A name, S " does not have any outputs"])
1121                  else ();
1122  (* FIXME: should check for duplicate method definitions *)  (* FIXME: should check for duplicate method definitions *)
1123              if not(List.exists (fn StrandUtil.Update => true | _ => false) methodNames)              if not(List.exists (fn StrandUtil.Update => true | _ => false) methodNames)
1124                then err(cxt, [S "strand ", A name, S " is missing an update method"])                then err(cxt, [S "strand ", A name, S " is missing an update method"])
1125                else ();                else ();
1126              (AST.D_Strand{name = name, params = params, state = vds, methods = methods},env)              AST.Strand{name = name, params = params, state = vds, methods = methods}
1127            end            end
1128    
1129      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))
1130        | checkCreate (env, cxt, PT.C_Create(strand, args)) = let        | checkCreate (env, cxt, PT.C_Create(strand, args)) = let
1131            val (args, tys) = checkExprList (env, cxt, args)            val (strand, args, env) = checkStrandCreate (env, cxt, strand, args)
1132            in            in
 (* FIXME: check against strand definition *)  
1133              AST.C_Create(strand, args)              AST.C_Create(strand, args)
1134            end            end
1135    
# Line 1000  Line 1199 
1199                    checkForRedef (env, cxt, x);                    checkForRedef (env, cxt, x);
1200                    (AST.D_Var(AST.VD_Decl(x', e')), insertGlobal(env, cxt, x, x'))                    (AST.D_Var(AST.VD_Decl(x', e')), insertGlobal(env, cxt, x, x'))
1201                  end                  end
1202                | PT.D_Func(ty, f, params, body) => let
1203              | PT.D_Strand arg => checkStrand(strandScope env, cxt, arg)                  val ty' = checkTy(cxt, ty)
1204                    val env' = functionScope (env, ty', f)
1205                    val (params', env') = checkParams (env', cxt, params)
1206                    val body' = (case body
1207                           of PT.FB_Expr e => let
1208                                val (e', ty) = checkExpr (env', cxt, e)
1209                                in
1210                                  case coerceType(ty', ty, e')
1211                                   of SOME e' => AST.S_Return e'
1212                                    | NONE => err(cxt, [
1213                                          S "type of function body does not match return type\n",
1214                                          S "  expected: ", TY ty', S "\n",
1215                                          S "  but found: ", TY ty
1216                                        ])
1217                                  (* end case *)
1218                                end
1219                            | PT.FB_Stmt s => #1(checkStmt(env', cxt, s))
1220                          (* end case *))
1221                    val fnTy = Ty.T_Fun(List.map Var.monoTypeOf params', ty')
1222                    val f' = Var.new (f, AST.FunVar, fnTy)
1223                    in
1224    (* QUESTION: should we check for redefinition of basis functions? *)
1225                      checkForRedef (env, cxt, f);
1226                      (AST.D_Func(f', params', body'), insertFunc(env, cxt, f, f'))
1227                    end
1228                | PT.D_Strand arg => let
1229                    val strand = checkStrand(strandScope env, cxt, arg)
1230                    in
1231                      checkForRedef (env, cxt, #name arg);
1232                      (AST.D_Strand strand, insertStrand(env, cxt, strand))
1233                    end
1234              | PT.D_InitialArray(create, iterators) => let              | PT.D_InitialArray(create, iterators) => let
1235                  val env = initScope env                  val (iterators, env') = checkIters (initScope env, cxt, iterators)
                 val (iterators, env') = checkIters (env, cxt, iterators)  
1236                  val create = checkCreate (env', cxt, create)                  val create = checkCreate (env', cxt, create)
1237                  in                  in
1238                    (AST.D_InitialArray(create, iterators), env)                    (AST.D_InitialArray(create, iterators), env)
1239                  end                  end
1240              | PT.D_InitialCollection(create, iterators) => let              | PT.D_InitialCollection(create, iterators) => let
1241                  val env = initScope env                  val (iterators, env') = checkIters (initScope env, cxt, iterators)
                 val (iterators, env') = checkIters (env, cxt, iterators)  
1242                  val create = checkCreate (env', cxt, create)                  val create = checkCreate (env', cxt, create)
1243                  in                  in
1244                    (AST.D_InitialCollection(create, iterators), env)                    (AST.D_InitialCollection(create, iterators), env)
1245                  end                  end
1246          | PT.D_Global stmt => let          | PT.D_Global stmt => let
1247          val (stmt',_) = checkStmt(globalScope env, cxt, stmt)                  val (stmt',_) = checkStmt(env, cxt, stmt)
1248          in          in
1249            (AST.D_Global(stmt'),env)            (AST.D_Global(stmt'),env)
1250          end          end
1251            (* end case *))            (* end case *))
1252    
1253    (* reorder the declarations so that the input variables come first, followed by strand definition *)    (* reorder the declarations so that the input variables come first *)
1254      fun reorderDecls dcls = let      fun reorderDecls dcls = let
1255            fun isInput (AST.D_Input _) = true            fun isInput (AST.D_Input _) = true
1256              | isInput _ = false              | isInput _ = false
# Line 1043  Line 1270 
1270            in            in
1271              chk ({scope=GlobalScope, bindings=AtomMap.empty, env=Basis.env}, tree, [])              chk ({scope=GlobalScope, bindings=AtomMap.empty, env=Basis.env}, tree, [])
1272            end            end
1273                handle TypeError => AST.Program[]
1274    
1275    end    end

Legend:
Removed from v.2297  
changed lines
  Added in v.2298

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