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 1300, Thu Jun 9 21:11:47 2011 UTC revision 1301, Thu Jun 9 23:58:40 2011 UTC
# Line 667  Line 667 
667    
668      fun checkDecl (env, cxt, d) = (case d      fun checkDecl (env, cxt, d) = (case d
669             of PT.D_Mark m => checkDecl (withEnvAndContext (env, cxt, m))             of PT.D_Mark m => checkDecl (withEnvAndContext (env, cxt, m))
670              | PT.D_Input(ty, x, optExp) => let              | PT.D_Input(ty, x, desc, optExp) => let
671    (* FIXME: need to do something with the description *)
672                  val ty = checkTy(cxt, ty)                  val ty = checkTy(cxt, ty)
673                  val x' = Var.new(x, Var.InputVar, ty)                  val x' = Var.new(x, Var.InputVar, ty)
674                  val dcl = (case optExp                  val dcl = (case optExp
675                         of NONE => AST.D_Input(x', NONE)                         of NONE => AST.D_Input(x', desc, NONE)
676                          | SOME e => let                          | SOME e => let
677                              val (e', ty') = checkExpr (env, cxt, e)                              val (e', ty') = checkExpr (env, cxt, e)
678                              in                              in
679                                if U.matchType (ty, ty')                                if U.matchType (ty, ty')
680                                  then AST.D_Input(x', SOME e')                                  then AST.D_Input(x', desc, SOME e')
681                                  else err(cxt, [                                  else err(cxt, [
682                                      S "definition of ", V x', S " has wrong type\n",                                      S "definition of ", V x', S " has wrong type\n",
683                                      S "  expected:  ", TY ty, S "\n",                                      S "  expected:  ", TY ty, S "\n",
# Line 715  Line 716 
716                  end                  end
717            (* end case *))            (* end case *))
718    
719      (* reorder the declarations so that the input variables come first *)
720        fun reorderDecls dcls = let
721              fun isInput (AST.D_Input _) = true
722                | isInput _ = false
723              val (inputs, others) = List.partition isInput dcls
724              in
725                inputs @ others
726              end
727    
728      fun check errStrm (PT.Program{span, tree}) = let      fun check errStrm (PT.Program{span, tree}) = let
729            val cxt = (errStrm, span)            val cxt = (errStrm, span)
730            fun chk (env, [], dcls') = AST.Program(List.rev dcls')            fun chk (env, [], dcls') = AST.Program(reorderDecls(List.rev dcls'))
731              | chk (env, dcl::dcls, dcls') = let              | chk (env, dcl::dcls, dcls') = let
732                  val (dcl', env) = checkDecl (env, cxt, dcl)                  val (dcl', env) = checkDecl (env, cxt, dcl)
733                  in                  in

Legend:
Removed from v.1300  
changed lines
  Added in v.1301

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