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/src/compiler/FLINT/cpsopt/infcnv.sml
ViewVC logotype

View of /sml/trunk/src/compiler/FLINT/cpsopt/infcnv.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1347 - (download) (annotate)
Thu Aug 28 21:59:15 2003 UTC (17 years, 1 month ago) by mblume
File size: 3368 byte(s)
implemented IntInf in Basis and compiler;
new version number; new bootfiles
(* infcnv.sml
 *
 * Expand out any remaining occurences of test_inf, trunc_inf, extend_inf,
 * and copy_inf.  These primops carry a second argument which is a
 * function that performs the operation for 32 bit precision.
 *
 * (C) 2003 The SML/NJ fellowship.
 *
 * Author: Matthias Blume (blume@tti-c.org)
 *)
structure InfCnv : sig

    val elim : { function : CPS.function,
		 mkKvar : unit -> LambdaVar.lvar,     (* new cont var. *)
		 mkI32var : unit -> LambdaVar.lvar }  (* new int32 var. *)
	       -> CPS.function

end = struct

    structure C = CPS

    fun elim { function = cfun, mkKvar, mkI32var } = let
	fun cexp (C.RECORD (rk, xl, v, e)) =
	      C.RECORD (rk, xl, v, cexp e)
	  | cexp (C.SELECT (i, x, v, t, e)) =
	      C.SELECT (i, x, v, t, cexp e)
	  | cexp (C.OFFSET (i, v, x, e)) =
	      C.OFFSET (i, v, x, cexp e)
	  | cexp (C.APP (x, xl)) =
	      C.APP (x, xl)
	  | cexp (C.FIX (fl, e)) =
	      C.FIX (map function fl, cexp e)
	  | cexp (C.SWITCH (x, v, el)) =
	      C.SWITCH (x, v, map cexp el)
	  | cexp (C.BRANCH (b, xl, v, e1, e2)) =
	      C.BRANCH (b, xl, v, cexp e1, cexp e2)
	  | cexp (C.SETTER (s, xl, e)) =
	      C.SETTER (s, xl, cexp e)
	  | cexp (C.LOOKER (l, xl, v, t, e)) =
	      C.LOOKER (l, xl, v, t, cexp e)
	  | cexp (C.PURE (C.P.copy_inf 32, [x, f], v, t, e)) =
	      let val k = mkKvar ()
		  val e' = cexp e
	      in
		  C.FIX ([(C.CONT, k, [v], [t], e')],
			 C.APP (f, [C.VAR k, x, C.INT 0]))
	      end
	  | cexp (C.PURE (C.P.extend_inf 32, [x, f], v, t, e)) =
	      let val k = mkKvar ()
		  val e' = cexp e
	      in
		  C.FIX ([(C.CONT, k, [v], [t], e')],
			 C.APP (f, [C.VAR k, x, C.INT 1]))
	      end
	  | cexp (C.ARITH (C.P.test_inf 32, [x, f], v, t, e) |
		  C.PURE (C.P.trunc_inf 32, [x, f], v, t, e)) =
	      let val k = mkKvar ()
		  val e' = cexp e
	      in
		  C.FIX ([(C.CONT, k, [v], [t], e')], C.APP (f, [C.VAR k, x]))
	      end
	  | cexp (C.ARITH (C.P.test_inf i, [x, f], v, t, e)) =
	      let val k = mkKvar ()
		  val v' = mkI32var ()
		  val e' = cexp e
	      in
		  C.FIX ([(C.CONT, k, [v'], [C.INT32t],
			   C.ARITH (C.P.test (32, i), [C.VAR v'], v, t, e'))],
			 C.APP (f, [C.VAR k, x]))
	      end
	  | cexp (C.ARITH (a, xl, v, t, e)) =
	      C.ARITH (a, xl, v, t, cexp e)
	  | cexp (C.PURE (C.P.trunc_inf i, [x, f], v, t, e)) =
	      let val k = mkKvar ()
		  val v' = mkI32var ()
		  val e' = cexp e
	      in
		  C.FIX ([(C.CONT, k, [v'], [C.INT32t],
			   C.PURE (C.P.trunc (32, i), [C.VAR v'], v, t, e'))],
			 C.APP (f, [C.VAR k, x]))
	      end
	  | cexp (C.PURE (C.P.copy_inf i, [x, f], v, t, e)) =
	      let val k = mkKvar ()
		  val v' = mkI32var ()
		  val e' = cexp e
	      in
		  C.FIX ([(C.CONT, k, [v], [t], e')],
			 C.PURE (C.P.copy (i, 32), [x], v', C.INT32t,
				 C.APP (f, [C.VAR k, C.VAR v', C.INT 0])))
	      end
	  | cexp (C.PURE (C.P.extend_inf i, [x, f], v, t, e)) =
	      let val k = mkKvar ()
		  val v' = mkI32var ()
		  val e' = cexp e
	      in
		  C.FIX ([(C.CONT, k, [v], [t], e')],
			 C.PURE (C.P.extend (i, 32), [x], v', C.INT32t,
				 C.APP (f, [C.VAR k, C.VAR v', C.INT 1])))
	      end
	  | cexp (C.PURE (p, xl, v, t, e)) =
	      C.PURE (p, xl, v, t, cexp e)
	  | cexp (C.RCC (k, s, p, xl, v, t, e)) =
	      C.RCC (k, s, p, xl, v, t, cexp e)

	and function (fk, f, vl, tl, e) = (fk, f, vl, tl, cexp e)
    in
	function cfun
    end
end

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