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/members.sml
ViewVC logotype

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

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

revision 283, Wed May 19 08:20:58 1999 UTC revision 588, Fri Mar 31 09:00:02 2000 UTC
# Line 14  Line 14 
14      type symbol = Symbol.symbol      type symbol = Symbol.symbol
15      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
16      type impexp = DependencyGraph.impexp      type impexp = DependencyGraph.impexp
17        type region = GenericVC.SourceMap.region
18    
19      type collection      type collection
20    
     type farlooker = AbsPath.t ->  
         { imports: impexp SymbolMap.map, gimports: impexp SymbolMap.map }  
   
21      val empty : collection      val empty : collection
22    
23      val expandOne : farlooker      val implicit : GroupGraph.group -> collection
24          -> { sourcepath: AbsPath.t, group: AbsPath.t, class: string option,  
25               error : string -> (PrettyPrint.ppstream -> unit) -> unit }      val expandOne :
26            GeneralParams.info *
27            (SrcPath.t -> GroupGraph.group) *
28            (SrcPath.context -> string -> bool)
29            -> { name: string,
30                 mkpath: string -> SrcPath.t,
31                 group: SrcPath.t * region,
32                 class: string option,
33                 tooloptions: PrivateTools.toolopts option,
34                 context: SrcPath.context }
35          -> collection          -> collection
36      val sequential : collection * collection * (string -> unit) -> collection      val sequential : collection * collection * (string -> unit) -> collection
37    
38      val build : collection * SymbolSet.set option * (string -> unit)      val build :
39          -> impexp SymbolMap.map          collection * SymbolSet.set option * GeneralParams.info *
40            DependencyGraph.farsbnode       (* pervasive env *)
41            -> impexp SymbolMap.map * GroupGraph.privileges
42    
43      val num_look : collection -> string -> int      val subgroups : collection -> (SrcPath.t * GroupGraph.group) list
44    
45        val num_look : GeneralParams.info -> collection -> string -> int
46        val cm_look : GeneralParams.info -> collection -> string -> bool
47      val ml_look : collection -> symbol -> bool      val ml_look : collection -> symbol -> bool
     val cm_look : collection -> string -> bool  
48  end  end
49    
50  structure MemberCollection :> MEMBERCOLLECTION = struct  structure MemberCollection :> MEMBERCOLLECTION = struct
51    
52      structure DG = DependencyGraph      structure DG = DependencyGraph
53      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
54      structure CBE = GenericVC.BareEnvironment      structure E = GenericVC.Environment
55        structure SS = SymbolSet
56        structure GG = GroupGraph
57    
58      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
59      type symbol = Symbol.symbol      type symbol = Symbol.symbol
60      type impexp = DG.impexp      type impexp = DG.impexp
61        type region = GenericVC.SourceMap.region
62    
63      datatype collection =      datatype collection =
64          COLLECTION of { imports: impexp SymbolMap.map,          COLLECTION of { imports: impexp SymbolMap.map,
65                          gimports: impexp SymbolMap.map,                          gimports: impexp SymbolMap.map,
66                          smlfiles: smlinfo list,                          smlfiles: smlinfo list,
67                          localdefs: smlinfo SymbolMap.map }                          localdefs: smlinfo SymbolMap.map,
68                            subgroups: (SrcPath.t * GG.group) list,
69      type farlooker = AbsPath.t ->                          reqpriv: GG.privileges }
70          { imports: impexp SymbolMap.map, gimports: impexp SymbolMap.map }        | ERRORCOLLECTION
71    
72      val empty =      val empty =
73          COLLECTION { imports = SymbolMap.empty,          COLLECTION { imports = SymbolMap.empty,
74                       gimports = SymbolMap.empty,                       gimports = SymbolMap.empty,
75                       smlfiles = [],                       smlfiles = [],
76                       localdefs = SymbolMap.empty }                       localdefs = SymbolMap.empty,
77                         subgroups = [],
78      fun convertEnv cmenv = let                       reqpriv = StringSet.empty }
79          fun modulesOnly sl = let  
80              fun addModule (sy, set) =      fun implicit init_group = let
81                  case Symbol.nameSpace sy of          val { grouppath, ... } =
82                      (Symbol.STRspace | Symbol.SIGspace |              case init_group of
83                       Symbol.FCTspace | Symbol.FSIGspace) =>                  GG.GROUP x => x
84                          SymbolSet.add (set, sy)                | GG.ERRORGROUP =>
85                    | _ => set                  EM.impossible "members.sml: implicit: bad init group"
         in  
             foldl addModule SymbolSet.empty sl  
         end  
         fun cvt CBE.CM_NONE = NONE  
           | cvt (CBE.CM_ENV { look, symbols }) =  
             SOME (DG.FCTENV { looker = cvt o look,  
                               domain = modulesOnly o symbols })  
