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/cm/semant/primitive.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/semant/primitive.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : blume 274 (*
2 : blume 323 * "Primitives".
3 : blume 274 * - provide access to compiler internals in an orderly fashion
4 :     *
5 :     * (C) 1999 Lucent Technologies, Bell Laboratories
6 :     *
7 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
8 :     *)
9 : blume 270 signature PRIMITIVE = sig
10 :    
11 : blume 286 type configuration
12 : blume 270 type primitive
13 :    
14 : blume 323 type pidInfo = { statpid: GenericVC.PersStamps.persstamp,
15 : blume 461 sympid: GenericVC.PersStamps.persstamp,
16 :     ctxt: GenericVC.ModuleId.Set.set }
17 : blume 323
18 : blume 279 val eq : primitive * primitive -> bool
19 :    
20 : blume 323 val fromString : configuration -> string -> primitive option
21 : blume 273 val toString : primitive -> string
22 : blume 272
23 : blume 323 val toIdent : configuration -> primitive -> char
24 :     val fromIdent : configuration -> char -> primitive option
25 : blume 304
26 : blume 301 val reqpriv : primitive -> StringSet.set
27 : blume 295
28 : blume 278 (* the domain of (lookup p) must always properly include (exports p) *)
29 : blume 286 val exports : configuration -> primitive -> SymbolSet.set
30 : blume 309 val da_env : configuration -> primitive -> DAEnv.env
31 : blume 295 val env : configuration -> primitive -> GenericVC.Environment.environment
32 : blume 323 val pidInfo : configuration -> primitive -> pidInfo
33 : blume 398 val iinfo : configuration -> primitive -> IInfo.info
34 : blume 286
35 : blume 323 type pspec = { name: string,
36 :     env: GenericVC.Environment.environment,
37 :     pidInfo: pidInfo }
38 :    
39 :     val configuration : pspec list -> configuration
40 : blume 360
41 :     val primEnvConf : configuration
42 : blume 270 end
43 :    
44 : blume 272 structure Primitive :> PRIMITIVE = struct
45 : blume 270
46 : blume 286 structure BE = GenericVC.BareEnvironment
47 : blume 294 structure E = GenericVC.Environment
48 : blume 286 structure DE = DAEnv
49 : blume 360 structure PS = GenericVC.PersStamps
50 :     structure SE = GenericVC.CMStaticEnv
51 : blume 270
52 : blume 323 type primitive = string
53 : blume 286
54 : blume 461 type pidInfo =
55 :     { statpid: PS.persstamp, sympid: PS.persstamp,
56 :     ctxt: GenericVC.ModuleId.Set.set }
57 : blume 286
58 : blume 323 type pinfo = { name: string,
59 :     exports: SymbolSet.set,
60 :     da_env: DE.env,
61 : blume 360 env: E.environment,
62 : blume 323 pidInfo: pidInfo,
63 :     ident: char }
64 : blume 286
65 : blume 323 type pspec = { name: string,
66 : blume 360 env: E.environment,
67 : blume 323 pidInfo: pidInfo }
68 :    
69 :     type configuration =
70 :     pinfo StringMap.map * primitive Vector.vector
71 :    
72 : blume 279 fun eq (p1 : primitive, p2) = p1 = p2
73 :    
74 : blume 323 fun fromString ((sm, v): configuration) s =
75 :     case StringMap.find (sm, s) of
76 :     NONE => NONE
77 :     | SOME _ => SOME s
78 : blume 274
79 : blume 323 fun toString (p: primitive) = p
80 : blume 274
81 : blume 323 fun get ((sm, v): configuration) p =
82 :     case StringMap.find (sm, p) of
83 :     NONE => GenericVC.ErrorMsg.impossible "Primitive: bad primitive"
84 :     | SOME i => i
85 : blume 304
86 : blume 323 infix o'
87 :     fun (f o' g) x y = f (g x y)
88 : blume 304
89 : blume 323 val exports = #exports o' get
90 :     val da_env = #da_env o' get
91 :     val env = #env o' get
92 :     val pidInfo = #pidInfo o' get
93 :     val toIdent = #ident o' get
94 : blume 295
95 : blume 398 fun iinfo c p = let
96 :     val e = env c p
97 : blume 461 val { statpid, sympid, ctxt } = pidInfo c p
98 : blume 398 val ste = E.staticPart e
99 :     val sye = E.symbolicPart e
100 :     in
101 : blume 461 { statenv = fn () => { env = ste, ctxt = ctxt },
102 : blume 398 symenv = fn () => sye,
103 :     statpid = statpid,
104 :     sympid = sympid }
105 :     end
106 :    
107 : blume 323 val reqpriv = StringSet.singleton o toString
108 : blume 301
109 : blume 323 fun fromIdent ((sm, v): configuration) c = let
110 :     val p = Char.ord c
111 :     in
112 :     if p < Vector.length v then SOME (Vector.sub (v, p)) else NONE
113 :     end
114 : blume 286
115 : blume 323 fun configuration l = let
116 : blume 358 (* First we make the list into a map to become independent of the
117 :     * order of the elements. *)
118 :     val m = foldl (fn (x: pspec, m) => StringMap.insert (m, #name x, x))
119 :     StringMap.empty l
120 : blume 323 fun gen_pinfo ({ name, env, pidInfo }, i) = let
121 : blume 355 val es2bs = GenericVC.CoerceEnv.es2bs
122 :     val (da_env, mkExports) =
123 :     Statenv2DAEnv.cvt (es2bs (E.staticPart env))
124 : blume 294 in
125 : blume 323 { name = name, exports = mkExports (), da_env = da_env,
126 :     env = env, pidInfo = pidInfo,
127 :     ident = Char.chr i }
128 : blume 294 end
129 : blume 323 fun one (ps, (sm, sl, i)) =
130 :     (StringMap.insert (sm, #name ps, gen_pinfo (ps, i)),
131 :     #name ps :: sl,
132 :     i + 1)
133 : blume 358 val (sm, sl, _) = StringMap.foldl one (StringMap.empty, [], 0) m
134 : blume 286 in
135 : blume 353 (sm, Vector.fromList (rev sl))
136 : blume 286 end
137 : blume 360
138 :     val primEnvConf = let
139 :     (* We could actually go and calculate the actual pid of primEnv.
140 :     * But in reality it's pretty pointless to do so... *)
141 :     val bogusPid = PS.fromBytes (Byte.stringToBytes "0123456789abcdef")
142 :     val pspec = { name = "primitive",
143 :     env = E.mkenv { static = E.primEnv,
144 :     symbolic = E.symbolicPart E.emptyEnv,
145 :     dynamic = E.dynamicPart E.emptyEnv },
146 :     pidInfo = { statpid = bogusPid,
147 : blume 461 sympid = bogusPid,
148 :     ctxt = GenericVC.ModuleId.Set.empty } }
149 : blume 360 in
150 :     configuration [pspec]
151 :     end
152 : blume 270 end

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