﻿"#", "(C) 2014-2020 FrankHB.",
"NPLA1 script as common library.";

"XXX", "'SHBuild_2*' depend on 'cygpath' optionally.";
"XXX", "'SHBuild_CheckUName_*' depend on 'uname'.";

$import! std.strings regex-match? string->regex ++ string->symbol symbol->string
	string-empty? string<-,
$import! std.environments bound? $binds1? value-of,
$import! std.io puts,
$import! std.system system system-get system-quote,
$import! std.promises $lazy force;
$import! env_SHBuild_ SHBuild_RaiseError_ SHBuild_EchoVar SHBuild_QuoteS_
	SHBuild_String_absolute_path?_  SHBuild_TrimOptions_ SHBuild_SDot_
	SHBuild_BuildGCH_existed_ SHBuild_BuildGCH_mkpdirp_;

"NOTE", "Prelude:", "Unsafe functions not friendly to environment stability",
	" or dangerous to environments except 'assign!' and",
	" 'lock-current-environment' are poisoned.";
$provide/d! (move! assign%! assign@! copy-environment lock-environment
	$defrec! $setrec! make-standard-environment) mods
(
	$def! fns (unwrap list) move! assign%! assign@! copy-environment
		lock-environment $defrec! $setrec!;
	$defl/e! raise-error mods (&fn) SHBuild_RaiseError_
		(++ "ERROR: Use of unsafe function '" fn "' is not allowed.");
	$defl! poison-fn (&fn &env)
		eval (list $defl/e! fn (() make-standard-environment)
			(string->symbol ".") raise-error (symbol->string fn)) env;
	$defw! poison (fns) d for-each-ltr ($lambda (fn) poison-fn fn d) fns;
	poison fns;
	$def! nstd (() make-standard-environment);
	eval (list poison (list $quote fns)) nstd;
	$defl/e! make-standard-environment nstd () () lock-current-environment
);

$def! $redef! $def!;
$defl! rmatch? (x r) regex-match? x (string->regex r);
$defl! putss (.xs) puts (apply ++ xs);
$defl! cmd-error-msg_ (cmd) ++ "Failed to call command: " cmd ".";
$defl! system-ok (cmd) eqv? (system cmd) 0;
$defl! system-check (cmd)
	$unless (system-ok cmd) (SHBuild_RaiseError_ (cmd-error-msg_ cmd));
$defv! $set-if-empty! (var .vexpr) env $if (string-empty? (eval var env))
	(eval (list $set! env var vexpr) env);

"NOTE", "Saving environments at first to avoid being overriden unexpectedly.";
$provide/d! (safeenv-get safeenv-set ss-verbose-puts) ext-env
(
	$import! std.system env-empty?;

	"NOTE", "Nonempty environment variable 'SS_*' would enable specifically.",
		"See user documentation Tools/Scripts.zh-CN.md.";
	$def! SS_DebugEnv not? (env-empty? "SS_DebugEnv"),
	$def! SS_Verbose not? (env-empty? "SS_Verbose");
	$def! mods $bindings/p->environment
		(std.environments std.strings std.system std.io)
		(emap () make-environment)
		(SS_DebugEnv SS_DebugEnv)
		(SS_Verbose SS_Verbose)
		(log-set $if SS_DebugEnv
			($lambda/e ext-env (name value)
				(puts "SS_DebugEnv: "; SHBuild_EchoVar name value))
			($lambda .));

	"TODO", "Optimize with continuations.";
	$defl/e! safeenv-get mods (name)
		$letrec ((sym string->symbol name) (denv () get-current-environment))
			$if (eval (list $binds1? emap sym) denv)
				(eval (list sym) emap)
				($def! v env-get name; eval (list $set! emap sym v) denv; v),
	$defl/e! safeenv-set mods (name val)
	(
		$letrec ((sym string->symbol name) (denv () get-current-environment))
			$unless (eval (list $binds1? emap sym) denv)
				eval (list $set! emap sym (env-get name)) denv;
		log-set name val;
		env-set name val
	),
	$defl/e! ss-verbose-puts mods (str)
		($if SS_Verbose (puts str))
);
$defl! safeenv-empty? (&n) string-empty? (safeenv-get n);
$defl! safeenv-restore (&n) safeenv-set n (safeenv-get n);

