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

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/MiscUtil/profile/tell-env.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log 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