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

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