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 294, Tue May 25 09:06:06 1999 UTC
# Line 17  Line 17 
17    
18      type collection      type collection
19    
     type farlooker = AbsPath.t ->  
         { imports: impexp SymbolMap.map, gimports: impexp SymbolMap.map }  
   
20      val empty : collection      val empty : collection
21    
22      val expandOne : farlooker      val expandOne : GeneralParams.params * (AbsPath.t -> GroupGraph.group)
23          -> { sourcepath: AbsPath.t, group: AbsPath.t, class: string option,          -> { sourcepath: AbsPath.t, group: AbsPath.t,
24               error : string -> (PrettyPrint.ppstream -> unit) -> unit }               class: string option,
25                 error : GenericVC.ErrorMsg.complainer }
26          -> collection          -> collection
27      val sequential : collection * collection * (string -> unit) -> collection      val sequential : collection * collection * (string -> unit) -> collection
28    
29      val build : collection * SymbolSet.set option * (string -> unit)      val build : collection * SymbolSet.set option * (string -> unit)
30          -> impexp SymbolMap.map          -> impexp SymbolMap.map
31    
32        val subgroups : collection -> GroupGraph.group list
33    
34      val num_look : collection -> string -> int      val num_look : collection -> string -> int
35      val ml_look : collection -> symbol -> bool      val ml_look : collection -> symbol -> bool
36      val cm_look : collection -> string -> bool      val cm_look : collection -> string -> bool
# Line 41  Line 41 
41      structure DG = DependencyGraph      structure DG = DependencyGraph
42      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
43      structure CBE = GenericVC.BareEnvironment      structure CBE = GenericVC.BareEnvironment
44        structure SS = SymbolSet
45        structure GG = GroupGraph
46    
47      type smlinfo = SmlInfo.info      type smlinfo = SmlInfo.info
48      type symbol = Symbol.symbol      type symbol = Symbol.symbol
# Line 50  Line 52 
52          COLLECTION of { imports: impexp SymbolMap.map,          COLLECTION of { imports: impexp SymbolMap.map,
53                          gimports: impexp SymbolMap.map,                          gimports: impexp SymbolMap.map,
54                          smlfiles: smlinfo list,                          smlfiles: smlinfo list,
55                          localdefs: smlinfo SymbolMap.map }                          localdefs: smlinfo SymbolMap.map,
56                            subgroups: GG.group list }
     type farlooker = AbsPath.t ->  
         { imports: impexp SymbolMap.map, gimports: impexp SymbolMap.map }  
57    
58      val empty =      val empty =
59          COLLECTION { imports = SymbolMap.empty,          COLLECTION { imports = SymbolMap.empty,
60                       gimports = SymbolMap.empty,                       gimports = SymbolMap.empty,
61                       smlfiles = [],                       smlfiles = [],
62                       localdefs = SymbolMap.empty }                       localdefs = SymbolMap.empty,
63                         subgroups = [] }
     fun convertEnv cmenv = let  
         fun modulesOnly sl = let  
             fun addModule (sy, set) =  
                 case Symbol.nameSpace sy of  
                     (Symbol.STRspace | Symbol.SIGspace |  
                      Symbol.FCTspace | Symbol.FSIGspace) =>  
                         SymbolSet.add (set, sy)  
                   | _ => set  
         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 })  
     in  
         valOf (cvt cmenv)  
     end  
