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/tools/tools.sml
[smlnj] / sml / trunk / src / cm / tools / tools.sml  
ViewVC logotype

Diff of /sml/trunk/src/cm/tools/tools.sml

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

revision 274, Fri May 14 05:23:02 1999 UTC revision 275, Sat May 15 09:54:52 1999 UTC
# Line 10  Line 10 
10      type fname = string      type fname = string
11      type class = string      type class = string
12    
     exception UnknownClass of class  
13      exception ToolError of { tool: string, msg: string }      exception ToolError of { tool: string, msg: string }
14    
15      type item = fname * class option      type item = fname * class option
# Line 67  Line 66 
66        | ISGROUP        | ISGROUP
67        | ISTOOL of class * rule        | ISTOOL of class * rule
68    
69      val expand : AbsPath.t * class option -> expansion list      val expand : (string -> unit) -> AbsPath.t * class option -> expansion list
70  end  end
71    
72  structure PrivateTools :> PRIVATETOOLS = struct  structure PrivateTools :> PRIVATETOOLS = struct
# Line 75  Line 74 
74      type fname = string      type fname = string
75      type class = string      type class = string
76    
     exception UnknownClass of class  
77      exception ToolError of { tool: string, msg: string }      exception ToolError of { tool: string, msg: string }
78    
79      type item = fname * class option      type item = fname * class option
# Line 150  Line 148 
148            | NONE => gen_loop (!gen_classifiers)            | NONE => gen_loop (!gen_classifiers)
149      end      end
150    
151        fun expand error = let
152    
153      (* get the rule corresponding to a given class *)      (* get the rule corresponding to a given class *)
154      fun class2rule class =      fun class2rule class =
155          case StringMap.find (!classes, class) of          case StringMap.find (!classes, class) of
156              SOME rule => rule              SOME rule => rule
157            | NONE => raise UnknownClass class                | NONE => (error (concat ["unknown class \"", class, "\""]);
158                             ISSML NONE)
159    
160      (* apply a rule to a path within a given context *)      (* apply a rule to a path within a given context *)
161      fun apply (rule, p, c) = let      fun apply (rule, p, c) = let
# Line 165  Line 166 
166                  (OS.FileSys.chDir dir; rf () before OS.FileSys.chDir cwd)                  (OS.FileSys.chDir dir; rf () before OS.FileSys.chDir cwd)
167          in          in
168              (Interrupt.guarded doit)              (Interrupt.guarded doit)
169              handle exn => (OS.FileSys.chDir cwd; raise exn)                  handle ToolError { tool, msg } =>
170                                (OS.FileSys.chDir cwd;
171                                 error (concat ["tool \"", tool, "\" failed: ",
172                                                msg]);
173                                 [])
174                         | exn => (OS.FileSys.chDir cwd; raise exn)
175          end          end
176      in      in
177          rule (p, rctxt)          rule (p, rctxt)
# Line 176  Line 182 
182            | loop (acc, ((p, c), history) :: t) = let            | loop (acc, ((p, c), history) :: t) = let
183                  fun step (ISSML share) =                  fun step (ISSML share) =
184                      let                      let
185                          val ap = AbsPath.native { context = context, spec = p }                              val ap = AbsPath.native { context = context,
186                                                          spec = p }
187                          val src = { sourcepath = ap,                          val src = { sourcepath = ap,
188                                      history = rev history,                                      history = rev history,
189                                      share = share }                                      share = share }
# Line 184  Line 191 
191                          loop (SMLSOURCE src :: acc, t)                          loop (SMLSOURCE src :: acc, t)
192                      end                      end
193                    | step ISGROUP = let                    | step ISGROUP = let
194                          val ap = AbsPath.native { context = context, spec = p }                              val ap = AbsPath.native { context = context,
195                                                          spec = p }
196                      in                      in
197                          loop (GROUP ap :: acc, t)                          loop (GROUP ap :: acc, t)
198                      end                      end
# Line 206  Line 214 
214          fn l => loop ([], l)          fn l => loop ([], l)
215      end      end
216    
217      fun expand (ap, SOME class) =          fun expand0 (ap, SOME class) =
218          (case class2rule class of          (case class2rule class of
219               ISSML share =>               ISSML share =>
220                   [SMLSOURCE { sourcepath = ap, history = [], share = share }]                       [SMLSOURCE { sourcepath = ap, history = [],
221                                      share = share }]
222             | ISGROUP =>             | ISGROUP =>
223                   [GROUP ap]                   [GROUP ap]
224             | ISTOOL (class, rule) => let             | ISTOOL (class, rule) => let
# Line 219  Line 228 
228               in               in
229                   expand' (AbsPath.context ap) l'                   expand' (AbsPath.context ap) l'
230               end)               end)
231        | expand (ap, NONE) =            | expand0 (ap, NONE) =
232               expand' (AbsPath.context ap) [((AbsPath.spec ap, NONE), [])]               expand' (AbsPath.context ap) [((AbsPath.spec ap, NONE), [])]
233        in
234            expand0
235        end
236    
237      (* registering standard classes and classifiers *)      (* registering standard classes and classifiers *)
238      local      local
Legend:
Removed from v.274  
changed lines
  Added in v.275
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge