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/branches/SMLNJ/src/system/HostCompiler/cm-hook.sml
ViewVC logotype

View of /sml/branches/SMLNJ/src/system/HostCompiler/cm-hook.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 475 - (download) (annotate)
Wed Nov 10 22:59:58 1999 UTC (19 years, 8 months ago) by monnier
File size: 2947 byte(s)
version 110.24
(*
 * Hook module for CM.
 *   This module exists to break the static dependency between CM and
 *   the compiler.  This way we avoid lengthy waits for the autoloader
 *   when touching CM at the interactive toplevel.
 *   (CM is there and running at bootstrap time, so it can easily
 *    install itself into the hook if this is what's desired.)
 *
 *   Copyright (c) 1999 by Lucent Bell Laboratories
 *
 * author: Matthias Blume (blume@cs.princeton.edu)
 *)
structure CmHook = struct
    local
	(* some dummy routines to make up the initial contents of the hook *)
	fun b's_b (b: bool) (s: string) = false
	fun s_b (s: string) = false
	fun u_u () = ()
	val b_gs = { get = fn () => false, set = fn (x: bool) => () }
	val i_gs = { get = fn () => 0, set = fn (x: int) => () }
	fun s_iogs (s: string) =
	    { get = fn () => SOME 0, set = fn (x: int option) => () }
	fun s_u (s: string) = ()
	fun s's_u (s1: string, s2: string) = ()
	fun server_start { name: string, cmd: string * string list,
			   pathtrans: (string -> string) option,
			   pref: int } = false
	fun server_stop (s: string) = ()
	fun server_kill (s: string) = ()

	(* the hook itself *)
	val hook = ref { stabilize = b's_b,
			 recomp = s_b,
			 make = s_b,
			 autoload = s_b,
			 reset = u_u,
			 verbose = b_gs,
			 debug = b_gs,
			 keep_going = b_gs,
			 warn_obsolete = b_gs,
			 parse_caching = i_gs,
			 setAnchor = s's_u,
			 cancelAnchor = s_u,
			 resetPathConfig = u_u,
			 synchronize = u_u,
			 showPending = u_u,
			 listLibs = u_u,
			 dismissLib = s_u,
			 symval = s_iogs,
			 server_start = server_start,
			 server_stop = server_stop,
			 server_kill = server_kill }

	fun gs label = let
	    fun get' () = let
		val { get, set } = label (!hook)
	    in
		get ()
	    end
	    fun set' x = let
		val { get, set } = label (!hook)
	    in
		set x
	    end
	in
	    { get = get', set = set' }
	end
    in
	(* the routine to be called at bootstrap time... *)
	fun init v = hook := v

	local
	in
	    (* the CM structure that will be visible at top-level *)
	    structure CM = struct
		fun stabilize b s = #stabilize (!hook) b s
		fun recomp s = #recomp (!hook) s
		fun make s = #make (!hook) s
		fun autoload s = #autoload (!hook) s
		fun reset () = #reset (!hook) ()
		val verbose = gs #verbose
		val debug = gs #debug
		val keep_going = gs #keep_going
		val warn_obsolete = gs #warn_obsolete
		val parse_caching = gs #parse_caching
		fun setAnchor (a, s) = #setAnchor (!hook) (a, s)
		fun cancelAnchor a = #cancelAnchor (!hook) a
		fun resetPathConfig () = #resetPathConfig (!hook) ()
		fun synchronize () = #synchronize (!hook) ()
		fun showPending () = #showPending (!hook) ()
		fun listLibs () = #listLibs (!hook) ()
		fun dismissLib l = #dismissLib (!hook) l
		fun symval s = #symval (!hook) s
		fun server_start a = #server_start (!hook) a
		fun server_stop s = #server_stop (!hook) s
		fun server_kill s = #server_kill (!hook) s
	    end
	end
    end
end

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