86      in      in
87          valOf (cvt cmenv)          (* This is a collection that is an implicit member of every
88             * library -- the "init" group which exports the pervasive env. *)
89            COLLECTION { imports = SymbolMap.empty,
90                         gimports = SymbolMap.empty,
91                         smlfiles = [],
92                         localdefs = SymbolMap.empty,
93                         subgroups = [(grouppath, init_group)],
94                         reqpriv = StringSet.empty }
95      end      end
96    
97      fun sequential (COLLECTION c1, COLLECTION c2, error) = let      fun sequential (COLLECTION c1, COLLECTION c2, error) =
98          fun describeSymbol (s, r) = let          let fun describeSymbol (s, r) = let
99              val ns = Symbol.nameSpace s              val ns = Symbol.nameSpace s
100          in          in
101              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r              Symbol.nameSpaceToString ns :: " " :: Symbol.name s :: r
102          end          end
103          fun i_error (s, x as (fn1, _), (fn2, _)) =              fun i_error (s, x as ((f, sbn), e), ((f', sbn'), e')) = let
104              (error (concat (describeSymbol                  fun complain () =
105                              (s, [" imported from ", DG.describeFarSBN fn1,                      error (concat (describeSymbol
106                                   " and also from ", DG.describeFarSBN fn2])));                                         (s, [" imported from ",
107               x)                                              DG.describeSBN sbn,
108                                                " and also from ",
109                                                DG.describeSBN sbn'])))
110                    fun union (NONE, _) = NONE
111                      | union (_, NONE) = NONE
112                      | union (SOME f, SOME f') = SOME (SymbolSet.union (f, f'))
113                in
114                    if DG.sbeq (sbn, sbn') then
115                        ((union (f, f'), sbn), DAEnv.LAYER (e, e'))
116                    else (complain (); x)
117                end
118          val i_union = SymbolMap.unionWithi i_error          val i_union = SymbolMap.unionWithi i_error
119          val gi_union = SymbolMap.unionWith #1          val gi_union = SymbolMap.unionWith #1
120          fun ld_error (s, f1, f2) =          fun ld_error (s, f1, f2) =
# Line 103  Line 127 
127          COLLECTION { imports = i_union (#imports c1, #imports c2),          COLLECTION { imports = i_union (#imports c1, #imports c2),
128                       gimports = gi_union (#gimports c1, #gimports c2),                       gimports = gi_union (#gimports c1, #gimports c2),
129                       smlfiles = #smlfiles c1 @ #smlfiles c2,                       smlfiles = #smlfiles c1 @ #smlfiles c2,
130                       localdefs = ld_union (#localdefs c1, #localdefs c2) }                           localdefs = ld_union (#localdefs c1, #localdefs c2),
131      end                           subgroups = #subgroups c1 @ #subgroups c2,
132                             reqpriv = StringSet.union (#reqpriv c1, #reqpriv c2) }
133      fun expandOne gexports { sourcepath, group, class, error } = let          end
134          fun noPrimitive () = let        | sequential _ = ERRORCOLLECTION
135              fun e0 s = error s EM.nullErrorBody  
136              val expansions = PrivateTools.expand e0 (sourcepath, class)      fun expandOne (gp, rparse, load_plugin) arg = let
137              fun exp2coll (PrivateTools.GROUP p) = let          val { name, mkpath, group, class, tooloptions, context } = arg
138                      val { imports = i, gimports = gi } = gexports p          val class = Option.map (String.map Char.toLower) class
139            val error = GroupReg.error (#groupreg gp) group
140            fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
141            fun w0 s = error EM.WARN s EM.nullErrorBody
142            val { smlfiles, cmfiles } =
143                PrivateTools.expand { error = e0,
144                                      spec = (name, mkpath, class, tooloptions),
145                                      context = context,
146                                      load_plugin = load_plugin }
147            fun g_coll p =
148                case rparse p of
149                    g as GG.GROUP { exports = i, kind, required,
150                                    grouppath, sublibs } => let
151                        val gi =
152                            case kind of GG.NOLIB _ => i | _ => SymbolMap.empty
153                  in                  in
154                      COLLECTION { imports = i, gimports = gi, smlfiles = [],                      COLLECTION { imports = i, gimports = gi, smlfiles = [],
155                                   localdefs = SymbolMap.empty }                                   localdefs = SymbolMap.empty,
156                  end                                   subgroups = [(p, g)],
157                | exp2coll (PrivateTools.SMLSOURCE src) = let                                   reqpriv = required }
158                      val { sourcepath = p, history = h, share = s } = src                  end
159                      val i =  SmlInfo.info                | GG.ERRORGROUP => ERRORCOLLECTION
160                          Policy.default          fun s_coll (p, s) = let
161                          { sourcepath = p, group = group,              val i =
162                            error = error, history = h,                  SmlInfo.info gp { sourcepath = p, group = group, sh_spec = s }
163                            share = s }              val exports =
164                      val exports = SmlInfo.exports i                  case SmlInfo.exports gp i of
165                        NONE => SS.empty
166                      | SOME ex => (if SS.isEmpty ex then
167                                        w0 ("no module exports from " ^
168                                            SrcPath.descr p)
169                                    else ();
170                                    ex)
171                      fun addLD (s, m) = SymbolMap.insert (m, s, i)                      fun addLD (s, m) = SymbolMap.insert (m, s, i)
172                      val ld = SymbolSet.foldl addLD SymbolMap.empty exports              val ld = SS.foldl addLD SymbolMap.empty exports
173                  in                  in
174                      COLLECTION { imports = SymbolMap.empty,                      COLLECTION { imports = SymbolMap.empty,
175                                   gimports = SymbolMap.empty,                                   gimports = SymbolMap.empty,
176                                   smlfiles = [i],                                   smlfiles = [i],
177                                   localdefs = ld }                           localdefs = ld,
178                             subgroups = [],
179                             reqpriv = StringSet.empty }
180                  end                  end
181              val collections = map exp2coll expansions          val collections = map g_coll cmfiles @ map s_coll smlfiles
182              fun combine (c1, c2) = sequential (c2, c1, e0)              fun combine (c1, c2) = sequential (c2, c1, e0)
183          in          in
184              foldl combine empty collections              foldl combine empty collections
185          end          end
186    
187        fun build (COLLECTION c, fopt, gp, perv_fsbnode) =
188            BuildDepend.build (c, fopt, gp, perv_fsbnode)
189          | build (ERRORCOLLECTION, _, _, _) =
190            (SymbolMap.empty, StringSet.empty)
191    
192        fun subgroups (COLLECTION { subgroups = sg, ... }) = sg
193          | subgroups ERRORCOLLECTION = []
194    
195        local
196            fun symenv_look (gp: GeneralParams.info) (c: collection) s =
197                #get (#symval (#param gp) s) ()
198      in      in
199          if isSome class then noPrimitive ()          fun num_look gp c s = getOpt (symenv_look gp c s, 0)
200          else case Primitive.fromString (AbsPath.spec sourcepath) of          fun cm_look gp c s = isSome (symenv_look gp c s)
             SOME p => let  
                 val exports = Primitive.exports p  
                 fun addFN (s, m) = let  
                     val cmenv = Primitive.lookup p s  
                     val env = convertEnv cmenv  
                     val fsbn = (NONE, DG.SB_BNODE (DG.PNODE p))  
                 in  
                     SymbolMap.insert (m, s, (fsbn, env))  
                 end  
                 val imp = SymbolSet.foldl addFN SymbolMap.empty exports  
             in  
                 COLLECTION { imports = imp,  
                              gimports = SymbolMap.empty,  
                              smlfiles = [],  
                              localdefs = SymbolMap.empty }  
             end  
           | NONE => noPrimitive ()  
201      end      end
202    
     fun build (COLLECTION c, fopt, error) = BuildDepend.build (c, fopt, error)  
   
     fun num_look (c: collection) (s: string) = 0  
   
     fun cm_look (c: collection) (s: string) = false  
   
203      fun ml_look (COLLECTION { imports, localdefs, ... }) s =      fun ml_look (COLLECTION { imports, localdefs, ... }) s =
204          isSome (SymbolMap.find (imports, s)) orelse          isSome (SymbolMap.find (imports, s)) orelse
205          isSome (SymbolMap.find (localdefs, s))          isSome (SymbolMap.find (localdefs, s))
206          | ml_look ERRORCOLLECTON _ = true
207  end  end

Legend:
Removed from v.283  
changed lines
  Added in v.588

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