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 296, Thu May 27 05:31:04 1999 UTC revision 297, Thu May 27 08:29:19 1999 UTC
# Line 12  Line 12 
12      type info      type info
13    
14      type complainer = GenericVC.ErrorMsg.complainer      type complainer = GenericVC.ErrorMsg.complainer
15      type parsetree = GenericVC.Ast.dec      type ast = GenericVC.Ast.dec
16        type region = GenericVC.SourceMap.region
17    
18      val resync : unit -> unit           (* rebuild internal table *)      val resync : unit -> unit           (* rebuild internal table *)
19    
# Line 21  Line 22 
22    
23      val info : GeneralParams.params ->      val info : GeneralParams.params ->
24          { sourcepath: AbsPath.t,          { sourcepath: AbsPath.t,
25            group: AbsPath.t,            group: AbsPath.t * region,
           error: complainer,  
           history: string list,  
26            share: bool option }            share: bool option }
27          -> info          -> info
28    
29      val sourcepath : info -> AbsPath.t      val sourcepath : info -> AbsPath.t
30      val error : info -> complainer      val error : GeneralParams.params -> info -> complainer
31    
32      val parsetree : info -> parsetree option      val parsetree : GeneralParams.params -> info -> ast option
33      val exports : info  -> SymbolSet.set      val exports : GeneralParams.params -> info  -> SymbolSet.set
34      val skeleton : info -> Skeleton.decl      val skeleton : GeneralParams.params -> info -> Skeleton.decl
35      val share : info -> bool option      val share : info -> bool option
36    
37      (* different ways of describing an sml file using group and source *)      (* different ways of describing an sml file using group and source *)
# Line 51  Line 50 
50      structure FNP = FilenamePolicy      structure FNP = FilenamePolicy
51    
52      type source = Source.inputSource      type source = Source.inputSource
53      type parsetree = GenericVC.Ast.dec      type ast = GenericVC.Ast.dec
54        type region = GenericVC.SourceMap.region
55    
56      type complainer = EM.complainer      type complainer = EM.complainer
57    
58      datatype info =      datatype persinfo =
59          INFO of {          PERS of { group: AbsPath.t * region,
                  sourcepath: AbsPath.t,  
                  group: AbsPath.t,  
                  error: complainer,  
60                   lastseen: TStamp.t ref,                   lastseen: TStamp.t ref,
61                   parsetree: { tree: parsetree, source: source } option ref,                    parsetree: { tree: ast, source: source } option ref,
62                   skelpath: AbsPath.t,                    skeleton: Skeleton.decl option ref }
63                   skeleton: Skeleton.decl option ref,  
64                   share: bool option      datatype info =
65                   (* to be extended *)          INFO of { sourcepath: AbsPath.t,
66                  }                    persinfo: persinfo,
67                      share: bool option }
68    
69      fun sourcepath (INFO { sourcepath = sp, ... }) = sp      fun sourcepath (INFO { sourcepath = sp, ... }) = sp
     fun error (INFO { error = e, ... }) = e  
70      fun share (INFO { share = s, ... }) = s      fun share (INFO { share = s, ... }) = s
71    
72        fun gerror (gp: GeneralParams.params) = GroupReg.error (#groupreg gp)
73    
74        fun error gp (INFO { persinfo = PERS { group, ... }, ... }) =
75            gerror gp group
76    
77      fun compare (INFO { sourcepath = p, ... }, INFO { sourcepath = p', ... }) =      fun compare (INFO { sourcepath = p, ... }, INFO { sourcepath = p', ... }) =
78          AbsPath.compare (p, p')          AbsPath.compare (p, p')
79      fun eq (i, i') = compare (i, i') = EQUAL      fun eq (i, i') = compare (i, i') = EQUAL
# Line 81  Line 83 
83       * We'll asume that this won't happen in general.  However, we provide       * We'll asume that this won't happen in general.  However, we provide
84       * a "resync" function that -- at the very least -- should be run       * a "resync" function that -- at the very least -- should be run
85       * at startup time. *)       * at startup time. *)
86      val knownInfo : info AbsPathMap.map ref = ref AbsPathMap.empty      val knownInfo = ref (AbsPathMap.empty: persinfo AbsPathMap.map)
87    
88      fun resync () = let      fun resync () = let
89          val l = AbsPathMap.listItemsi (!knownInfo)          val l = AbsPathMap.listItemsi (!knownInfo)
# Line 90  Line 92 
92          knownInfo := foldl AbsPathMap.insert' AbsPathMap.empty l          knownInfo := foldl AbsPathMap.insert' AbsPathMap.empty l
93      end      end
94    
95      fun info (params: GeneralParams.params) arg = let      fun info (gp: GeneralParams.params) arg = let
96          val fnpolicy = #fnpolicy params          val { sourcepath, group = gr as (group, region), share } = arg
97          val groupreg = #groupreg params          val groupreg = #groupreg gp
98          val { sourcepath, group, error, history, share } = arg          fun newpersinfo () = let
99          fun newinfo () = let              val pi = PERS { group = gr, lastseen = ref TStamp.NOTSTAMP,
100              val i = INFO {                              parsetree = ref NONE, skeleton = ref NONE }
                           sourcepath = sourcepath,  
                           group = group,  
                           error = error,  
                           lastseen = ref TStamp.NOTSTAMP,  
                           parsetree = ref NONE,  
                           skelpath = FNP.mkSkelPath fnpolicy sourcepath,  
                           skeleton = ref NONE,  
                           share = share  
                          }  
