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

SCM Repository

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

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

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

revision 2745, Sun Sep 28 12:50:50 2014 UTC revision 2746, Wed Oct 1 21:08:30 2014 UTC
# Line 73  Line 73 
73              bindings = AtomMap.insert(bindings, name, Error.location cxt),              bindings = AtomMap.insert(bindings, name, Error.location cxt),
74              env=Env.insertStrand(env, s)              env=Env.insertStrand(env, s)
75            }            }
76      fun insertFunc ({scope, bindings, env}, cxt, f, f') = {      fun insertFunc ({scope, bindings, env}, cxt, f, f') =  let
77              val loc = Error.location cxt
78              in
79                setLoc(f', loc);
80                {
81              scope=scope,              scope=scope,
82              bindings = AtomMap.insert(bindings, f, Error.location cxt),                bindings = AtomMap.insert(bindings, f, loc),
83              env=Env.insertFunc(env, f, Env.UserFun f')              env=Env.insertFunc(env, f, Env.UserFun f')
84            }            }
85              end
86      fun insertLocal ({scope, bindings, env}, cxt, x, x') = let      fun insertLocal ({scope, bindings, env}, cxt, x, x') = let
87            val loc = Error.location cxt            val loc = Error.location cxt
88            in            in
89              setLoc(x', loc);              setLoc(x', loc);
90              {              {
91                scope=scope,                scope=scope,
92                bindings = AtomMap.insert(bindings, x, Error.location cxt),                bindings = AtomMap.insert(bindings, x, loc),
93                env=Env.insertLocal(env, x, x')                env=Env.insertLocal(env, x, x')
94              }              }
95            end            end
# Line 494  Line 499 
499                  in                  in
500                    case stripMark e                    case stripMark e
501                     of PT.E_Var f => (case Env.findVar (#env env, f)                     of PT.E_Var f => (case Env.findVar (#env env, f)
502                           of SOME f' => checkFieldApp (AST.E_Var f', Var.monoTypeOf f')                           of SOME f' => (
503                                  markUsed (f', true);
504                                  checkFieldApp (AST.E_Var f', Var.monoTypeOf f'))
505                            | NONE => (case Env.findFunc (#env env, f)                            | NONE => (case Env.findFunc (#env env, f)
506                                 of Env.PrimFun[] => err(cxt, [S "unknown function ", A f])                                 of Env.PrimFun[] => err(cxt, [S "unknown function ", A f])
507                                  | Env.PrimFun[f'] =>                                  | Env.PrimFun[f'] =>
# Line 506  Line 513 
513                                        else checkFunApp f'                                        else checkFunApp f'
514                                  | Env.PrimFun ovldList =>                                  | Env.PrimFun ovldList =>
515                                      resolveOverload (cxt, f, tys, args, ovldList)                                      resolveOverload (cxt, f, tys, args, ovldList)
516                                  | Env.UserFun f' => checkFunApp f'                                  | Env.UserFun f' => (
517                                        markUsed (f', true);
518                                        checkFunApp f')
519                                (* end case *))                                (* end case *))
520                            (* end case *))                            (* end case *))
521                      | _ => checkFieldApp (checkExpr (env, cxt, e))                      | _ => checkFieldApp (checkExpr (env, cxt, e))
# Line 519  Line 528 
528                  end                  end
529              | PT.E_Sequence args => (case checkExprList (env, cxt, args)              | PT.E_Sequence args => (case checkExprList (env, cxt, args)
530  (* FIXME: need kind for concrete types here! *)  (* FIXME: need kind for concrete types here! *)
531                   of ([], _) => (AST.E_Seq[], Ty.T_Sequence(Ty.T_Var(MetaVar.newTyVar()), Ty.DimConst 0))                   of ([], _) => let
532                          val ty = Ty.T_Sequence(Ty.T_Var(MetaVar.newTyVar()), Ty.DimConst 0)
533                          in
534                            (AST.E_Seq([], ty), ty)
535                          end
536                    | (args, ty::tys) =>                    | (args, ty::tys) =>
537                        if TU.isFixedSizeType(TU.pruneHead ty)                        if TU.isFixedSizeType(TU.pruneHead ty)
538                          then let                          then let
# Line 527  Line 540 
540                            val resTy = Ty.T_Sequence(ty, Ty.DimConst(List.length args))                            val resTy = Ty.T_Sequence(ty, Ty.DimConst(List.length args))
541                            in                            in
542                              if List.all chkTy tys                              if List.all chkTy tys
543                                then (AST.E_Seq args, resTy)                                then (AST.E_Seq(args, resTy), resTy)
544                                else err(cxt, [S "arguments of sequence expression must have same type"])                                else err(cxt, [S "arguments of sequence expression must have same type"])
545                            end                            end
546                          else err(cxt, [S "sequence expression of non-value argument type"])                          else err(cxt, [S "sequence expression of non-value argument type"])
# Line 783  Line 796 
796                              (* check that x' is mutable *)                              (* check that x' is mutable *)
797                                case Var.kindOf x'                                case Var.kindOf x'
798                                 of Var.StrandStateVar => ()                                 of Var.StrandStateVar => ()
799                                  | Var.StrandOutputVar => ()                                  | Var.StrandOutputVar => markUsed (x', true)
800                                  | Var.LocalVar => ()                                  | Var.LocalVar => ()
801                                  | _ => err(cxt, [                                  | _ => err(cxt, [
802                                        S "assignment to immutable variable ", A x,                                        S "assignment to immutable variable ", A x,
# Line 804  Line 817 
817                              (* check that x' is mutable *)                              (* check that x' is mutable *)
818                                case Var.kindOf x'                                case Var.kindOf x'
819                                 of Var.StrandStateVar => ()                                 of Var.StrandStateVar => ()
820                                  | Var.StrandOutputVar => ()                                  | Var.StrandOutputVar => markUsed (x', true)
821                                  | Var.LocalVar => ()                                  | Var.LocalVar => ()
822                                  | _ => err(cxt, [                                  | _ => err(cxt, [
823                                        S "assignment to immutable variable ", A x,                                        S "assignment to immutable variable ", A x,

Legend:
Removed from v.2745  
changed lines
  Added in v.2746

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