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

Diff of /sml/trunk/src/cm/smlfile/smlinfo.sml

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

revision 353, Thu Jun 24 09:43:28 1999 UTC revision 354, Fri Jun 25 08:36:12 1999 UTC
# Line 17  Line 17 
17      type region = GenericVC.SourceMap.region      type region = GenericVC.SourceMap.region
18      type source = GenericVC.Source.inputSource      type source = GenericVC.Source.inputSource
19    
     val resync : unit -> unit           (* rebuild internal table *)  
   
20      val eq : info * info -> bool        (* compares sourcepaths *)      val eq : info * info -> bool        (* compares sourcepaths *)
21      val compare : info * info -> order  (* compares sourcepaths *)      val compare : info * info -> order  (* compares sourcepaths *)
22    
23      val info : GeneralParams.info ->      val info : GeneralParams.info ->
24          { sourcepath: AbsPath.t,          { sourcepath: SrcPath.t,
25            group: AbsPath.t * region,            group: SrcPath.t * region,
26            share: bool option,            share: bool option,
27            split: bool }            split: bool }
28          -> info          -> info
29    
30      val sourcepath : info -> AbsPath.t      val sourcepath : info -> SrcPath.t
31      val skelpath : info -> AbsPath.t      val skelname : info -> string
32      val binpath : info -> AbsPath.t      val binname : info -> string
33      val error : GeneralParams.info -> info -> complainer      val error : GeneralParams.info -> info -> complainer
34    
35      val parsetree : GeneralParams.info -> info -> (ast * source) option      val parsetree : GeneralParams.info -> info -> (ast * source) option
# Line 45  Line 43 
43      val forgetParsetree : info -> unit      val forgetParsetree : info -> unit
44    
45      (* evict all but the reachable nodes in the cache *)      (* evict all but the reachable nodes in the cache *)
46      val forgetAllBut : AbsPathSet.set -> unit      val forgetAllBut : SrcPathSet.set -> unit
47    
48      (* different ways of describing an sml file using group and source *)      (* different ways of describing an sml file using group and source *)
49      val spec : info -> string           (* sspec *)      val spec : info -> string           (* sspec *)
50      val fullSpec : info -> string       (* gspec(sspec) *)      val fullSpec : info -> string       (* gspec(sspec) *)
51      val name : info -> string           (* sname *)      val descr : info -> string          (* sname *)
52      val fullName : info -> string       (* gname(sspec) *)      val fullDescr : info -> string      (* gname(sspec) *)
53    
54      val errorLocation : GeneralParams.info -> info -> string      val errorLocation : GeneralParams.info -> info -> string
55  end  end
# Line 70  Line 68 
68      type complainer = EM.complainer      type complainer = EM.complainer
69    
70      datatype persinfo =      datatype persinfo =
71          PERS of { group: AbsPath.t * region,          PERS of { group: SrcPath.t * region,
72                    lastseen: TStamp.t ref,                    lastseen: TStamp.t ref,
73                    parsetree: (ast * source) option ref,                    parsetree: (ast * source) option ref,
74                    skeleton: Skeleton.decl option ref }                    skeleton: Skeleton.decl option ref }
75    
76      datatype info =      datatype info =
77          INFO of { sourcepath: AbsPath.t,          INFO of { sourcepath: SrcPath.t,
78                    skelpath: AbsPath.t,                    skelname: string,
79                    binpath: AbsPath.t,                    binname: string,
80                    persinfo: persinfo,                    persinfo: persinfo,
81                    share: bool option,                    share: bool option,
82                    split: bool }                    split: bool }
# Line 86  Line 84 
84      type ord_key = info      type ord_key = info
85    
86      fun sourcepath (INFO { sourcepath = sp, ... }) = sp      fun sourcepath (INFO { sourcepath = sp, ... }) = sp
87      fun skelpath (INFO { skelpath = sp, ... }) = sp      fun skelname (INFO { skelname = sn, ... }) = sn
88      fun binpath (INFO { binpath = bp, ... }) = bp      fun binname (INFO { binname = bn, ... }) = bn
89      fun share (INFO { share = s, ... }) = s      fun share (INFO { share = s, ... }) = s
90      fun split (INFO { split = s, ... }) = s      fun split (INFO { split = s, ... }) = s
91    
# Line 97  Line 95 
95          gerror gp group          gerror gp group
96    
97      fun compare (INFO { sourcepath = p, ... }, INFO { sourcepath = p', ... }) =      fun compare (INFO { sourcepath = p, ... }, INFO { sourcepath = p', ... }) =
98          AbsPath.compare (p, p')          SrcPath.compare (p, p')
99      fun eq (i, i') = compare (i, i') = EQUAL      fun eq (i, i') = compare (i, i') = EQUAL
100    
101      fun lastseen (INFO { persinfo = PERS { lastseen, ... }, ... }) =      fun lastseen (INFO { persinfo = PERS { lastseen, ... }, ... }) =
102          !lastseen          !lastseen
103    
104      (* If files change their file ids, then CM will be seriously      val knownInfo = ref (SrcPathMap.empty: persinfo SrcPathMap.map)
      * disturbed because the ordering relation will change.  
      * We'll asume that this won't happen in general.  However, we provide  
      * a "resync" function that -- at the very least -- should be run  
      * at startup time. *)  
     val knownInfo = ref (AbsPathMap.empty: persinfo AbsPathMap.map)  
   
     fun resync () = let  
         val l = AbsPathMap.listItemsi (!knownInfo)  
     in  
         AbsPath.newEra ();              (* force recalculation of file ids *)  
         knownInfo := foldl AbsPathMap.insert' AbsPathMap.empty l  
     end  
