diff --git a/base/cm/main/cm-boot.sml b/base/cm/main/cm-boot.sml index 46202add..9327ea09 100644 --- a/base/cm/main/cm-boot.sml +++ b/base/cm/main/cm-boot.sml @@ -7,6 +7,9 @@ * structure CM people find in $smlnj/cm/full.cm. * * author: Matthias Blume (blume@cs.princeton.edu) + * + * This module amended to include 'Execute as a script' change done by Dayanandan Natarajan, Heriot Watt University + * *) functor LinkCM (structure HostBackend : BACKEND) = struct @@ -690,7 +693,8 @@ functor LinkCM (structure HostBackend : BACKEND) = struct end end in - fun init (bootdir, de, er, useStream, useFile, errorwrap, icm) = let + (* New function useScriptFile included in the argument list as part of 'Execute as a script' change *) + fun init (bootdir, de, er, useStream, useScriptFile, useFile, errorwrap, icm) = let fun procCmdLine () = let val autoload' = errorwrap (ignore o autoload mkStdSrcPath) val make' = errorwrap (ignore o makeStd) @@ -701,6 +705,41 @@ functor LinkCM (structure HostBackend : BACKEND) = struct "!* unable to process '", file, "' (unknown extension '", ext, "')\n" ] (* end case *)) + + (* 'Execute as a script' change starts here. Change added by Dayanandan Natarajan *) + fun eatuntilnewline (instream : TextIO.instream): bool = let + val c = TextIO.input1 instream + in + case TextIO.lookahead instream of + SOME #"\n" => true + | SOME c => eatuntilnewline instream + | NONE => false + end + + fun checkSharpbang (instream : TextIO.instream): bool = let + val c = TextIO.input1 instream + in + case c of + SOME #"#" => ( + case TextIO.lookahead instream of + SOME #"!" => eatuntilnewline instream + | SOME c => false + | NONE => false + ) + | SOME c => false + | NONE => false + end + + fun processFileScript (fname) = let + val stream = TextIO.openIn fname + val isscript = checkSharpbang stream + in + if (isscript) = false + then ( Say.say [ "!* Script file doesn't start with #!. \n" ] ) + else ( useScriptFile (fname, stream) ) + end + (* 'Execute as a script' change ends here *) + fun inc n = n + 1 fun show_controls (getarg, getval, padval) level = let fun walk indent (ControlRegistry.RTree rt) = let @@ -778,6 +817,7 @@ functor LinkCM (structure HostBackend : BACKEND) = struct \ .cm (CM.make or CM.autoload)\n\ \ -m (switch to CM.make)\n\ \ -a (switch to CM.autoload; default)\n\ + \ --script (execute as a script)\n\ \ .sig (use)\n\ \ .sml (use)\n\ \ .fun (use)\n\ @@ -878,6 +918,7 @@ functor LinkCM (structure HostBackend : BACKEND) = struct | args ("-S" :: _ :: _, mk) = (showcur NONE; nextarg mk) | args (["-E"], _) = (show_envvars NONE; quit ()) | args ("-E" :: _ :: _, mk) = (show_envvars NONE; nextarg mk) + | args ("--script" :: _, _) = (nextargscript ()) (* added as part of 'Execute as a script' change *) | args ("@CMbuild" :: rest, _) = mlbuild rest | args (["@CMredump", heapfile], _) = redump_heap heapfile | args (f :: rest, mk) = @@ -890,6 +931,13 @@ functor LinkCM (structure HostBackend : BACKEND) = struct let val l = SMLofNJ.getArgs () in SMLofNJ.shiftArgs (); args (l, mk) end + + (* nextargscript added as part of 'Execute as a script' change *) + and nextargscript () = + let val l = SMLofNJ.getArgs () + in SMLofNJ.shiftArgs (); processFileScript (hd l); quit () + end + in case SMLofNJ.getArgs () of ["@CMslave"] => (#set StdConfig.verbose false; slave ()) diff --git a/base/compiler/TopLevel/interact/interact.sig b/base/compiler/TopLevel/interact/interact.sig index be83754c..3fc6d33a 100644 --- a/base/compiler/TopLevel/interact/interact.sig +++ b/base/compiler/TopLevel/interact/interact.sig @@ -2,6 +2,9 @@ * * COPYRIGHT (c) 2019 The Fellowship of SML/NJ (http://www.smlnj.org) * All rights reserved. + * + * This module amended to include 'Execute as a script' change done by Dayanandan Natarajan, Heriot Watt University + * *) signature INTERACT = @@ -27,6 +30,7 @@ signature INTERACT = val useFile : string -> bool val useStream : TextIO.instream -> unit + val useScriptFile : string * TextIO.instream -> unit (* Addded as part of Execute as a script change *) val evalStream : TextIO.instream * Environment.environment -> Environment.environment val withErrorHandling : bool -> (* true: treat all exns like usercode exns *) diff --git a/base/compiler/TopLevel/interact/interact.sml b/base/compiler/TopLevel/interact/interact.sml index e726ebcf..509aa5d2 100644 --- a/base/compiler/TopLevel/interact/interact.sml +++ b/base/compiler/TopLevel/interact/interact.sml @@ -2,6 +2,9 @@ * * COPYRIGHT (c) 2017 The Fellowship of SML/NJ (http://www.smlnj.org) * All rights reserved. + * + * This module amended to include 'Execute as a script' change done by Dayanandan Natarajan, Heriot Watt University + * *) functor Interact(EvalLoop : EVALLOOP) : INTERACT = @@ -91,6 +94,15 @@ functor Interact(EvalLoop : EVALLOOP) : INTERACT = fun useStream stream = EvalLoop.evalStream ("", stream) + (* Function added as part of Execute as a script change*) + fun useScriptFile (fname, stream) = ( + + (EvalLoop.evalStream (fname, stream)) + handle exn => ( + EvalLoop.uncaughtExnMessage exn + ) + ) + fun evalStream (stream, baseEnv) = let val r = ref Environment.emptyEnv val base = { set = fn _ => raise Fail "evalStream: #set base", diff --git a/base/system/smlnj/internal/boot-env-fn.sml b/base/system/smlnj/internal/boot-env-fn.sml index d9b2d1f6..12d81b0d 100644 --- a/base/system/smlnj/internal/boot-env-fn.sml +++ b/base/system/smlnj/internal/boot-env-fn.sml @@ -5,6 +5,9 @@ * completely redone by M.Blume (5/1998) * ... and again in the course of switching over to the new CM * (M. Blume, 7/1999) + * + * This module amended to include 'Execute as a script' change done by Dayanandan Natarajan, Heriot Watt University + * *) signature BOOTENV = sig val init: @@ -15,6 +18,7 @@ functor BootEnvF (datatype envrequest = AUTOLOAD | BARE val architecture: string val cminit : string * DynamicEnv.env * envrequest * (TextIO.instream -> unit)(* useStream *) + * (string * TextIO.instream -> unit) (* useScriptFile - added as part of 'Execute as a script' change *) * (string -> unit) (* useFile *) * ((string -> unit) -> (string -> unit)) (* errorwrap *) @@ -70,6 +74,7 @@ functor BootEnvF (datatype envrequest = AUTOLOAD | BARE U.pStruct := U.NILrde; cminit (bootdir, de, er, Backend.Interact.useStream, + Backend.Interact.useScriptFile, (* added as part of Execute as a script change *) errorwrap false useFile, errorwrap true, Backend.Interact.installCompManagers)