101          in          in
102              knownInfo := AbsPathMap.insert (!knownInfo, sourcepath, i);              knownInfo := AbsPathMap.insert (!knownInfo, sourcepath, pi);
103              i              pi
104          end          end
105      in          fun persinfo () =
106          case AbsPathMap.find (!knownInfo, sourcepath) of          case AbsPathMap.find (!knownInfo, sourcepath) of
107              SOME (i as INFO { group = g, error = e, ... }) =>                  NONE => newpersinfo ()
108                  | SOME (pi as PERS { group = gr' as (g, r), ... }) =>
109                  if AbsPath.compare (group, g) <> EQUAL then                  if AbsPath.compare (group, g) <> EQUAL then
110                      (if GroupReg.registered groupreg g then                      (if GroupReg.registered groupreg g then
111                           let val n = AbsPath.name sourcepath                           let val n = AbsPath.name sourcepath
112                           in                               in gerror gp gr EM.COMPLAIN
                              error EM.COMPLAIN  
113                                    (concat ["ML source file ", n,                                    (concat ["ML source file ", n,
114                                             " appears in more than one group"])                                             " appears in more than one group"])
115                                     EM.nullErrorBody;                                     EM.nullErrorBody;
116                               e EM.COMPLAIN                                  gerror gp gr' EM.COMPLAIN
117                                 (concat ["(previous occurence of ", n, ")"])                                 (concat ["(previous occurence of ", n, ")"])
118                                 EM.nullErrorBody                                 EM.nullErrorBody
119                           end                           end
120                       else ();                       else ();
121                       newinfo ())                           newpersinfo ())
122                  else i                      else pi
123            | NONE => newinfo ()      in
124            INFO { sourcepath = sourcepath,
125                   persinfo = persinfo (),
126                   share = share }
127      end      end
128    
129      (* check timestamp and throw away any invalid cache *)      (* check timestamp and throw away any invalid cache *)
130      fun validate (INFO ir) = let      fun validate (INFO ir) = let
131          (* don't use "..." pattern to have the compiler catch later          (* don't use "..." pattern to have the compiler catch later
132           * additions to the type! *)           * additions to the type! *)
133          val { sourcepath, group, error, lastseen,          val { sourcepath, persinfo = PERS pir, share } = ir
134                parsetree, skelpath, skeleton, share } = ir          val { group, lastseen, parsetree, skeleton } = pir
135          val ts = !lastseen          val ts = !lastseen
136          val nts = AbsPath.tstamp sourcepath          val nts = AbsPath.tstamp sourcepath
137      in      in
# Line 148  Line 144 
144    
145      (* the following functions are only concerned with getting the data,      (* the following functions are only concerned with getting the data,
146       * not with checking time stamps *)       * not with checking time stamps *)
147      fun getParseTree (INFO ir, quiet, noerrors) = let      fun getParseTree gp (i as INFO ir, quiet, noerrors) = let
148          val { sourcepath, parsetree, error, ... } = ir          val { sourcepath, persinfo = PERS { parsetree, ... }, ... } = ir
149          val name = AbsPath.name sourcepath          val name = AbsPath.name sourcepath
150          val err = if noerrors then (fn m => ())          val err = if noerrors then (fn m => ())
151                    else (fn m => error EM.COMPLAIN m EM.nullErrorBody)                    else (fn m => error gp i EM.COMPLAIN m EM.nullErrorBody)
152      in      in
153          case !parsetree of          case !parsetree of
154              SOME pt => SOME pt              SOME pt => SOME pt
# Line 181  Line 177 
177                                            NONE)                                            NONE)
178      end      end
179    
180      fun getSkeleton (INFO ir, noerrors) = let      fun getSkeleton gp (i as INFO ir, noerrors) = let
181          val { skelpath, skeleton, lastseen, error, ... } = ir          val { sourcepath, persinfo = PERS pir, ... } = ir
182            val { skeleton, lastseen, ... } = pir
183      in      in
184          case !skeleton of          case !skeleton of
185              SOME sk => sk              SOME sk => sk
186            | NONE =>            | NONE => let
187                  (case SkelIO.read (skelpath, !lastseen) of                  val skelpath = FNP.mkSkelPath (#fnpolicy gp) sourcepath
188                in
189                    case SkelIO.read (skelpath, !lastseen) of
190                       SOME sk => (skeleton := SOME sk; sk)                       SOME sk => (skeleton := SOME sk; sk)
191                     | NONE =>                     | NONE =>
192                           (case getParseTree (INFO ir, false, noerrors) of                          (case getParseTree gp (i, false, noerrors) of
193                                SOME { tree, source } => let                                SOME { tree, source } => let
194                                    fun err sv region s =                                    fun err sv region s =
195                                        EM.error source region sv s                                        EM.error source region sv s
196                                           EM.nullErrorBody                                           EM.nullErrorBody
197                                    val { skeleton = sk, complain } =                                    val { skeleton = sk, complain } =
198                                        SkelCvt.convert { tree = tree,                                       SkelCvt.convert { tree = tree, err = err }
                                                         err = err }  
199                                in                                in
200                                    if noerrors then () else complain ();                                    if noerrors then () else complain ();
201                                    if EM.anyErrors (EM.errors source) then                                    if EM.anyErrors (EM.errors source) then
202                                        if noerrors then ()                                        if noerrors then ()
203                                        else error EM.COMPLAIN                                       else error gp i EM.COMPLAIN
204                                                   "error(s) in ML source file"                                                   "error(s) in ML source file"
205                                                   EM.nullErrorBody                                                   EM.nullErrorBody
206                                    else (SkelIO.write (skelpath, sk);                                    else (SkelIO.write (skelpath, sk);
207                                          skeleton := SOME sk);                                          skeleton := SOME sk);
208                                    sk                                    sk
209                                end                                end
210                              | NONE => Skeleton.Ref SymbolSet.empty))                             | NONE => Skeleton.Ref SymbolSet.empty)
211                end
212      end      end
213    
214      (* first check the time stamp, then do your stuff... *)      (* first check the time stamp, then do your stuff... *)
215      fun skeleton0 noerrors i = (validate i; getSkeleton (i, noerrors))      fun skeleton0 noerrors gp i = (validate i; getSkeleton gp (i, noerrors))
216    
217      (* we only complain at the time of getting the exports *)      (* we only complain at the time of getting the exports *)
218      val exports = SkelExports.exports o (skeleton0 false)      fun exports gp i = SkelExports.exports (skeleton0 false gp i)
219      val skeleton = skeleton0 true      val skeleton = skeleton0 true
220    
221      fun parsetree i = Option.map #tree (getParseTree (i, true, true))      fun parsetree gp i =
222            Option.map #tree (getParseTree gp (i, true, true))
223    
224      fun spec (INFO { sourcepath, ... }) = AbsPath.spec sourcepath      fun spec (INFO { sourcepath, ... }) = AbsPath.spec sourcepath
225      fun fullSpec (INFO { group, sourcepath, ... }) =      fun fullSpec (INFO { sourcepath, persinfo = PERS { group, ... }, ... }) =
226          concat [AbsPath.spec group, "(", AbsPath.spec sourcepath, ")"]          concat [AbsPath.spec (#1 group), "(", AbsPath.spec sourcepath, ")"]
227      fun name (INFO { sourcepath, ... }) = AbsPath.name sourcepath      fun name (INFO { sourcepath, ... }) = AbsPath.name sourcepath
228      fun fullName (INFO { group, sourcepath, ... }) =      fun fullName (INFO { sourcepath, persinfo = PERS { group, ... }, ... }) =
229          concat [AbsPath.name group, "(", AbsPath.spec sourcepath, ")"]          concat [AbsPath.name (#1 group), "(", AbsPath.spec sourcepath, ")"]
230  end  end

Legend:
Removed from v.296  
changed lines
  Added in v.297

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