Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/cm/tools/make/tool.sml
ViewVC logotype

View of /sml/trunk/src/cm/tools/make/tool.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1078 - (download) (annotate)
Tue Feb 19 21:26:48 2002 UTC (17 years, 7 months ago) by blume
File size: 2153 byte(s)
a mix of changes to CM and FFI
(*
 * A tool for running "make" from CM.
 *
 *   (C) 2000 Lucent Technologies, Bell Laboratories
 *
 * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
 *)
structure MakeTool = struct
    local
	open Tools

	val tool = "Make-Command"	(* the name of this tool *)
	val class = "make"		(* the name of the class *)
	val stdCmdPath = "make"		(* the shell command to invoke it *)
	val kw_class = "class"
	val kw_options = "options"

	fun err m = raise ToolError { tool = tool, msg = m }

	fun rule { spec, context, native2pathmaker, defaultClassOf, sysinfo } = let
	    val { name = str, mkpath, opts = too, ... } : spec = spec
	    val (tclass, topts, mopts) =
		case too of
		    NONE => (NONE, NONE, [])
		  | SOME options => let
			val { matches, restoptions } =
			    parseOptions
				{ tool = tool,
				  keywords = [kw_class, kw_options],
				  options = options }
		    in
			(case matches kw_class of
			     SOME [STRING { name, ... }] => SOME name
			   | NONE => NONE
			   | _ => err "invalid class specification",
			 matches kw_options,
			 restoptions)
		    end
	    val p = srcpath (mkpath ())
	    val tname = nativeSpec p	(* for passing to "make" *)
	    val partial_expansion =
		(* The "make" class is odd in that it has only a target
		 * but no sources.  We use "str" and "mkpath", that is,
		 * we retain the distinction between native and standard
		 * paths instead of going native in all cases. *)
		({ smlfiles = [], cmfiles = [], sources = [] },
		 [{ name = str, mkpath = mkpath,
		    class = tclass, opts = topts, derived = true }])
	    fun runcmd () = let
		val cmdname = mkCmdName stdCmdPath
		val tname =
		    if OS.Path.isAbsolute tname then
			OS.Path.mkRelative
			    { path = tname,
			      relativeTo = OS.FileSys.getDir () }
		    else tname
		val cmd = concat (cmdname :: foldr (fn (x, l) => " " :: x :: l)
				                   [" ", tname] mopts)
	    in
		vsay ["[", cmd, "]\n"];
		if OS.Process.system cmd = OS.Process.success then ()
		else err cmd
	    end
	    fun rulefn () = (runcmd (); partial_expansion)
	in
	    context rulefn
	end
    in
        val _ = registerClass (class, rule)
    end
end

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