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 410 - (download) (annotate)
Fri Oct 15 19:31:53 2010 UTC (8 years, 8 months ago) by jhr
File size: 3150 byte(s)
  Working on checking code
(* 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

  end = struct

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

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

    fun err errBuf toks = let
	  fun tok2str (S s) = s
	    | tok2str (V x) = Var.nameOf x
	    | tok2str (TY ty) = TU.toString ty
	    | tok2str (TYS []) = "()"
	    | tok2str (TYS[ty]) = TU.toString ty
	    | tok2str (TYS tys) = String.concat[
		  "(", String.concatWith " * " (List.map TU.toString tys), ")"
		]
	  in
	    errBuf := concat ("**** Error: " :: List.map tok2str toks)
	      :: !errBuf
	  end

    fun checkVar errFn bvs x = if VSet.member(x, bvs)
	  then ()
	  else errFn [S "variable ", V x, " is not bound\n"]

    fun chkAssign errFn (bvs, y, rhs) = (
	  (* check that y is not bound twice *)
	    if VSet.member(y, bvs)
	      then errFn [S "variable ", V y, " is bound twice\n"]
	      else ();
	    case rhs
	     of IL.VAR x => (
		  checkVar bvs x;
		  if Ty.same(V.ty y, V.ty x)
		    then ()
		    else errFn [
			S "type mismatch: ", T(V.ty y), S " <> ",
			T (V.ty x), S "\n"
		      ])
	      | IL.LIT lit => let
		  val ty = (case lit
			 of IL.Int _ => Ty.IntTy
			  | IL.Float _ => Ty.realTy
			  | IL.String _ => Ty.StringTy
			  | IL.Bool _ => Ty.BoolTy
			(* end case *))
		  in
		    if Ty.same(V.ty y, ty)
		      then ()
		      else errFn [
			S "type mismatch: ", T(V.ty y), S " <> ",
			T ty, S "\n"
		      ]
		  end
	      | IL.OP(rator, xs) => let
		  val (resTy, argTys) = OpTy.sigOf rator
		  in
		    List.app (checkVar bvs) xs;
		    if Ty.same(V.ty y, resTy)
		      then ()
		      else errFn [
			S "type mismatch: ", T(V.ty y), S " <> ",
			T resTy, S "\n"
		      ];
		    if ListPair.allEq (fn (x, ty) => Ty.same(V.ty x, ty)) (xs, argsTys)
		      then ()
		      else (* error *)
		  end
	      | IL.CONS xs => (
		  List.app (checkVar bvs) xs;
		  case OpTy.typeOfCons (List.map V.ty xs)
		   of NONE => (* error *)
		    | SOME ty => if Ty.same(V.ty y, ty)
			then ()
			else (* error *)
		  (* end case *))
	    (* end case *);
	    VSet.add(bvs, y))

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

  end

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