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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 413 - (download) (annotate)
Sat Oct 16 15:39:31 2010 UTC (8 years, 5 months ago) by jhr
File size: 4416 byte(s)
  More work on checking
(* check-il-fn.sml
 *
 * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
 * All rights reserved.
 *
 * Correctness checker for SSA-based ILs.
 *)

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 argument types
   * are given.  Returns NONE if the argument types are
   * invalid for the IL.
   *)
    val typeOfCons : ty list -> ty option

  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.
   *)
    fun check : string * IL.program -> bool

  end = struct

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

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

    fun err errBuf toks = let
	  fun tok2str NL = "\n  ** "
	    | tok2str (S s) = 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 chkAssign errFn (bvs, y, rhs) = let
	  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.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.CONS xs => (
		    List.app checkVar xs;
		    case OpTy.typeOfCons (List.map V.ty xs)
		     of NONE => errFn [S "invalid ", S(IL.assignToString(y, rhs))]
		      | SOME ty => if Ty.same(V.ty y, ty)
			  then ()
			  else tyError (V.ty y, ty)
		    (* end case *))
	      (* end case *);
	      VSet.add(bvs, y)
	    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{globals, globalInit, actors}) = let
	  val errBuf = ref []
	  val errFn = errFn 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 *))
	  in
(* FIXME: check the program *)
	    final()
	  end

  end

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