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

SCM Repository

[diderot] View of /branches/lamont_dev/src/compiler/IL/check-il-fn.sml
ViewVC logotype

View of /branches/lamont_dev/src/compiler/IL/check-il-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1868 - (download) (annotate)
Fri May 11 03:17:42 2012 UTC (7 years, 5 months ago) by lamonts
File size: 11214 byte(s)
Major Progress with the FOREACH statment
(* check-il-fn.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot-language.cs.uchicago.edu)
 * All rights reserved.
 *
 * Correctness checker for SSA-based ILs.
 *
 * TODO:
 *	check that the state variables and method stateOut variables are all defined.
 *)

signature OPERATOR_TY =
  sig
    type rator
    type ty

  (* returns the signature of an operator as (rng, dom). *)
    val sigOf : rator -> ty * ty list

  (* return the type of a CONS, where the first argument is the annotated type
   * and the second argument is the list of argument types.  Returns false if
   * there is a type error.
   *)
    val typeOfCons : ty * ty list -> bool

  end

functor CheckILFn (

    structure IL : SSA
    structure OpTy : OPERATOR_TY
	where type rator = IL.Op.rator
	where type ty = IL.Ty.ty

  ) : sig

  (* check the program for type errors, etc.  The first argument will be used to
   * identify the phase that the check follows and the return result will be true
   * if any errors were detected.
   *)
    val check : string * IL.program -> bool

  end = struct

    structure IL = IL
    structure Ty = IL.Ty
    structure V = IL.Var
    structure VSet = V.Set

  (* forward analysis to determine the variables that are available in blocks *)
    structure Avail = ForwardDFAFn (
      struct

	structure IL = IL
	type t = VSet.set

	val bottom = VSet.empty

	fun join inputs = List.foldl VSet.union bottom inputs

	fun transfer (input, nd as IL.ND{kind, ...}) = (case kind
	       of IL.JOIN{phis, ...} => let
		  (* add the lhs of the phi node.  We do not remove the rhs variables, since
		   * after value numbering, they may have further uses.
		   *)
		    fun doPhi ((y, _), vs) = VSet.add(vs, y)
		    val output = List.foldl doPhi input (!phis)
		    in
		      output
		    end
        | IL.FOREACH{phis, ...} => let
		  (* add the lhs of the phi node.  We do not remove the rhs variables, since
		   * after value numbering, they may have further uses.
		   *)
		    fun doPhi ((y, _), vs) = VSet.add(vs, y)
		    val output = List.foldl doPhi input (!phis)
		    in
		      output
		    end
		| IL.ASSIGN{stm=(y, _), ...} => VSet.add(input, y)
		| IL.MASSIGN{stm=(ys, _, _), ...} => VSet.addList(input, ys)
		| _ => input
	       (* end case *))

	val same = VSet.equal

	fun toString vs = let
	      fun f (v, []) = [IL.Var.toString v, "}"]
		| f (v, l) = IL.Var.toString v :: "," :: l
	      in
		if VSet.isEmpty vs then "{}" else String.concat("{" :: VSet.foldl f [] vs)
	      end

      end)

    datatype token
      = NL | S of string | A of Atom.atom | V of IL.var | VTYS of IL.var list
      | TY of Ty.ty | TYS of Ty.ty list

    fun error errBuf toks = let
	  fun tok2str NL = "\n  ** "
	    | tok2str (S s) = s
	    | tok2str (A s) = Atom.toString s
	    | tok2str (V x) = V.toString x
	    | tok2str (VTYS xs) = tok2str(TYS(List.map V.ty xs))
	    | tok2str (TY ty) = Ty.toString ty
	    | tok2str (TYS []) = "()"
	    | tok2str (TYS[ty]) = Ty.toString ty
	    | tok2str (TYS tys) = String.concat[
		  "(", String.concatWith " * " (List.map Ty.toString tys), ")"
		]
	  in
	    errBuf := concat ("**** Error: " :: List.map tok2str toks)
	      :: !errBuf
	  end

    fun checkAssign errFn ((y, rhs), bvs) = let
	(* check a variable use *)
	  fun checkVar x = if VSet.member(bvs, x)
		then ()
		else errFn [
		    S "variable ", V x, S " is not bound in", NL,
		    S(IL.assignToString(y, rhs))
		  ]
	  fun tyError (ty1, ty2) = errFn [
		  S "type mismatch in \"", S(IL.assignToString (y, rhs)), S "\"",
		  NL, S "lhs: ", TY ty1, NL, S "rhs: ", TY ty2
		]
	  in
	    (* check that y is not bound twice *)
	      if VSet.member(bvs, y)
		then errFn [
		    S "variable ", V y, S " is bound twice in", NL,
		    S(IL.assignToString (y, rhs))
		  ]
		else ();
	      case rhs
	       of IL.STATE x =>
                    if Ty.same(V.ty y, IL.StateVar.ty x)
                      then ()
		      else tyError (V.ty y, IL.StateVar.ty x)
                | IL.VAR x => (
		    checkVar x;
		    if Ty.same(V.ty y, V.ty x)
		      then ()
		      else tyError (V.ty y, V.ty x))
		| IL.LIT lit => let
		    val ty = (case lit
			   of Literal.Int _ => Ty.intTy
			    | Literal.Float _ => Ty.realTy
			    | Literal.String _ => Ty.StringTy
			    | Literal.Bool _ => Ty.BoolTy
			  (* end case *))
		    in
		      if Ty.same(V.ty y, ty)
			then ()
			else tyError (V.ty y, ty)
		    end
		| IL.OP(rator, xs) => let
		    val (resTy, argTys) = OpTy.sigOf rator
		    in
		      List.app checkVar xs;
		      if Ty.same(V.ty y, resTy)
			then ()
			else  tyError (V.ty y, resTy);
		      if ListPair.allEq (fn (x, ty) => Ty.same(V.ty x, ty)) (xs, argTys)
			then ()
			else errFn [
			    S "argument type mismatch in \"", S(IL.assignToString (y, rhs)), S "\"",
			    NL, S "expected: ", TYS argTys,
			    NL, S "found:    ", VTYS xs
			  ]
		    end
		| IL.APPLY(name, xs) => () (* FIXME: need functor parameter for typing name *)
		| IL.CONS(ty, xs) => (
		    List.app checkVar xs;
		    if OpTy.typeOfCons (ty, List.map V.ty xs)
		      then if Ty.same(V.ty y, ty)
			then ()
			else tyError (V.ty y, ty)
		      else errFn [S "invalid ", S(IL.assignToString(y, rhs))]
		    (* end case *))
	      (* end case *);
	      VSet.add(bvs, y)
	    end

    fun checkMAssign errFn (stm as (ys, rator, xs), bvs) = let
        (* check that a lhs variable is not bound twice *)
          fun checkBind y = if VSet.member(bvs, y)
		then errFn [
		    S "variable ", V y, S " is bound twice in", NL,
		    S(IL.massignToString stm)
		  ]
		else ()
	(* check a variable use *)
	  fun checkVar x = if VSet.member(bvs, x)
		then ()
		else errFn [
		    S "variable ", V x, S " is not bound in", NL,
		    S(IL.massignToString stm)
		  ]
	  fun tyError (ty1, ty2) = errFn [
		  S "type mismatch in \"", S(IL.massignToString stm), S "\"",
		  NL, S "lhs: ", TY ty1, NL, S "rhs: ", TY ty2
		]
	  in
	    (* check that the lhs variables are not bound twice *)
	      List.app checkBind ys;
