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

SCM Repository

[diderot] View of /branches/vis15/src/compiler/typechecker/check-globals.sml
ViewVC logotype

View of /branches/vis15/src/compiler/typechecker/check-globals.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3410 - (download) (annotate)
Thu Nov 12 02:57:49 2015 UTC (3 years, 9 months ago) by jhr
File size: 5448 byte(s)
working on merge
(* check-globals.sml
 *
 * This code is part of the Diderot Project (http://diderot-language.cs.uchicago.edu)
 *
 * COPYRIGHT (c) 2015 The University of Chicago
 * All rights reserved.
 *)

structure CheckGlobals : sig

  (* type check the global declarations of a program.  We partition the result
   * into constants (which can only depend on other constants), inputs (which
   * can depend on contants), and the other globals (functions and variables).
   *)
    val check : Env.t * Env.context * ParseTree.global_dcl list -> {
	    const_dcls : AST.var_dcl list,
	    input_dcls : (AST.var_dcl * string option) list,
	    other_dcls : AST.global_dcl list,
	    env : Env.t
	  }

  end = struct

    structure PT = ParseTree
    structure Ty = Types
    structure TU = TypeUtil
    structure E = Env

    val err = TypeError.error

    datatype token = datatype TypeError.token

    fun location ((errStrm, _), span) = Error.location(errStrm, span)

  (* tegged union of the different kinds of global declarations *)
    datatype dcl_kind
      = CONST of AST.var_dcl
      | INPUT of (AST.var_dcl * string option)
      | OTHER of AST.global_dcl
      | ERROR

    fun chkDcl (env, cxt, dcl) = (case dcl
	   of PT.GD_Mark m => chkDcl (E.withEnvAndContext (env, cxt, m))
	    | PT.GD_Const(ty, {span, tree=x}, optDefn) => let
		val ty = CheckType.check (env, cxt, ty)
		in
                  E.checkForRedef (env, cxt, x);
		  (ERROR, env) (* FIXME *)
		end
	    | PT.GD_Input(ty, {span, tree=x}, optDesc, optDefn) => let
                val ty = CheckType.check (env, cxt, ty)
                val x' = Var.new(x, location(cxt, span), Var.InputVar, ty)
                val dcl : AST.var_dcl = (case optDefn
                       of NONE => (x', NONE)
                        | SOME e => let
                            val (e', ty') = CheckExpr.check (env, cxt, e)
			    val e' = (case ConstExpr.eval (cxt, e')
				   of SOME v => ConstExpr.valueToExpr v
				    | NONE => e' (* error has already been reported *)
				  (* end case *))
                            in
                              case Util.coerceType (ty, (e', ty'))
                               of SOME e' => (x', SOME e')
                                | NONE => (
				    err (cxt, [
					S "definition of ", V x', S " has wrong type\n",
					S "  expected:  ", TY ty, S "\n",
					S "  but found: ", TY ty'
				      ]);
				    (x', NONE))
                              (* end case *)
                            end
                      (* end case *))
                in
                (* check that input variables have valid types *)
                  if not(TU.isValueType ty orelse TU.isImageType ty)
                    then err (cxt, [S "input variable ", V x', S " has invalid type ", TY ty])
                    else ();
                  E.checkForRedef (env, cxt, x);
                  E.recordProp (env, StrandUtil.HasGlobals);
                  E.recordProp (env, StrandUtil.HasInputs);
                  (INPUT(dcl, optDesc), E.insertGlobal(env, cxt, x, x'))
                end
	    | PT.GD_Var varDcl => let
		val (x, x', optDefn) = CheckStmt.checkVarDecl (env, cxt, Var.GlobalVar, varDcl)
		in
                  E.checkForRedef (env, cxt, x);
                  Env.recordProp (env, StrandUtil.HasGlobals);
                  (OTHER(AST.D_Var(x', optDefn)), E.insertGlobal(env, cxt, x, x'))
		end
	    | PT.GD_Func(ty, {span, tree=f}, params, body) => let
                val ty' = CheckType.check(env, cxt, ty)
                val env' = E.functionScope (env, ty', f)
                val (params', env') = CheckParams.check (env', cxt, Var.FunParam, params)
                val body' = (case body
                       of PT.FB_Expr e => let
                            val eTy = CheckExpr.check (env', cxt, e)
                            in
                              case Util.coerceType(ty', eTy)
                               of SOME e' => AST.S_Return e'
                                | NONE => (
				    err (cxt, [
					S "type of function body does not match return type\n",
					S "  expected: ", TY ty', S "\n",
					S "  but found: ", TY(#2 eTy)
				      ]);
				    AST.S_Block[])
                              (* end case *)
                            end
                        | PT.FB_Stmt s => CheckStmt.check(env', cxt, s)
                      (* end case *))
                val fnTy = Ty.T_Fun(List.map Var.monoTypeOf params', ty')
                val f' = Var.new (f, location (cxt, span), AST.FunVar, fnTy)
                in
(* QUESTION: should we also check for redefinition of basis functions? *)
                  E.checkForRedef (env, cxt, f);
                  (OTHER(AST.D_Func(f', params', body')), E.insertFunc(env, cxt, f, f'))
                end
	  (* end case *))

    fun check (env, cxt, globs) = let
	  fun chk (env, [], cdecls, idecls, gdecls) = {
		  const_dcls = List.rev cdecls,
		  input_dcls = List.rev idecls,
		  other_dcls = List.rev gdecls,
		  env = env
		}
	    | chk (env, dcl::dcls, cdecls, idecls, gdecls) = (
		case chkDcl (env, cxt, dcl)
		 of (CONST dcl, env) => chk (env, dcls, dcl::cdecls, idecls, gdecls)
		  | (INPUT dcl, env) => chk (env, dcls, cdecls, dcl::idecls, gdecls)
		  | (OTHER dcl, env) => chk (env, dcls, cdecls, idecls, dcl::gdecls)
		  | (ERROR, env) => chk (env, dcls, cdecls, idecls, gdecls)
		(* end case *))
	  in
	    chk (env, globs, [], [], [])
	  end

  end

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