64    
65      fun sequential (COLLECTION c1, COLLECTION c2, error) = let      fun sequential (COLLECTION c1, COLLECTION c2, error) = let
66          fun describeSymbol (s, r) = let          fun describeSymbol (s, r) = let
# Line 103  Line 85 
85          COLLECTION { imports = i_union (#imports c1, #imports c2),          COLLECTION { imports = i_union (#imports c1, #imports c2),
86                       gimports = gi_union (#gimports c1, #gimports c2),                       gimports = gi_union (#gimports c1, #gimports c2),
87                       smlfiles = #smlfiles c1 @ #smlfiles c2,                       smlfiles = #smlfiles c1 @ #smlfiles c2,
88                       localdefs = ld_union (#localdefs c1, #localdefs c2) }                       localdefs = ld_union (#localdefs c1, #localdefs c2),
89                         subgroups = #subgroups c1 @ #subgroups c2 }
90      end      end
91    
92      fun expandOne gexports { sourcepath, group, class, error } = let      fun expandOne (params, rparse) arg = let
93            val primconf = #primconf params
94            val { sourcepath, group, class, error } = arg
95          fun noPrimitive () = let          fun noPrimitive () = let
96              fun e0 s = error s EM.nullErrorBody              fun e0 s = error EM.COMPLAIN s EM.nullErrorBody
97                fun w0 s = error EM.WARN s EM.nullErrorBody
98              val expansions = PrivateTools.expand e0 (sourcepath, class)              val expansions = PrivateTools.expand e0 (sourcepath, class)
99              fun exp2coll (PrivateTools.GROUP p) = let              fun exp2coll (PrivateTools.GROUP p) = let
100                      val { imports = i, gimports = gi } = gexports p                      val g as GG.GROUP { exports = i, islib, ... } = rparse p
101                        val gi = if islib then SymbolMap.empty else i
102                  in                  in
103                      COLLECTION { imports = i, gimports = gi, smlfiles = [],                      COLLECTION { imports = i, gimports = gi, smlfiles = [],
104                                   localdefs = SymbolMap.empty }                                   localdefs = SymbolMap.empty,
105                                     subgroups = [g] }
106                  end                  end
107                | exp2coll (PrivateTools.SMLSOURCE src) = let                | exp2coll (PrivateTools.SMLSOURCE src) = let
108                      val { sourcepath = p, history = h, share = s } = src                      val { sourcepath = p, history = h, share = s } = src
109                      val i =  SmlInfo.info                      val i =  SmlInfo.info
110                          Policy.default                          params
111                          { sourcepath = p, group = group,                          { sourcepath = p, group = group,
112                            error = error, history = h,                            error = error EM.COMPLAIN,
113                              history = h,
114                            share = s }                            share = s }
115                      val exports = SmlInfo.exports i                      val exports = SmlInfo.exports i
116                        val _ = if SS.isEmpty exports then w0 "no module exports"
117                                else ()
118                      fun addLD (s, m) = SymbolMap.insert (m, s, i)                      fun addLD (s, m) = SymbolMap.insert (m, s, i)
119                      val ld = SymbolSet.foldl addLD SymbolMap.empty exports                      val ld = SS.foldl addLD SymbolMap.empty exports
120                  in                  in
121                      COLLECTION { imports = SymbolMap.empty,                      COLLECTION { imports = SymbolMap.empty,
122                                   gimports = SymbolMap.empty,                                   gimports = SymbolMap.empty,
123                                   smlfiles = [i],                                   smlfiles = [i],
124                                   localdefs = ld }                                   localdefs = ld,
125                                     subgroups = [] }
126                  end                  end
127              val collections = map exp2coll expansions              val collections = map exp2coll expansions
128              fun combine (c1, c2) = sequential (c2, c1, e0)              fun combine (c1, c2) = sequential (c2, c1, e0)
# Line 141  Line 133 
133          if isSome class then noPrimitive ()          if isSome class then noPrimitive ()
134          else case Primitive.fromString (AbsPath.spec sourcepath) of          else case Primitive.fromString (AbsPath.spec sourcepath) of
135              SOME p => let              SOME p => let
136                  val exports = Primitive.exports p                  val exports = Primitive.exports primconf p
137                    val plook = Primitive.lookup primconf p
138                  fun addFN (s, m) = let                  fun addFN (s, m) = let
139                      val cmenv = Primitive.lookup p s                      val env = plook s
                     val env = convertEnv cmenv  
140                      val fsbn = (NONE, DG.SB_BNODE (DG.PNODE p))                      val fsbn = (NONE, DG.SB_BNODE (DG.PNODE p))
141                  in                  in
142                      SymbolMap.insert (m, s, (fsbn, env))                      SymbolMap.insert (m, s, (fsbn, env))
143                  end                  end
144                  val imp = SymbolSet.foldl addFN SymbolMap.empty exports                  val imp = SS.foldl addFN SymbolMap.empty exports
145              in              in
146                  COLLECTION { imports = imp,                  COLLECTION { imports = imp,
147                               gimports = SymbolMap.empty,                               gimports = SymbolMap.empty,
148                               smlfiles = [],                               smlfiles = [],
149                               localdefs = SymbolMap.empty }                               localdefs = SymbolMap.empty,
150                                 subgroups = [] }
151              end              end
152            | NONE => noPrimitive ()            | NONE => noPrimitive ()
153      end      end
154    
155      fun build (COLLECTION c, fopt, error) = BuildDepend.build (c, fopt, error)      fun build (COLLECTION c, fopt, error) = BuildDepend.build (c, fopt, error)
156    
157        fun subgroups (COLLECTION { subgroups = sg, ... }) = sg
158    
159      fun num_look (c: collection) (s: string) = 0      fun num_look (c: collection) (s: string) = 0
160    
161      fun cm_look (c: collection) (s: string) = false      fun cm_look (c: collection) (s: string) = false

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

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