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 279, Tue May 18 08:10:36 1999 UTC revision 286, Fri May 21 07:47:16 1999 UTC
# Line 8  Line 8 
8   *)   *)
9  signature PRIMITIVE = sig  signature PRIMITIVE = sig
10    
11        type configuration
12      type primitive      type primitive
13    
14      val eq : primitive * primitive -> bool      val eq : primitive * primitive -> bool
# Line 16  Line 17 
17      val toString : primitive -> string      val toString : primitive -> string
18    
19      (* the domain of (lookup p) must always properly include (exports p) *)      (* the domain of (lookup p) must always properly include (exports p) *)
20      val exports: primitive -> SymbolSet.set      val exports : configuration -> primitive -> SymbolSet.set
21      val lookup: primitive -> Symbol.symbol -> GenericVC.BareEnvironment.cmEnv      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      datatype primitive = CORE | HELPER      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      fun eq (p1 : primitive, p2) = p1 = p2
46    
47      fun fromString "primitive_core" = SOME CORE      fun fromString "basis" = SOME BASIS
       | fromString "primitive_helper" = SOME HELPER  
48        | fromString _ = NONE        | fromString _ = NONE
49    
50      fun toString CORE = "primitive_core"      fun toString BASIS = "basis"
51        | toString HELPER = "primitive_helper"  
52        fun exports (cfg: configuration) p = #exports (cfg p)
53        fun lookup (cfg: configuration) p = #lookup (cfg p)
54    
55      fun exports p = (ignore Dummy.v; SymbolSet.empty)      fun configuration { basis } = let
56      fun lookup p s = (ignore Dummy.v; GenericVC.BareEnvironment.CM_NONE)          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            val sb = BE.staticPart (GenericVC.CoerceEnv.e2b basis)
74            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.279  
changed lines
  Added in v.286

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