$defv! $env-de! (var .vexpr) env
	$let ((t safeenv-get (symbol->string var)))
		eval (list $def! var
			($if (string-empty? t) (list (unwrap eval) vexpr env) t)) env;
$defv! $set-system-var! (var arg) env $unless (eval (list $binds1? env var) env)
	($let* ((cmd eval arg env) ((rstr code .) system-get cmd)) $if (eqv? code 0)
		(eval (list $def! var rstr) env)
		(SHBuild_RaiseError_ (cmd-error-msg_ cmd)));
$defv! $assert (var pred? msg) env $unless
	($and? (eval (list $binds1? env var) env)
		(pred? (eval var env)))
	(SHBuild_RaiseError_ (++ "Variable " (SHBuild_QuoteS_
		(symbol->string var)) " shall " msg "."));
"TODO", "Use 'string?'.";
$defv! $assert-nonempty (var) env
	eval (list $assert var ($lambda (str) not? (string-empty? str))
		"be a string of nonempty value") env;
$defv! $assert-absolute-path (var) env
	eval (list $assert var SHBuild_String_absolute_path?_
		"be a string of absolute path") env;
$defl! cons-cmd (.xs) apply ++ (map1 ($lambda (s) ++ s " ") xs);

$defl! SHBuild_CheckUName_Case_ (x) $cond
	((rmatch? x ".*Darwin.*") "OS_X")
	(($or? (rmatch? x ".*MSYS.*") (rmatch? x ".*MINGW.*")) "Win32")
	((rmatch? x ".*Linux.*") "Linux")
	(#t "unknown");
$defl! SHBuild_CheckUNameM_Case_ (x) $cond
	((rmatch? x "x86_64|i.*86-64") "x86_64")
	((rmatch? x "i.*86") x)
	((rmatch? x "aarch64") x)
	(#t "unknown");
$defl! SHBuild_GetLangFlags_
	(var flags-pic flags-common flags-impl flags-dbg)
	$let ((val safeenv-get var))
		SHBuild_TrimOptions_ ($if (string-empty? val)
			(cons-cmd flags-pic flags-common flags-impl flags-dbg) val);

$defl! win32? (env-os) eqv? env-os "Win32";
$defl! get-nul-dev (env-os) $if (win32? env-os) "NUL" "/dev/null";
$defl! get-tmp-dir (env-os) SHBuild_GetTempDir env-os;
$defl! get-tmp-nul (env-os) ++ (get-tmp-dir env-os) "/null";
"NOTE",
	"The output path cannot be '/dev/null'. See http://sourceforge.net/p/msys2/discussion/general/thread/2d6adff2/?limit=25.";
$defl! system-or-puts (env-os cmd str) $let (((rstr code .)
	system-get (cons-cmd cmd (system-quote str) "2>" (get-nul-dev env-os))))
	$if (eqv? code 0) rstr str;

$defl! compile-ok (src compile out opt err-out)
(
	$unless (safeenv-empty? "SHELL")
		(string<- src (system-quote src));
	system-ok (cons-cmd "echo" src "|" (system-quote compile) "-xc++" "-o"
		(system-quote out) opt "- 2>" err-out)
);
$defl! compile-ok-silent (env-os src compile opt)
	compile-ok src compile (get-tmp-nul env-os) opt (get-nul-dev env-os);

$defl! SHBuild_2m (env-os pth) system-or-puts env-os "cygpath -m" pth;
$defl! SHBuild_2u (env-os pth) system-or-puts env-os "cygpath -au" pth;
$defl! SHBuild_2w (env-os pth) system-or-puts env-os "cygpath -w" pth;

$defl! SHBuild_EchoVar_N (var) SHBuild_EchoVar var
	(safeenv-get (SHBuild_SDot_ var));

$defl! SHBuild_GetPlatformStrings ()
(
	"XXX", "'SHBuild_CheckUName_*' depend on 'uname'";
	$env-de! SHBuild_Env_OS ($set-system-var! SHBuild_Env_uname "uname";
		SHBuild_CheckUName_Case_ SHBuild_Env_uname),
	$env-de! SHBuild_Env_Arch ($set-system-var! SHBuild_Env_uname_m "uname -m";
		SHBuild_CheckUNameM_Case_ SHBuild_Env_uname_m);
	list SHBuild_Env_OS SHBuild_Env_Arch
);
$defl! SHBuild_GetTempDir (env-os)
(
	$defl! search (&x) $cond
		((null? x) SHBuild_2m env-os "/tmp")
		((safeenv-empty? (first& x)) search (rest& x))
		(#t safeenv-get (first& x));
	search (list "TMPDIR" "TEMP" "TMP");
);
$defl! SHBuild_GetSystemPrefix (platform) $cond
	((eqv? platform "MinGW64") "/mingw64")
	((eqv? platform "MinGW32") "/mingw32")
	(#t "/usr");
$defl! SHBuild_Platform_Detect (env-os env-arch)
(
	$env-de! MSYSTEM;
	$cond
		((win32? env-os) $cond
			((eqv? MSYSTEM "MINGW64") "MinGW64")
			((eqv? MSYSTEM "MINGW32") "MinGW32")
			((eqv? env-arch "x86_64") "MinGW64")
			((eqv? env-arch "aarch64") (SHBuild_RaiseError_
				"ERROR: The architecture aarch64 is not supported in MinGW."))
			(#t "MinGW32"))
		(#t env-os)
);

$def! SHBuild_CmdCache_ ();
$defl%! SHBuild_CmdCache_At_ (env-os) assv env-os SHBuild_CmdCache_;
$defl! SHBuild_CmdCache_GetEnv_ (env-os)
(
	$def! r SHBuild_CmdCache_At_ env-os;
	$if (null? r)
	(
		list-push-front! SHBuild_CmdCache_ (list env-os (() make-environment));
		assign! r (SHBuild_CmdCache_At_ env-os)
	);
	first (rest& r)
);
$defl! SHBuild_CheckCXX (env-os cxx)
	$let ((e SHBuild_CmdCache_GetEnv_ env-os) (sym string->symbol cxx))
	(
		$unless (eval (list bound? cxx) e)
		(
			eval (list $def! sym ($lazy $if (compile-ok-silent env-os
				"int main(){return __clang__;}" cxx "")
				"Clang++" "G++")) e;
		);
		force (eval% sym e)
	);

$defl! get-thread-option (cxx err-out)
(
	"TODO", "Impl without pthread?";
	$defl! dmp-test (name) (system-ok (cons-cmd (system-quote cxx)
		"-dumpspecs 2>& 1 | grep" name ">" err-out));
	$if (dmp-test "no-pthread:")
		($if (dmp-test "mthreads:") "-mthreads" "") "-pthread"
);
$defl! get-thread-option-silent (env-os cxx)
	get-thread-option cxx (get-nul-dev env-os);
$defl! get-SHBOPT_ (outdir shbopt-ext use-ld)
(
	$def! opt cons-cmd (++ "-xd,\"" outdir "\"") shbopt-ext;
	$if use-ld (cons-cmd opt "-xmode,2") opt
);
$defl! SHB_SetupPlatformVars_ (e env-os)
(
	$def! LIBPFX safeenv-get "LIBPFX";
	$def! DSOSFX safeenv-get "DSOSFX";
	$def! EXESFX safeenv-get "EXESFX";
	$if (win32? env-os)
	(
		$set-if-empty! DSOSFX ".dll";
		$set-if-empty! EXESFX ".exe"
	)
	(
		$set-if-empty! LIBPFX "lib";
		$set-if-empty! DSOSFX ".so";
	);
	$set! e (LIBPFX DSOSFX EXESFX) (list LIBPFX DSOSFX EXESFX)
);

$defl! ld-ext-noadjust_ #ignore "";
$defl! ld-ext-adjust_win32_subsystem_ (env-os)
(
	$if ($and? (win32? env-os)
		(string-empty? (safeenv-get "SHBuild_NoAdjustSubsystem")))
		(ss-verbose-puts "Added \"-mwindows\" to LDFLAGS."; "-mwindows")
		""
);

$defl! build-with-conf-opt (outdir env-os debug dynamic shbopt-ext app
	do-ld-ext do-build)
(
	$def! CXXFLAGS_OPT_DBG
		$if debug ("-O0 -g -D_GLIBCXX_DEBUG -D_GLIBCXX_DEBUG_PEDANTIC") "";
	($env-de! CXX "g++"; safeenv-set "CXX" CXX),
	"TODO", "Implement SHBuild_GetAR_.";
	($env-de! AR "ar"; safeenv-set "AR" AR),
	($env-de! ARFLAGS "rcs"; safeenv-set "ARFLAGS" ARFLAGS),
	($env-de! LD CXX; safeenv-set "LD" LD);
	"TODO", "Add sanity checks.";
	$env-de! C_CXXFLAGS_GC "-fdata-sections -ffunction-sections";
	$env-de! LDFLAGS_GC
		($if (eqv? env-os "OS_X") "-Wl,--dead-strip" "-Wl,--gc-sections");
	"NOTE", "See https://gcc.gnu.org/onlinedocs/gcc/Link-Options.html#Link-Options,",
		"also https://clang.llvm.org/docs/ClangCommandLineReference.html#linker-flags.";
	$env-de! LDFLAGS_STRIP "-s";
	"#", "-Wl,--print-gc-sections";
	$def! SHBuild_CXX_Style_ SHBuild_CheckCXX env-os CXX;
	$unless (compile-ok-silent env-os "int main(){}" CXX
		(cons-cmd C_CXXFLAGS_GC LDFLAGS_GC))
	(
		$redef! C_CXXFLAGS_GC "",
		$redef! LDFLAGS_GC ""
	);
	$env-de! C_CXXFLAGS_PIC $if (win32? env-os) "" "-fPIC";
	$env-de! C_CXXFLAGS_COMMON cons-cmd "-pipe" C_CXXFLAGS_GC
		(safeenv-get "C_CXXFLAGS_ARCH") "-pedantic-errors";
	$env-de! C_CXXFLAGS_OPT_LV "-O3";
	$env-de! C_CXXFLAGS_WARNING cons-cmd "-Wall" "-Wcast-align" "-Wdeprecated"
		"-Wdeprecated-declarations" "-Wextra" "-Wfloat-equal" "-Wformat=2"
		"-Winvalid-pch" "-Wmissing-declarations" "-Wmissing-include-dirs"
		"-Wmultichar" "-Wno-format-nonliteral" "-Wredundant-decls" "-Wshadow"
		"-Wsign-conversion";
	$def! cxxflags_impl_common_thrd_ get-thread-option-silent env-os CXX;
	$env-de! CXXFLAGS_IMPL_WARNING "";
	$env-de! C_CXXFLAGS_COMMON_IMPL_ "";
	$env-de! CXXFLAGS_IMPL_OPT "";
	$env-de! C_CXXFLAGS_IMPL_WARNING "";
	$env-de! LDFLAGS_IMPL_OPT "";
	$cond
		((eqv? SHBuild_CXX_Style_ "Clang++")
		(
			$set-if-empty! C_CXXFLAGS_COMMON_IMPL_
				"-fno-merge-all-constants";
			$set-if-empty! CXXFLAGS_IMPL_WARNING cons-cmd
				"-Wno-deprecated-register" "-Wno-mismatched-tags"
				"-Wno-missing-braces" "-Wshorten-64-to-32" "-Wweak-vtables";
			$set-if-empty! CXXFLAGS_IMPL_OPT "-flto";
			$set-if-empty! LDFLAGS_IMPL_OPT "-flto"
		))
		((eqv? SHBuild_CXX_Style_ "G++")
		(
			$set-if-empty! C_CXXFLAGS_IMPL_WARNING cons-cmd "-Wdouble-promotion"
				"-Wlogical-op" "-Wtrampolines" "-Wsuggest-attribute=const"
				"-Wsuggest-attribute=noreturn" "-Wsuggest-attribute=pure"
				"-Wsuggest-final-types" "-Wsuggest-final-methods";
			$set-if-empty! CXXFLAGS_IMPL_WARNING cons-cmd
				"-Wconditionally-supported" "-Wno-noexcept-type"
				"-Wstrict-null-sentinel" "-Wzero-as-null-pointer-constant";
			$set-if-empty! CXXFLAGS_IMPL_OPT cons-cmd
				"-fexpensive-optimizations" "-flto=jobserver"
				"-fno-enforce-eh-specs";
			"XXX", "Workarond for LTO bug on MinGW. See https://sourceware.org/bugzilla/show_bug.cgi?id=12762.";
			$set-if-empty! LDFLAGS_IMPL_OPT $if (win32? env-os)
				"-fexpensive-optimizations -flto -Wl,-allow-multiple-definition"
				"-fexpensive-optimizations -flto"
		));
	$env-de! CFLAGS_STD "-std=c11";
	$env-de! CFLAGS_WARNING cons-cmd C_CXXFLAGS_WARNING C_CXXFLAGS_IMPL_WARNING;
	$env-de! CFLAGS_COMMON cons-cmd C_CXXFLAGS_COMMON CFLAGS_STD CFLAGS_WARNING;
	$env-de! CXXFLAGS_IMPL_COMMON cons-cmd cxxflags_impl_common_thrd_
		"-U__GXX_MERGED_TYPEINFO_NAMES" "-D__GXX_MERGED_TYPEINFO_NAMES=1";
	$env-de! CXXFLAGS_STD "-std=c++11";
	$env-de! CXXFLAGS_WARNING cons-cmd CFLAGS_WARNING "-Wctor-dtor-privacy"
		"-Wnon-virtual-dtor" "-Woverloaded-virtual" "-Wsign-promo"
		CXXFLAGS_IMPL_WARNING;
	$env-de! CXXFLAGS_COMMON cons-cmd CXXFLAGS_STD
		C_CXXFLAGS_COMMON CXXFLAGS_WARNING CXXFLAGS_IMPL_COMMON;
	$set-if-empty! CXXFLAGS_OPT_DBG cons-cmd C_CXXFLAGS_OPT_LV
		($if (safeenv-empty? "CXXFLAGS_OPT_UseAssert") "-DNDEBUG" "")
		CXXFLAGS_IMPL_OPT "-fomit-frame-pointer";
	"XXX", "Rename %CXXFLAGS_OPT_DBG -> CFLAGS_OPT_DBG/C_CXXFLAGS_OPT_DBG?";
	$defl! get-lang-flags (var flags-common)
		(SHBuild_GetLangFlags_ var C_CXXFLAGS_PIC flags-common
			C_CXXFLAGS_COMMON_IMPL_ CXXFLAGS_OPT_DBG);
	$def! CFLAGS get-lang-flags "CFLAGS" CFLAGS_COMMON;
	$def! CXXFLAGS get-lang-flags "CXXFLAGS" CXXFLAGS_COMMON;
	"#", "%LDFLAGS_OPT_DBG is always set despite %debug configuration in",
		" %SHBuild-BuildApp.sh.";
	$env-de! LDFLAGS_OPT_DBG $if debug ""
		(cons-cmd LDFLAGS_STRIP LDFLAGS_IMPL_OPT LDFLAGS_GC);
	$def! LDFLAGS_DYN_BASE safeenv-get "LDFLAGS_DYN_BASE";
	$def! LIBS_RPATH safeenv-get "LIBS_RPATH";
	$if (win32? env-os) ($set-if-empty! LDFLAGS_DYN_BASE "-shared -Wl,--dll")
	(
		$set-if-empty! LDFLAGS_DYN_BASE "-shared";
		$set-if-empty! LIBS_RPATH ++ "-Wl,-rpath,"
			(SHBuild_QuoteS_ "$ORIGIN:$ORIGIN/../lib")
	);
	SHB_SetupPlatformVars_ (() get-current-environment) env-os;
	$env-de! LDFLAGS_DYN_EXTRA cons-cmd "-Wl,--no-undefined"
		(++ "-Wl,--dynamic-list-data,--dynamic-list-cpp-new,"
		"--dynamic-list-cpp-typeinfo");
	$env-de! LDFLAGS_DYN cons-cmd LDFLAGS_DYN_BASE LDFLAGS_DYN_EXTRA;
	"#", "Forced setting %LDFLAGS for debug configurations?";
	$def! LDFLAGS cons-cmd C_CXXFLAGS_PIC cxxflags_impl_common_thrd_
		LDFLAGS_OPT_DBG;
	"#", "%LDFLAGS_OPT_DBG is set to ' ' in %SHBuild-BuildApp.sh.";
	"#", "Following settings are not in %SHBuild-common-options.sh.";
	$redef! LDFLAGS SHBuild_TrimOptions_ (cons-cmd (SHBuild_TrimOptions_
		LDFLAGS) ($if app (cons-cmd ($if dynamic LIBS_RPATH "")
		(do-ld-ext env-os)) ($if dynamic (cons-cmd LDFLAGS_DYN) "-Wl,--dn")));
	safeenv-set "LDFLAGS" LDFLAGS;
	$def! SHBOPT get-SHBOPT_ outdir shbopt-ext ($or? dynamic app);
	$defl! echo-var (var) SHBuild_EchoVar var (value-of var);
	"XXX", "The values of following variables may be overriden in 'do-build'.";
	"TODO", "Print actual values being used in 'do-build' as possible.";
	echo-var "CXXFLAGS";
	echo-var "LDFLAGS";
	echo-var "SHBOPT";
	do-build CXX CXXFLAGS SHBOPT LIBPFX
);

$defl! get_env_SHB_ (env-os)
(
	SHB_SetupPlatformVars_ (() get-current-environment) env-os;

	$def! cmd_noerr_ ++ "2>" (get-nul-dev env-os);
	"#", "Following private environment variables are used: SHBuild.",
		" This is expected to be stage 1";
	$def! e_S1_SHBuild_ () system-quote (safeenv-get "SHBuild");
	$defl! e_rm_ (pth)
	(
		"TODO", "Avoid deletion if possible?";
		"XXX", "This relies on 'rm'", "Error is ignored.";
		system (cons-cmd "rm" (system-quote pth) cmd_noerr_)
	);
	$if (win32? env-os)
		($defl! e_add_x_ (#ignore));
	(
		$defl! e_add_x_ (pth)
		(
			"XXX", "This relies on 'chmod'", "Error is ignored.";
			system-check (cons-cmd "chmod" "+x" pth)
		)
	);
	$defl! InstSHBuild (type dst src)
	(
		$assert-nonempty dst,
		$assert-nonempty src;
		"TODO",
			"More specific error handling in system-check and SHBuld command?";
		$cond
		((eqv? type "Link") (
			e_rm_ dst;
			$unless (system-ok (cons-cmd e_S1_SHBuild_
				"-xcmd,InstallSymbolicLink" dst src cmd_noerr_)) InstSHBuild
				"File" dst src
		))
		((eqv? type "HardLink") (
			e_rm_ dst;
			$unless (system-ok (cons-cmd e_S1_SHBuild_ "-xcmd,InstallHardLink"
				dst src cmd_noerr_)) InstSHBuild "File" dst src
		))
		(#t (system-check
			(cons-cmd e_S1_SHBuild_ (++ "-xcmd,Install" type) dst src);
			$if (eqv? type "Executable") (e_add_x_ dst))
		);
	);
	"NOTE",
		"This is basically same to %SHBuild_BuildGCH in %SHBuild-common.sh.",
		"Except the input path cannot have quotes and the function would",
		" always fail despite 'set -e' setting in shell scripts,",
		" and the tool would be quoted in the call.",
		"Params of %BuildGCH_:", "header = path of header to be copied",
		"inc = path of header to be included", "tool = tool to build header",
		"cmd = options for the tool";
	$defl! BuildGCH_ (header inc tool tool-opts)
	(
		$def! pch ++ inc ".gch";
		$def! qpch system-quote pch;
		$if (SHBuild_BuildGCH_existed_ pch)
			(putss "PCH file " qpch " exists, skipped building.")
			(
				SHBuild_BuildGCH_mkpdirp_ pch;
				putss "Building precompiled file " qpch " ...";
				InstSHBuild "HardLink" inc header;
				system-check (cons-cmd (system-quote tool) (SHBuild_TrimOptions_
					(cons-cmd tool-opts (system-quote header) (++ "-o" qpch))));
				putss "Building precompiled file " qpch " done."
			)
	);
	$defl! InstLibS (from-dir to-dir name)
	(
		$assert-nonempty from-dir,
		$assert-nonempty to-dir,
		$assert-nonempty name;
		InstSHBuild "HardLink" (++ to-dir "/lib" name ".a")
			(++ from-dir "/" LIBPFX name ".a")
	);
	$defl! InstLibD (from-dir name to-dir SR_DSO_Dest SR_DSO_Imp)
	(
		$assert-nonempty from-dir,
		$assert-nonempty SR_DSO_Dest,
		$assert-nonempty name;
		$def! target ++ LIBPFX name DSOSFX;
		$def! dest ++ SR_DSO_Dest "/" target;
		InstSHBuild "HardLink" dest (++ from-dir "/" target);
		$unless (string-empty? SR_DSO_Imp) ($assert-nonempty to-dir)
			(InstSHBuild "Link" (++ to-dir "/" target SR_DSO_Imp) dest)
	);
	$defl! InstInc (from-dir to-dir)
	(
		$assert-nonempty from-dir,
		$assert-nonempty to-dir;
		InstSHBuild "Directory" to-dir from-dir
	);
	$defl! InstHardLinkExe (from-dir to-dir name)
	(
		$assert-nonempty name;
		$def! dst ++ to-dir "/" name EXESFX;
		$def! src ++ from-dir "/" name ".exe";
		InstSHBuild "HardLink" dst src;
		e_add_x_ dst
	);
	$defl! InstNPLA1Module_ (from-dir to-dir name)
	(
		"TODO", "Use other location for NPLA1 library?";
		$assert-nonempty name,
		$assert-nonempty to-dir,
		$assert-nonempty from-dir;
		InstSHBuild "File" (++ to-dir "/" name) (++ from-dir "/" name)
	);
	$defl! InstTool (from-dir to-dir name)
	(
		$assert-nonempty name,
		$assert-nonempty to-dir,
		$assert-nonempty from-dir;
		InstSHBuild "Executable" (++ to-dir "/" name) (++ from-dir "/" name)
	);
	$if (win32? env-os)
	(
		$defl! InstUACManifestForExe (from to-dir name)
			InstSHBuild "HardLink" (++ to-dir "/" name EXESFX ".manifest") from
	);

	() lock-current-environment
);

