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 299 - (view) (download)

1 : blume 274 (*
2 :     * "Primitive" classes in CM.
3 :     * - 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 279 val eq : primitive * primitive -> bool
15 :    
16 : blume 274 val fromString : string -> primitive option
17 : blume 273 val toString : primitive -> string
18 : blume 272
19 : blume 299 val pervasive : configuration -> GenericVC.Environment.environment
20 :     val corenv : configuration -> GenericVC.BareEnvironment.staticEnv
21 : blume 295
22 : blume 278 (* the domain of (lookup p) must always properly include (exports p) *)
23 : blume 286 val exports : configuration -> primitive -> SymbolSet.set
24 :     val lookup : configuration -> primitive -> Symbol.symbol -> DAEnv.value
25 : blume 295 val env : configuration -> primitive -> GenericVC.Environment.environment
26 :     val pidInfo : configuration -> primitive
27 :     -> { statpid: GenericVC.PersStamps.persstamp,
28 :     sympid: GenericVC.PersStamps.persstamp,
29 :     ctxt: GenericVC.Environment.staticEnv }
30 : blume 286
31 :     val configuration :
32 :     { basis: GenericVC.Environment.environment }
33 :     -> configuration
34 : blume 270 end
35 :    
36 : blume 272 structure Primitive :> PRIMITIVE = struct
37 : blume 270
38 : blume 286 structure BE = GenericVC.BareEnvironment
39 : blume 294 structure E = GenericVC.Environment
40 : blume 286 structure DE = DAEnv
41 : blume 270
42 : blume 286 (* For now, we only know about the "basis".
43 :     * This is for testing only -- the basis will become a real
44 :     * "non-primitive" library, and there will be other primitives
45 :     * that are used to implement the basis. *)
46 :     datatype primitive =
47 :     BASIS
48 :    
49 :     type pinfo = { exports : SymbolSet.set,
50 : blume 294 lookup : Symbol.symbol -> DE.value,
51 : blume 295 env : GenericVC.Environment.environment }
52 : blume 286
53 :     type configuration = primitive -> pinfo
54 :    
55 : blume 279 fun eq (p1 : primitive, p2) = p1 = p2
56 :    
57 : blume 286 fun fromString "basis" = SOME BASIS
58 : blume 274 | fromString _ = NONE
59 :    
60 : blume 286 fun toString BASIS = "basis"
61 : blume 274
62 : blume 299 fun pervasive c = Dummy.f ()
63 :     fun corenv c = Dummy.f ()
64 : blume 295
65 : blume 286 fun exports (cfg: configuration) p = #exports (cfg p)
66 :     fun lookup (cfg: configuration) p = #lookup (cfg p)
67 : blume 295 fun env (cfg: configuration) p = #env (cfg p)
68 : blume 286
69 :     fun configuration { basis } = let
70 : blume 294
71 :     fun gen_pinfo e = let
72 :     fun l2s l = let
73 :     fun addModule (sy, set) =
74 :     case Symbol.nameSpace sy of
75 :     (Symbol.STRspace | Symbol.SIGspace |
76 :     Symbol.FCTspace | Symbol.FSIGspace) =>
77 : blume 286 SymbolSet.add (set, sy)
78 : blume 294 | _ => set
79 :     in
80 :     foldl addModule SymbolSet.empty l
81 :     end
82 : blume 286
83 : blume 294 fun cvt_fctenv { symbols, look } =
84 :     { looker = cvt_result o look, domain = l2s o symbols }
85 : blume 286
86 : blume 294 and cvt_result (BE.CM_ENV cme) = SOME (DE.FCTENV (cvt_fctenv cme))
87 :     | cvt_result BE.CM_NONE = NONE
88 : blume 286
89 : blume 294 val sb = BE.staticPart (GenericVC.CoerceEnv.e2b e)
90 : blume 286
91 : blume 294 val { domain, looker } =
92 :     cvt_fctenv { symbols = fn () => BE.catalogEnv sb,
93 :     look = BE.cmEnvOfModule sb }
94 :     in
95 : blume 295 { exports = domain (), lookup = valOf o looker, env = e }
96 : blume 294 end
97 :    
98 :     val basis_pinfo = gen_pinfo basis
99 :     fun cfg BASIS = basis_pinfo
100 : blume 286 in
101 :     cfg
102 :     end
103 : blume 295 fun pidInfo c _ = Dummy.f ()
104 : blume 270 end

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