Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/compiler/CodeGen/cpscompile/cps-treeify.sml
ViewVC logotype

View of /sml/trunk/compiler/CodeGen/cpscompile/cps-treeify.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5199 - (download) (annotate)
Sun May 26 20:25:42 2019 UTC (4 months, 2 weeks ago) by jhr
File size: 2326 byte(s)
  header comments
(* cps-treeify.sml
 *
 * COPYRIGHT (c) 2019 The Fellowship of SML/NJ (http://www.smlnj.org)
 * All rights reserved.
 *)

signature CPS_TREEIFY = sig
  datatype treeify = TREEIFY | COMPUTE | DEAD

  val usage : CPS.function list -> (CPS.lvar -> treeify)
end


structure CpsNoTreeify : CPS_TREEIFY =
struct
  datatype treeify = TREEIFY | COMPUTE | DEAD
  val usage = fn _ => fn _ => COMPUTE
end



structure CpsTreeify : CPS_TREEIFY =
struct
  structure C = CPS

  datatype treeify = TREEIFY | COMPUTE | DEAD

  fun error msg = ErrorMsg.impossible ("FPStack." ^ msg)

  fun usage fl = let
   (* Table to record number of uses *)
    exception UseCntTbl
    val useCntTbl : treeify  Intmap.intmap = Intmap.new(32, UseCntTbl)
    val uses = Intmap.mapWithDefault (useCntTbl,DEAD)
    val addCntTbl = Intmap.add useCntTbl
    fun addUse v =
      case uses v
       of DEAD => addCntTbl(v, TREEIFY)
        | TREEIFY => addCntTbl(v, COMPUTE)
	| _ => ()

    fun addValue(C.VAR v) = addUse v
      | addValue _ = ()
    fun addValues [] = ()
      | addValues(C.VAR v::vl) = (addUse v; addValues vl)
      | addValues(_::vl) = addValues vl

    fun cntUsesCps(C.RECORD(_, vl, w, e)) =
	 (addValues (map #1 vl); cntUsesCps e)
      | cntUsesCps(C.SELECT(i, v, x, _, e)) = (addValue v; cntUsesCps e)
      | cntUsesCps(C.OFFSET(i, v, x, e)) = (addValue v; cntUsesCps e)
      | cntUsesCps(C.APP(v, vl)) = (addValue v; addValues vl)
      | cntUsesCps(C.FIX _) = error "pass1: FIX"
      | cntUsesCps(C.SWITCH(v, _, el)) = (addValue v; app cntUsesCps el)
      | cntUsesCps(C.BRANCH(_, vl, _, c1, c2)) =
	 (addValues vl; cntUsesCps c1; cntUsesCps c2)
      | cntUsesCps(C.SETTER(_, vl, e)) = (addValues vl; cntUsesCps e)
      | cntUsesCps(C.LOOKER(looker, vl, x, _, e)) =
	 (addValues vl;
	  (* floating subscript cannot move past a floating update.
	   * For now subscript operations cannot be treeified.
	   * This is hacked by making it (falsely) used more than once.
	   *)
	  case looker
	   of C.P.numsubscript{kind=C.P.FLOAT _} => (addUse x; addUse x)
	    | _ => ()
          (*esac*);
	  cntUsesCps e)
      | cntUsesCps(C.ARITH(_, vl, _, _, e)) = (addValues vl; cntUsesCps e)
      | cntUsesCps(C.PURE(_, vl, _, _, e)) = (addValues vl; cntUsesCps e)
  in
    app (fn (_, _, _, _, e) => cntUsesCps e) fl;
    uses

  end
end

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