Annotation of /sml/trunk/src/compiler/MiscUtil/profile/tell-env.sml

Parent Directory | Revision Log

---

Revision 419 - (view) (download)

1 :	monnier	245	(* tell-env.sml
2 :			*
3 :			* COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :			*
5 :			* This provides an abstract interface to the static environments for
6 :			* the profiler to use.
7 :			*
8 :			*)
9 :
10 :			signature TELL_ENV =
11 :			sig
12 :			type symbol
13 :			type env = CMStaticEnv.staticEnv
14 :			type binding
15 :			type ty
16 :			val name : symbol -> string
17 :			val components : env -> (symbol * binding) list
18 :			val strBind : binding -> env option
19 :			val valBind : binding -> ty option
20 :			val funTy : ty -> (ty*ty) option
21 :			end
22 :
23 :			structure TellEnv :> TELL_ENV =
24 :			struct
25 :			type symbol = Symbol.symbol
26 :			type env = CMStaticEnv.staticEnv
27 :			type binding = Bindings.binding
28 :			type ty = Types.ty
29 :			val name = Symbol.name
30 :
31 :			fun components _ = []
32 :			fun strBind _ = NONE
33 :			fun valBind _ = NONE
34 :			fun funTy _ = NONE
35 :
36 :			(*
37 :			fun components e =
38 :			let val bindings = ref (nil: (symbol * binding) list)
39 :			fun get x = bindings := x :: !bindings
40 :			in Env.app get (Env.consolidate e);
41 :			!bindings
42 :			end
43 :
44 :			fun strBind(Modules.STRbind(Modules.STRvar{access,binding,...})) =
45 :			SOME(ModuleUtil.makeEnv(binding,access))
46 :			| strBind _ = NONE
47 :
48 :			fun valBind(Modules.VARbind(Variables.VALvar{access=Access.INLINE _,...})) = NONE
49 :			| valBind(Modules.VARbind(Variables.VALvar{typ=ref ty,...})) = SOME ty
50 :			| valBind _ = NONE
51 :
52 :			fun funTy ty =
53 :			let val ty' = TypesUtil.headReduceType ty
54 :			in if BasicTypes.isArrowType ty'
55 :			then SOME(BasicTypes.domain ty', BasicTypes.range ty')
56 :			else NONE
57 :			end
58 :			*)
59 :			end
60 :
61 :

---

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