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/Semant/basics/inlinfo.sml
ViewVC logotype

View of /sml/trunk/src/compiler/Semant/basics/inlinfo.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1370 - (download) (annotate)
Mon Sep 15 03:38:25 2003 UTC (16 years, 11 months ago) by macqueen
File size: 1306 byte(s)
eliminate types from primop info
(* inlinfo.sml
 *
 * (C) 2001 Lucent Technologies, Bell Labs
 *)
structure InlInfo : INL_INFO = struct

    fun bug s = ErrorMsg.impossible ("InlInfo: " ^ s)

    exception E of PrimOp.primop   (* PRIMOP *)

    type inl_info = II.ii

    val INL_PRIM = II.Info o E
    val INL_STR = II.List
    val INL_NO = II.Null

    fun match i { inl_prim, inl_str, inl_no } =
	case i of
	    II.Info (E x) => inl_prim x
	  | II.Info _ => bug "bogus Info node"
	  | II.List l => inl_str l
	  | II.Null => inl_no ()

    fun prInfo i = let
	fun loop (i, acc) =
	    match i { inl_prim = fn p => PrimOp.prPrimop p :: acc,
		      inl_no = fn () => "<InlNo>" :: acc,
		      inl_str = fn [] => "{}" :: acc
				 | h::t =>
				   "{" :: loop (h,
						foldr (fn (x, a) =>
							  "," :: loop (x, a))
						      ("}" :: acc)
						      t) }
    in
	concat (loop (i, []))
    end

    val selInfo = II.sel

    val isPrimInfo = II.isSimple

    fun isPrimCallcc (II.Info (E (PrimOp.CALLCC | PrimOp.CAPTURE))) = true
      | isPrimCallcc _ = false

    fun pureInfo (II.Info (E p)) =
	let fun isPure PrimOp.CAST = true
	      | isPure _ = false
	(* val isPure = PrimOp.purePrimop *)
	in
	    isPure p
	end
      | pureInfo _ = false

    val mkPrimInfo = INL_PRIM
    val mkStrInfo = INL_STR
    val nullInfo = INL_NO
end

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