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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2445 - (download) (annotate)
Thu Sep 26 17:40:17 2013 UTC (5 years, 11 months ago) by cchiw
File size: 13389 byte(s)
value numbering?
(* 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.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))])
                | IL.EINAPP(ein, xs) => ()
              (* 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.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