Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/semant/primitive.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 272, Wed May 12 07:09:28 1999 UTC revision 286, Fri May 21 07:47:16 1999 UTC
# Line 1  Line 1 
1    (*
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  signature PRIMITIVE = sig  signature PRIMITIVE = sig
10    
11        type configuration
12      type primitive      type primitive
13    
14      val fromString : string -> primitive      val eq : primitive * primitive -> bool
15    
16      val exports: primitive -> SymbolSet.set      val fromString : string -> primitive option
17        val toString : primitive -> string
18    
19        (* the domain of (lookup p) must always properly include (exports p) *)
20        val exports : configuration -> primitive -> SymbolSet.set
21        val lookup : configuration -> primitive -> Symbol.symbol -> DAEnv.value
22    
23        val configuration :
24            { basis: GenericVC.Environment.environment }
25            -> configuration
26  end  end
27    
28  structure Primitive :> PRIMITIVE = struct  structure Primitive :> PRIMITIVE = struct
29    
30      type primitive = Dummy.t      structure BE = GenericVC.BareEnvironment
31        structure DE = DAEnv
32    
33        (* For now, we only know about the "basis".
34         * This is for testing only -- the basis will become a real
35         * "non-primitive" library, and there will be other primitives
36         * that are used to implement the basis. *)
37        datatype primitive =
38            BASIS
39    
40        type pinfo = { exports : SymbolSet.set,
41                       lookup : Symbol.symbol -> DE.value }
42    
43        type configuration = primitive -> pinfo
44    
45        fun eq (p1 : primitive, p2) = p1 = p2
46    
47        fun fromString "basis" = SOME BASIS
48          | fromString _ = NONE
49    
50        fun toString BASIS = "basis"
51    
52        fun exports (cfg: configuration) p = #exports (cfg p)
53        fun lookup (cfg: configuration) p = #lookup (cfg p)
54    
55        fun configuration { basis } = let
56            fun l2s l = let
57                fun addModule (sy, set) =
58                    case Symbol.nameSpace sy of
59                        (Symbol.STRspace | Symbol.SIGspace |
60                         Symbol.FCTspace | Symbol.FSIGspace) =>
61                            SymbolSet.add (set, sy)
62                      | _ => set
63            in
64                foldl addModule SymbolSet.empty l
65            end
66    
67            fun cvt_fctenv { symbols, look } =
68                { looker = cvt_result o look, domain = l2s o symbols }
69    
70            and cvt_result (BE.CM_ENV cme) = SOME (DE.FCTENV (cvt_fctenv cme))
71              | cvt_result BE.CM_NONE = NONE
72    
73      fun fromString s = Dummy.f ()          val sb = BE.staticPart (GenericVC.CoerceEnv.e2b basis)
74      fun exports p = Dummy.f ()          val { domain, looker } =
75                cvt_fctenv { symbols = fn () => BE.catalogEnv sb,
76                             look = BE.cmEnvOfModule sb }
77            val pinfo = { exports = domain (), lookup = valOf o looker }
78    
79            fun cfg BASIS = pinfo
80        in
81            cfg
82        end
83  end  end

Legend:
Removed from v.272  
changed lines
  Added in v.286

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