(* FIXME:
            (* check the types *)
              val (resTys, argTys) = OpTy.sigOf rator
              in
                List.app checkVar xs;
                if ListPair.allEq (fn (y, ty) => Ty.same(V.ty y, ty)) (ys, resTys)
                  then ()
                  else tyError (V.ty y, resTy);
                if ListPair.allEq (fn (x, ty) => Ty.same(V.ty x, ty)) (xs, argTys)
                  then ()
                  else errFn [
                      S "argument type mismatch in \"", S(IL.massignToString stm), S "\"",
                      NL, S "expected: ", TYS argTys,
                      NL, S "found:    ", VTYS xs
                    ]
              end
*)
	      VSet.addList(bvs, ys)
	    end

    fun checkPhi errFn bvs (y, xs) = let
	  val ty = V.ty y
	  in
	  (* check that y is not bound twice *)
	    if VSet.member(bvs, y)
	      then errFn [
		  S "variable ", V y, S " is bound twice in", NL,
		  S(IL.phiToString (y, xs))
		]
	      else ();
	  (* check that rhs vars have the correct type *)
	    if List.all (fn x => Ty.same(V.ty x, ty)) xs
	      then ()
	      else errFn [
		  S "type mismatch in \"", S(IL.phiToString (y, xs)), S "\"",
		  NL, S "lhs: ", TY ty, NL, S "rhs: ", VTYS xs
		]
	  end

    fun check (phase, IL.Program{props, globalInit, initially, strands}) = let
	  val errBuf = ref []
	  val errFn = error errBuf
	  fun final () = (case !errBuf
		 of [] => false
		  | errs => (
		      Log.msg(concat["********** IL Errors detected after ", phase, " **********\n"]);
		      List.app (fn msg => Log.msg(msg ^ "\n")) (List.rev errs);
		      true)
		(* end case *))
	  val checkPhi = checkPhi errFn
	  val checkAssign = checkAssign errFn
	  val checkMAssign = checkMAssign errFn
	  fun checkCFG (vs, cfg) = let
		val bvs = VSet.fromList vs
	      (* compute the variables available on entry to each block *)
		val nodes = Avail.analyse (bvs, cfg)
		fun checkNd (nd as IL.ND{kind, ...}) = (case kind
		       of IL.NULL => errFn [S "unexpected ", S(IL.Node.toString nd)]
			| IL.JOIN{phis, ...} =>
			    List.app (checkPhi (VSet.union(Avail.inValue nd, bvs))) (!phis)
			| IL.COND{cond, ...} =>
			    if VSet.member(Avail.inValue nd, cond)
			    orelse VSet.member(bvs, cond)
			      then ()
			      else errFn [S "unbound variable ", V cond, S " in conditional"]
            | IL.FOREACH{cond,phis,...} => 
			    if VSet.member(Avail.inValue nd, cond)
			    orelse VSet.member(bvs, cond)
			      then List.app (checkPhi (VSet.union(Avail.inValue nd, bvs))) (!phis)
			      else errFn [S "unbound variable ", V cond, S " in foreach conditional"]
            | IL.ASSIGN{stm, ...} =>
			    ignore (checkAssign (stm, VSet.union(Avail.inValue nd, bvs)))
			| IL.MASSIGN{stm, ...} =>
			    ignore (checkMAssign (stm, VSet.union(Avail.inValue nd, bvs)))
			| IL.NEW{strand, args, ...} => let
			    val bvs = VSet.union(Avail.inValue nd, bvs)
			  (* check a variable use *)
			    fun checkVar x = if VSet.member(bvs, x)
				  then ()
				  else errFn [
				      S "variable ", V x, S " is not bound in new ",
				      S(Atom.toString strand)
				    ]
			    in
			      List.app checkVar args
			    end
                        | IL.SAVE{lhs, rhs, ...} => let
			    val bvs = VSet.union(Avail.inValue nd, bvs)
                            in
                              if VSet.member(bvs, rhs)
                                then ()
                                else errFn [
                                    S "variable ", V rhs, S " is not bound in save ",
                                    S(IL.StateVar.toString lhs)
                                  ];
                              if Ty.same(IL.StateVar.ty lhs, V.ty rhs)
                                then ()
                                else errFn [
                                    S "type mismatch in \"", S(IL.StateVar.toString lhs),
                                    S " = ", S(V.toString rhs), S "\"",
                                    NL, S "lhs: ", TY(IL.StateVar.ty lhs),
                                    NL, S "rhs: ", TY(V.ty rhs)
                                  ]
                            end
			| _ => ()
		      (* end case *))
		in
		  List.app checkNd nodes;
		(* cleanup *)
		  Avail.scrub nodes
		end
	(* the globals are those variables that are live at the exit of the global initialization *)
	  val globals = IL.CFG.liveAtExit globalInit
	(* check a strand definition *)
	  fun checkStrand (IL.Strand{name, params, state, stateInit, methods}) = let
		val nStateVars = List.length state
		val extraVars = params @ globals
		fun checkMethod (IL.Method{name, body, ...}) = checkCFG (extraVars, body)
(*DEBUG*)handle ex => raise ex
		in
		  checkCFG (extraVars, stateInit)
(*DEBUG*)handle ex => raise ex;
		  List.app checkMethod methods
		end
        (* handle exceptions *)
          fun onExn exn = errFn [S "uncaught exception: ", S(exnMessage exn)]
	  in
	  (* check the global part *)
	    checkCFG ([], globalInit) handle ex => onExn ex;
(* FIXME: need to check initially *)
	  (* check the strands *)
	    (List.app checkStrand strands) handle ex => onExn ex;
	  (* check for errors *)
	    final()
	  end

  end

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