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 398 - (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 :     sympid: GenericVC.PersStamps.persstamp,
16 :     ctxt: GenericVC.Environment.staticEnv }
17 :    
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 360 type pidInfo = { statpid: PS.persstamp, sympid: PS.persstamp,
55 :     ctxt: E.staticEnv }
56 : blume 286
57 : blume 323 type pinfo = { name: string,
58 :     exports: SymbolSet.set,
59 :     da_env: DE.env,
60 : blume 360 env: E.environment,
61 : blume 323 pidInfo: pidInfo,
62 :     ident: char }
63 : blume 286
64 : blume 323 type pspec = { name: string,
65 : blume 360 env: E.environment,
66 : blume 323 pidInfo: pidInfo }
67 :    
68 :     type configuration =
69 :     pinfo StringMap.map * primitive Vector.vector
70 :    
71 : blume 279 fun eq (p1 : primitive, p2) = p1 = p2
72 :    
73 : blume 323 fun fromString ((sm, v): configuration) s =
74 :     case StringMap.find (sm, s) of
75 :     NONE => NONE
76 :     | SOME _ => SOME s
77 : blume 274
78 : blume 323 fun toString (p: primitive) = p
79 : blume 274
80 : blume 323 fun get ((sm, v): configuration) p =
81 :     case StringMap.find (sm, p) of
82 :     NONE => GenericVC.ErrorMsg.impossible "Primitive: bad primitive"
83 :     | SOME i => i
84 : blume 304
85 : blume 323 infix o'
86 :     fun (f o' g) x y = f (g x y)
87 : blume 304
88 : blume 323 val exports = #exports o' get
89 :     val da_env = #da_env o' get
90 :     val env = #env o' get
91 :     val pidInfo = #pidInfo o' get
92 :     val toIdent = #ident o' get
93 : blume 295
94 : blume 398 fun iinfo c p = let
95 :     val e = env c p
96 :     val { statpid, sympid, ... } = pidInfo c p
97 :     val ste = E.staticPart e
98 :     val sye = E.symbolicPart e
99 :     in
100 :     { statenv = fn () => ste,
101 :     symenv = fn () => sye,
102 :     statpid = statpid,
103 :     sympid = sympid }
104 :     end
105 :    
106 : blume 323 val reqpriv = StringSet.singleton o toString
107 : blume 301
108 : blume 323 fun fromIdent ((sm, v): configuration) c = let
109 :     val p = Char.ord c
110 :     in
111 :     if p < Vector.length v then SOME (Vector.sub (v, p)) else NONE
112 :     end
113 : blume 286
114 : blume 323 fun configuration l = let
115 : blume 358 (* First we make the list into a map to become independent of the
116 :     * order of the elements. *)
117 :     val m = foldl (fn (x: pspec, m) => StringMap.insert (m, #name x, x))
118 :     StringMap.empty l
119 : blume 323 fun gen_pinfo ({ name, env, pidInfo }, i) = let
120 : blume 355 val es2bs = GenericVC.CoerceEnv.es2bs
121 :     val (da_env, mkExports) =
122 :     Statenv2DAEnv.cvt (es2bs (E.staticPart env))
123 : blume 294 in
124 : blume 323 { name = name, exports = mkExports (), da_env = da_env,
125 :     env = env, pidInfo = pidInfo,
126 :     ident = Char.chr i }
127 : blume 294 end
128 : blume 323 fun one (ps, (sm, sl, i)) =
129 :     (StringMap.insert (sm, #name ps, gen_pinfo (ps, i)),
130 :     #name ps :: sl,
131 :     i + 1)
132 : blume 358 val (sm, sl, _) = StringMap.foldl one (StringMap.empty, [], 0) m
133 : blume 286 in
134 : blume 353 (sm, Vector.fromList (rev sl))
135 : blume 286 end
136 : blume 360
137 :     val primEnvConf = let
138 :     (* We could actually go and calculate the actual pid of primEnv.
139 :     * But in reality it's pretty pointless to do so... *)
140 :     val bogusPid = PS.fromBytes (Byte.stringToBytes "0123456789abcdef")
141 :     val pspec = { name = "primitive",
142 :     env = E.mkenv { static = E.primEnv,
143 :     symbolic = E.symbolicPart E.emptyEnv,
144 :     dynamic = E.dynamicPart E.emptyEnv },
145 :     pidInfo = { statpid = bogusPid,
146 :     sympid = bogusPid,
147 :     ctxt = SE.empty } }
148 :     in
149 :     configuration [pspec]
150 :     end
151 : blume 270 end

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