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
ViewVC logotype

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

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

revision 275, Sat May 15 09:54:52 1999 UTC revision 276, Mon May 17 06:01:28 1999 UTC
# Line 38  Line 38 
38      (* classifiers are used when the class is not given explicitly *)      (* classifiers are used when the class is not given explicitly *)
39      datatype classifier =      datatype classifier =
40          SFX_CLASSIFIER of string -> class option          SFX_CLASSIFIER of string -> class option
41        | GEN_CLASSIFIER of string -> class option        | GEN_CLASSIFIER of fname -> class option
42    
43      (* make a classifier which looks for a specific file name suffix *)      (* make a classifier which looks for a specific file name suffix *)
44      val stdSfxClassifier : { sfx: string, class: class } -> classifier      val stdSfxClassifier : { sfx: string, class: class } -> classifier
45    
46        (* two standard ways of dealing with filename extensions... *)
47        datatype extensionStyle =
48            EXTEND of string list
49          | REPLACE of string list * string list
50    
51        (* perform filename extension *)
52        val extend : extensionStyle -> fname -> fname list
53    
54        (* check for outdated files *)
55        val outdated : string -> fname list * fname -> bool
56    
57      (* install a classifier *)      (* install a classifier *)
58      val registerClassifier : classifier -> unit      val registerClassifier : classifier -> unit
59    
# Line 108  Line 119 
119      (* classifiers are used when the class is not given explicitly *)      (* classifiers are used when the class is not given explicitly *)
120      datatype classifier =      datatype classifier =
121          SFX_CLASSIFIER of string -> class option          SFX_CLASSIFIER of string -> class option
122        | GEN_CLASSIFIER of string -> class option        | GEN_CLASSIFIER of fname -> class option
123    
124      (* make a classifier which looks for a specific file name suffix *)      (* make a classifier which looks for a specific file name suffix *)
125      fun stdSfxClassifier { sfx, class } =      fun stdSfxClassifier { sfx, class } =
# Line 214  Line 225 
225              fn l => loop ([], l)              fn l => loop ([], l)
226          end          end
227    
228          fun expand0 (ap, SOME class) =          fun expand0 (ap, NONE) =
229              (case class2rule class of              expand' (AbsPath.context ap) [((AbsPath.spec ap, NONE), [])]
230              | expand0 (ap, SOME class0) = let
231                    (* classes are case-insensitive, internally we use lowercase *)
232                    val class = String.map Char.toLower class0
233                in
234                    case class2rule class of
235                   ISSML share =>                   ISSML share =>
236                       [SMLSOURCE { sourcepath = ap, history = [],                       [SMLSOURCE { sourcepath = ap, history = [],
237                                    share = share }]                                    share = share }]
# Line 227  Line 243 
243                       val l' = map (fn i => (i, [class])) l                       val l' = map (fn i => (i, [class])) l
244                   in                   in
245                       expand' (AbsPath.context ap) l'                       expand' (AbsPath.context ap) l'
246                   end)                      end
247            | expand0 (ap, NONE) =              end
                  expand' (AbsPath.context ap) [((AbsPath.spec ap, NONE), [])]  
248      in      in
249          expand0          expand0
250      end      end
251    
252        (* make the most common kind of rule *)
253        datatype extensionStyle =
254            EXTEND of string list
255          | REPLACE of string list * string list
256    
257        fun extend (EXTEND l) f = map (fn s => concat [f, ".", s]) l
258          | extend (REPLACE (ol, nl)) f = let
259                val { base, ext } = OS.Path.splitBaseExt f
260                fun join b e = OS.Path.joinBaseExt { base = b, ext = SOME e }
261                fun gen b = map (join b) nl
262                fun sameExt (e1: string) (e2: string) = e1 = e2
263            in
264                case ext of
265                    NONE => gen base
266                  | SOME e =>
267                        if List.exists (sameExt e) ol then gen base else gen f
268            end
269    
270        fun outdated tool (l, f) = let
271            val (ftime, fexists) =
272                (OS.FileSys.modTime f, true)
273                handle _ => (Time.zeroTime, false)
274            fun olderThan t f = Time.< (OS.FileSys.modTime f, t)
275        in
276            (List.exists (olderThan ftime) l)
277            handle _ => if fexists then true
278                        else raise ToolError { tool = tool,
279                                               msg = "cannot access " ^ f }
280        end
281    
282      (* registering standard classes and classifiers *)      (* registering standard classes and classifiers *)
283      local      local
284          fun sfx (s, c) =          fun sfx (s, c) =
# Line 250  Line 295 
295      end      end
296  end  end
297    
298  structure Tools :> TOOLS = PrivateTools  structure Tools : TOOLS = PrivateTools

Legend:
Removed from v.275  
changed lines
  Added in v.276

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