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

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