Execute as a script

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
 		     \    <file>.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\
 		     \    <file>.sig       (use)\n\
 		     \    <file>.sml       (use)\n\
 		     \    <file>.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 ())

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 *)

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 ("<instream>", 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",

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)