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 322, Tue Jun 8 09:36:16 1999 UTC revision 323, Wed Jun 9 06:16:22 1999 UTC
# Line 1  Line 1 
1  (*  (*
2   * "Primitive" classes in CM.   * "Primitives".
3   *   - provide access to compiler internals in an orderly fashion   *   - provide access to compiler internals in an orderly fashion
4   *   *
5   * (C) 1999 Lucent Technologies, Bell Laboratories   * (C) 1999 Lucent Technologies, Bell Laboratories
# Line 11  Line 11 
11      type configuration      type configuration
12      type primitive      type primitive
13    
14        type pidInfo = { statpid: GenericVC.PersStamps.persstamp,
15                         sympid: GenericVC.PersStamps.persstamp,
16                         ctxt: GenericVC.Environment.staticEnv }
17    
18      val eq : primitive * primitive -> bool      val eq : primitive * primitive -> bool
19    
20      val fromString : string -> primitive option      val fromString : configuration -> string -> primitive option
21      val toString : primitive -> string      val toString : primitive -> string
22    
23      val toIdent : primitive -> char      val toIdent : configuration -> primitive -> char
24      val fromIdent : char -> primitive option      val fromIdent : configuration -> char -> primitive option
25    
26      val reqpriv : primitive -> StringSet.set      val reqpriv : primitive -> StringSet.set
27    
# Line 25  Line 29 
29      val exports : configuration -> primitive -> SymbolSet.set      val exports : configuration -> primitive -> SymbolSet.set
30      val da_env : configuration -> primitive -> DAEnv.env      val da_env : configuration -> primitive -> DAEnv.env
31      val env : configuration -> primitive -> GenericVC.Environment.environment      val env : configuration -> primitive -> GenericVC.Environment.environment
32      val pidInfo : configuration -> primitive      val pidInfo : configuration -> primitive -> pidInfo
33          -> { statpid: GenericVC.PersStamps.persstamp,  
34               sympid: GenericVC.PersStamps.persstamp,      type pspec = { name: string,
35               ctxt: GenericVC.Environment.staticEnv }                     env: GenericVC.Environment.environment,
36                       pidInfo: pidInfo }
37    
38      val configuration :      val configuration : pspec list -> configuration
         { basis: GenericVC.Environment.environment }  
         -> configuration  
39  end  end
40    
41  structure Primitive :> PRIMITIVE = struct  structure Primitive :> PRIMITIVE = struct
# Line 41  Line 44 
44      structure E = GenericVC.Environment      structure E = GenericVC.Environment
45      structure DE = DAEnv      structure DE = DAEnv
46    
47      (* For now, we only know about the "basis".      type primitive = string
48       * This is for testing only -- the basis will become a real  
49       * "non-primitive" library, and there will be other primitives      type pidInfo = { statpid: GenericVC.PersStamps.persstamp,
50       * that are used to implement the basis. *)                       sympid: GenericVC.PersStamps.persstamp,
51      datatype primitive =                       ctxt: GenericVC.Environment.staticEnv }
         BASIS  
52    
53      type pinfo = { exports : SymbolSet.set,      type pinfo = { name: string,
54                       exports: SymbolSet.set,
55                     da_env : DE.env,                     da_env : DE.env,
56                     env : GenericVC.Environment.environment }                     env: GenericVC.Environment.environment,
57                       pidInfo: pidInfo,
58                       ident: char }
59    
60        type pspec = { name: string,
61                       env: GenericVC.Environment.environment,
62                       pidInfo: pidInfo }
63    
64      type configuration = primitive -> pinfo      type configuration =
65            pinfo StringMap.map * primitive Vector.vector
66    
67      fun eq (p1 : primitive, p2) = p1 = p2      fun eq (p1 : primitive, p2) = p1 = p2
68    
69      fun fromString "basis" = SOME BASIS      fun fromString ((sm, v): configuration) s =
70        | fromString _ = NONE          case StringMap.find (sm, s) of
71                NONE => NONE
72      fun toString BASIS = "basis"            | SOME _ => SOME s
73    
74      fun toIdent BASIS = #"b"      fun toString (p: primitive) = p
75    
76      fun fromIdent #"b" = SOME BASIS      fun get ((sm, v): configuration) p =
77        | fromIdent _ = NONE          case StringMap.find (sm, p) of
78                NONE => GenericVC.ErrorMsg.impossible "Primitive: bad primitive"
79      val reqpriv_basis = StringSet.singleton "basis"            | SOME i => i
80    
81      fun reqpriv BASIS = reqpriv_basis      infix o'
82        fun (f o' g) x y = f (g x y)
83    
84        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    
90      fun exports (cfg: configuration) p = #exports (cfg p)      val reqpriv = StringSet.singleton o toString
     fun da_env (cfg: configuration) p = #da_env (cfg p)  
     fun env (cfg: configuration) p = #env (cfg p)  
91    
92      fun configuration { basis } = let      fun fromIdent ((sm, v): configuration) c = let
93          fun gen_pinfo e = let          val p = Char.ord c
             val (da_env, mkExports) = Statenv2DAEnv.cvt (E.staticPart e)  
94          in          in
95              { exports = mkExports (), da_env = da_env, env = e }          if p < Vector.length v then SOME (Vector.sub (v, p)) else NONE
96          end          end
97    
98          val basis_pinfo = gen_pinfo basis      fun configuration l = let
99          fun cfg BASIS = basis_pinfo          fun gen_pinfo ({ name, env, pidInfo }, i) = let
100                val (da_env, mkExports) = Statenv2DAEnv.cvt (E.staticPart env)
101      in      in
102          cfg              { name = name, exports = mkExports (), da_env = da_env,
103                  env = env, pidInfo = pidInfo,
104                  ident = Char.chr i }
105      end      end
106      (* this doesn't make much sense yet -- there aren't any singular          fun one (ps, (sm, sl, i)) =
107       * pids describing the basis *)              (StringMap.insert (sm, #name ps, gen_pinfo (ps, i)),
108      fun pidInfo c BASIS = let               #name ps :: sl,
109          val p = GenericVC.PersStamps.fromBytes               i + 1)
110              (Byte.stringToBytes "0123456789abcdef")          val (sm, sl, _) = foldr one (StringMap.empty, [], 0) l
111      in      in
112          { statpid = p, sympid = p, ctxt = GenericVC.CMStaticEnv.empty }          (sm, Vector.fromList sl)
113      end      end
114  end  end

Legend:
Removed from v.322  
changed lines
  Added in v.323

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