105    
106      fun forgetParsetree (INFO { persinfo = PERS { parsetree, ... }, ... }) =      fun forgetParsetree (INFO { persinfo = PERS { parsetree, ... }, ... }) =
107          parsetree := NONE          parsetree := NONE
108    
109      fun forgetAllBut reachable = let      fun forgetAllBut reachable = let
110          fun isReachable (p, m) = AbsPathSet.member (reachable, p)          fun isReachable (p, m) = SrcPathSet.member (reachable, p)
111      in      in
112          knownInfo := AbsPathMap.filteri isReachable (!knownInfo)          knownInfo := SrcPathMap.filteri isReachable (!knownInfo)
113      end      end
114    
115      (* check timestamp and throw away any invalid cache *)      (* check timestamp and throw away any invalid cache *)
# Line 132  Line 118 
118           * additions to the type! *)           * additions to the type! *)
119          val { group, lastseen, parsetree, skeleton } = pir          val { group, lastseen, parsetree, skeleton } = pir
120          val ts = !lastseen          val ts = !lastseen
121          val nts = AbsPath.tstamp sourcepath          val nts = SrcPath.tstamp sourcepath
122      in      in
123          if TStamp.needsUpdate { source = nts, target = ts } then          if TStamp.needsUpdate { source = nts, target = ts } then
124              (lastseen := nts;              (lastseen := nts;
# Line 144  Line 130 
130      fun info (gp: GeneralParams.info) arg = let      fun info (gp: GeneralParams.info) arg = let
131          val { sourcepath, group = gr as (group, region), share, split } = arg          val { sourcepath, group = gr as (group, region), share, split } = arg
132          val policy = #fnpolicy (#param gp)          val policy = #fnpolicy (#param gp)
133          val skelpath = FNP.mkSkelPath policy sourcepath          val skelname = FNP.mkSkelName policy sourcepath
134          val binpath = FNP.mkBinPath policy sourcepath          val binname = FNP.mkBinName policy sourcepath
135          val groupreg = #groupreg gp          val groupreg = #groupreg gp
136          fun newpersinfo () = let          fun newpersinfo () = let
137              val ts = AbsPath.tstamp sourcepath              val ts = SrcPath.tstamp sourcepath
138              val pi = PERS { group = gr, lastseen = ref ts,              val pi = PERS { group = gr, lastseen = ref ts,
139                              parsetree = ref NONE, skeleton = ref NONE }                              parsetree = ref NONE, skeleton = ref NONE }
140          in          in
141              knownInfo := AbsPathMap.insert (!knownInfo, sourcepath, pi);              knownInfo := SrcPathMap.insert (!knownInfo, sourcepath, pi);
142              pi              pi
143          end          end
144          fun persinfo () =          fun persinfo () =
145              case AbsPathMap.find (!knownInfo, sourcepath) of              case SrcPathMap.find (!knownInfo, sourcepath) of
146                  NONE => newpersinfo ()                  NONE => newpersinfo ()
147                | SOME (pi as PERS { group = gr' as (g, r), ... }) =>                | SOME (pi as PERS { group = gr' as (g, r), ... }) =>
148                      if AbsPath.compare (group, g) <> EQUAL then let                      if SrcPath.compare (group, g) <> EQUAL then let
149                          val n = AbsPath.name sourcepath                          val n = SrcPath.descr sourcepath
150                      in                      in
151                          if GroupReg.registered groupreg g then                          if GroupReg.registered groupreg g then
152                              (gerror gp gr EM.COMPLAIN                              (gerror gp gr EM.COMPLAIN
# Line 180  Line 166 
166                      else (validate (sourcepath, pi); pi)                      else (validate (sourcepath, pi); pi)
167      in      in
168          INFO { sourcepath = sourcepath,          INFO { sourcepath = sourcepath,
169                 skelpath = skelpath,                 skelname = skelname,
170                 binpath = binpath,                 binname = binname,
171                 persinfo = persinfo (),                 persinfo = persinfo (),
172                 share = share,                 share = share,
173                 split = split }                 split = split }
# Line 191  Line 177 
177       * not with checking time stamps *)       * not with checking time stamps *)
178      fun getParseTree gp (i as INFO ir, quiet, noerrors) = let      fun getParseTree gp (i as INFO ir, quiet, noerrors) = let
179          val { sourcepath, persinfo = PERS { parsetree, ... }, ... } = ir          val { sourcepath, persinfo = PERS { parsetree, ... }, ... } = ir
         val name = AbsPath.name sourcepath  
180          val err = if noerrors then (fn m => ())          val err = if noerrors then (fn m => ())
181                    else (fn m => error gp i EM.COMPLAIN m EM.nullErrorBody)                    else (fn m => error gp i EM.COMPLAIN m EM.nullErrorBody)
182      in      in
# Line 200  Line 185 
185            | NONE => let            | NONE => let
186                  fun work stream = let                  fun work stream = let
187                      val _ = if noerrors orelse quiet then ()                      val _ = if noerrors orelse quiet then ()
188                              else Say.vsay ["[parsing ", name, "]\n"]                              else Say.vsay ["[parsing ",
189                                               SrcPath.descr sourcepath, "]\n"]
190                      val source =                      val source =
191                          Source.newSource (name, 1, stream, false, #errcons gp)                          Source.newSource (SrcPath.osstring sourcepath,
192                                              1, stream, false, #errcons gp)
193                  in                  in
194                      (SF.parse source, source)                      (SF.parse source, source)
195                  end                  end
196                  fun openIt () = AbsPath.openTextIn sourcepath                  fun openIt () = SrcPath.openTextIn sourcepath
197                  val pto =                  val pto =
198                      SOME (SafeIO.perform { openIt = openIt,                      SOME (SafeIO.perform { openIt = openIt,
199                                             closeIt = TextIO.closeIn,                                             closeIt = TextIO.closeIn,
# Line 220  Line 207 
207      end      end
208    
209      fun getSkeleton gp (i as INFO ir, noerrors) = let      fun getSkeleton gp (i as INFO ir, noerrors) = let
210          val { sourcepath, skelpath, persinfo = PERS pir, ... } = ir          val { sourcepath, skelname, persinfo = PERS pir, ... } = ir
211          val { skeleton, lastseen, ... } = pir          val { skeleton, lastseen, ... } = pir
212      in      in
213          case !skeleton of          case !skeleton of
214              SOME sk => SOME sk              SOME sk => SOME sk
215            | NONE =>            | NONE =>
216                  (case SkelIO.read (skelpath, !lastseen) of                  (case SkelIO.read (skelname, !lastseen) of
217                       SOME sk => (skeleton := SOME sk; SOME sk)                       SOME sk => (skeleton := SOME sk; SOME sk)
218                     | NONE =>                     | NONE =>
219                           (case getParseTree gp (i, false, noerrors) of                           (case getParseTree gp (i, false, noerrors) of
# Line 244  Line 231 
231                                        else error gp i EM.COMPLAIN                                        else error gp i EM.COMPLAIN
232                                                   "error(s) in ML source file"                                                   "error(s) in ML source file"
233                                                   EM.nullErrorBody                                                   EM.nullErrorBody
234                                    else (SkelIO.write (skelpath, sk, !lastseen);                                    else (SkelIO.write (skelname, sk, !lastseen);
235                                          skeleton := SOME sk);                                          skeleton := SOME sk);
236                                    SOME sk                                    SOME sk
237                                end                                end
# Line 259  Line 246 
246    
247      fun parsetree gp i = getParseTree gp (i, true, true)      fun parsetree gp i = getParseTree gp (i, true, true)
248    
249      fun spec (INFO { sourcepath, ... }) = AbsPath.specOf sourcepath      fun spec (INFO { sourcepath, ... }) = SrcPath.specOf sourcepath
250      fun fullSpec (INFO { sourcepath, persinfo = PERS { group, ... }, ... }) =      fun fullSpec (INFO { sourcepath, persinfo = PERS { group, ... }, ... }) =
251          concat [AbsPath.specOf (#1 group), "(", AbsPath.specOf sourcepath, ")"]          concat [SrcPath.specOf (#1 group), "(", SrcPath.specOf sourcepath, ")"]
252      fun name (INFO { sourcepath, ... }) = AbsPath.name sourcepath      fun descr (INFO { sourcepath, ... }) = SrcPath.descr sourcepath
253      fun fullName (INFO { sourcepath, persinfo = PERS { group, ... }, ... }) =      fun fullDescr (INFO { sourcepath, persinfo = PERS { group, ... }, ... }) =
254          concat [AbsPath.name (#1 group), "(", AbsPath.specOf sourcepath, ")"]          concat [SrcPath.descr (#1 group), "(", SrcPath.specOf sourcepath, ")"]
255    
256      fun errorLocation (gp: GeneralParams.info) (INFO i) = let      fun errorLocation (gp: GeneralParams.info) (INFO i) = let
257          val { persinfo = PERS { group = (group, reg), ... }, ... } = i          val { persinfo = PERS { group = (group, reg), ... }, ... } = i

Legend:
Removed from v.353  
changed lines
  Added in v.354

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