[MLton] cvs commit: added flag -sequence-unit {false|true}

Stephen Weeks sweeks@mlton.org
Fri, 13 Feb 2004 09:05:57 -0800


sweeks      04/02/13 09:05:57

  Modified:    .        Makefile
               basis-library/arrays-and-vectors array2.sml sequence.fun
               basis-library/general option.sml
               basis-library/io stream-io.fun
               basis-library/net socket.sml
               basis-library/posix error.sml io.sml primitive.sml
                        process.sml signal.sml tty.sml
               basis-library/real pack-real.sml
               basis-library/system process.sml time.sml
               doc      changelog
               doc/user-guide man-page.tex
               lib/mlton/basic hash-set.sml
               man      mlton.1
               mlton/control control.sig control.sml
               mlton/elaborate elaborate-core.fun elaborate-env.fun
                        type-env.fun type-env.sig
               mlton/main main.fun
  Log:
  MAIL added flag -sequence-unit {false|true}
  
  If true, then in the sequence expression (e1; e2), it is a type
  error if e1 is not of type unit.
  
  I implemented it as an error rather than a warning, because it is
  easily implemented by unifying the type of e1 with unit, which may
  cause a type error.  To implement as a warning would require not
  unifying, and delaying the check of e1's type until undetermined types
  are reported, which seems to me like it could be more confusing that
  immediately reporting the error.  For example, consider what should be
  the inferred type of f in
  
  val f =
     let
     in
        fn g => (g (); ())
     end
  
  Forcing g to return type unit means that the type of f is "(unit ->
  unit) -> unit".  If we didn't force g to return unit, then we wouldn't
  know whether to issue a warning or not until we discover the type of
  f.
  
  Compiling the basis library with -sequence-unit true turned up a few
  spurious errors, and even caught several bugs in cases where return
  values from system calls were being ignored.
  
  I also fixed the one spurious error in the MLton library.
  
  There are a couple hundred such errors in the MLton sources proper.
  I'll look into those at some point.

Revision  Changes    Path
1.108     +1 -1      mlton/Makefile

Index: Makefile
===================================================================
RCS file: /cvsroot/mlton/mlton/Makefile,v
retrieving revision 1.107
retrieving revision 1.108
diff -u -r1.107 -r1.108
--- Makefile	14 Jan 2004 22:04:25 -0000	1.107
+++ Makefile	13 Feb 2004 17:05:54 -0000	1.108
@@ -206,7 +206,7 @@
 world: 
 	$(MAKE) world-no-check
 	@echo 'Type checking basis.'
-	$(MLTON) -dead-code false -stop tc >/dev/null
+	$(MLTON) -dead-code false -sequence-unit true -stop tc >/dev/null
 
 .PHONY: world-no-check
 world-no-check: 



1.3       +41 -30    mlton/basis-library/arrays-and-vectors/array2.sml

Index: array2.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/array2.sml,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- array2.sml	10 Apr 2002 07:02:15 -0000	1.2
+++ array2.sml	13 Feb 2004 17:05:54 -0000	1.3
@@ -75,23 +75,25 @@
 	       let
 		  val cols = length row1
 		  val a as {array, ...} = arrayUninit (length rows, cols)
-	       in List.foldl
-		  (fn (row: 'a list, i) =>
-		   let
-		      val max = i +? cols
-		      val i' =
-			 List.foldl (fn (x: 'a, i) =>
-				     (if i >= max
-					 then raise Size
-				      else (Primitive.Array.update (array, i, x)
-					    ; i + 1)))
-			 i row
-		   in if i' = max
-			 then i'
-		      else raise Size
-		   end)
-		  0 rows
-		  ; a
+		  val _ =
+		     List.foldl
+		     (fn (row: 'a list, i) =>
+		      let
+			 val max = i +? cols
+			 val i' =
+			    List.foldl (fn (x: 'a, i) =>
+					(if i >= max
+					    then raise Size
+					 else (Primitive.Array.update (array, i, x)
+					       ; i + 1)))
+			    i row
+		      in if i' = max
+			    then i'
+			 else raise Size
+		      end)
+		     0 rows
+	       in
+		  a
 	       end
 
       fun row ({rows, cols, array}, r) =
@@ -171,23 +173,32 @@
 		     (* The list holds the elements in row major order,
 		      * but reversed.
 		      *)
-		     (List.foldl (fn (x, i) => (Primitive.Array.update (a, i, x)
-						; i -? 1))
-		      (size -? 1) l
-		      ; ())
+		     let
+			val _ =
+			   List.foldl (fn (x, i) =>
+				       (Primitive.Array.update (a, i, x)
+					; i -? 1))
+			   (size -? 1) l
+		     in
+			()
+		     end
 		| ColMajor =>
 		     (* The list holds the elements in column major order,
 		      * but reversed.
 		      *)
-		     (List.foldl (fn (x, (spot, r)) =>
-				  (Primitive.Array.update (a, spot, x)
-				   ; if r = 0
-					then (spot -? 1 +? size -? cols,
-					      rows -? 1)
-				     else (spot -? cols, r -? 1)))
-		      (size -? 1, rows -? 1)
-		      l
-		      ; ())
+		     let
+			val _ =
+			   List.foldl (fn (x, (spot, r)) =>
+				       (Primitive.Array.update (a, spot, x)
+					; if r = 0
+					     then (spot -? 1 +? size -? cols,
+						   rows -? 1)
+					  else (spot -? cols, r -? 1)))
+			   (size -? 1, rows -? 1)
+			   l
+		     in
+			()
+		     end
 		  ; {rows = rows, cols = cols, array = a}
 	       end
 	 else



1.16      +5 -2      mlton/basis-library/arrays-and-vectors/sequence.fun

Index: sequence.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/arrays-and-vectors/sequence.fun,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- sequence.fun	3 Feb 2004 06:56:08 -0000	1.15
+++ sequence.fun	13 Feb 2004 17:05:54 -0000	1.16
@@ -84,8 +84,11 @@
       fun new (n, x) = tabulate (n, fn _ => x)
 
       fun fromList l =
-	 let val a = array (List.length l)
-	 in List.foldl (fn (c, i) => (Array.update (a, i, c) ; i +? 1)) 0 l ;
+	 let
+	    val a = array (List.length l)
+	    val _ =
+	       List.foldl (fn (c, i) => (Array.update (a, i, c) ; i +? 1)) 0 l
+	 in
 	    fromArray a
 	 end
 



1.6       +1 -1      mlton/basis-library/general/option.sml

Index: option.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/general/option.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- option.sml	23 Jun 2003 00:55:33 -0000	1.5
+++ option.sml	13 Feb 2004 17:05:54 -0000	1.6
@@ -15,7 +15,7 @@
    fn NONE => NONE
     | SOME a => SOME (f a)
 
-fun app f z = (map f z; ())
+fun app f z = (ignore (map f z); ())
 
 fun compose (f, g) c = map f (g c)
 



1.26      +3 -3      mlton/basis-library/io/stream-io.fun

Index: stream-io.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/io/stream-io.fun,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- stream-io.fun	11 Feb 2004 21:26:32 -0000	1.25
+++ stream-io.fun	13 Feb 2004 17:05:55 -0000	1.26
@@ -805,9 +805,9 @@
 					let
 					   val curPos = getPos ()
 					in
-					   setPos b;
-					   readVec pos;
-					   getPos () before setPos curPos
+					   setPos b
+					   ; ignore (readVec pos)
+					   ; getPos () before setPos curPos
 					end
 				   | _ => 
 					liftExn (instreamName is) "filePosIn" IO.RandomAccessNotSupported))



1.9       +9 -7      mlton/basis-library/net/socket.sml

Index: socket.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/net/socket.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- socket.sml	12 Feb 2004 19:04:08 -0000	1.8
+++ socket.sml	13 Feb 2004 17:05:55 -0000	1.9
@@ -252,14 +252,16 @@
 in
    fun withNonBlock (fd, f: unit -> 'a) =
       let
-	 val flags = PIO.fcntl2 (fd, PIO.F_GETFL)
-	 val _ = PIO.fcntl3 (fd, PIO.F_SETFL,
-			     Word.toIntX
-			     (Word.orb (Word.fromInt flags,
-					PosixPrimitive.FileSys.O.nonblock)))
+	 val flags = PE.checkReturnResult (PIO.fcntl2 (fd, PIO.F_GETFL))
+	 val _ =
+	    PE.checkResult
+	    (PIO.fcntl3 (fd, PIO.F_SETFL,
+			 Word.toIntX
+			 (Word.orb (Word.fromInt flags,
+				    PosixPrimitive.FileSys.O.nonblock))))
       in
-	 DynamicWind.wind (f, fn () => (PIO.fcntl3 (fd, PIO.F_SETFL, flags)
-					; ()))
+	 DynamicWind.wind
+	 (f, fn () => PE.checkResult (PIO.fcntl3 (fd, PIO.F_SETFL, flags)))
       end
 end
 



1.7       +1 -1      mlton/basis-library/posix/error.sml

Index: error.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/error.sml,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- error.sml	6 Jan 2004 05:12:27 -0000	1.6
+++ error.sml	13 Feb 2004 17:05:55 -0000	1.7
@@ -39,5 +39,5 @@
       fun checkReturnResult (n: int) = if n = ~1 then error () else n
       fun checkReturnPosition (n: Position.int) =
 	 if n = ~1 then error () else n
-      fun checkResult n = (checkReturnResult n; ())
+      fun checkResult n = (ignore (checkReturnResult n); ())
    end



1.14      +1 -1      mlton/basis-library/posix/io.sml

Index: io.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/io.sml,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- io.sml	11 Feb 2004 19:16:11 -0000	1.13
+++ io.sml	13 Feb 2004 17:05:55 -0000	1.14
@@ -230,8 +230,8 @@
 				      in
 					pos := curPos; curPos
 				      end
+		   val _ = verifyPos ()
 		 in
-		   verifyPos ();
 		   {pos = pos,
 		    getPos = SOME getPos,
 		    setPos = SOME setPos,



1.22      +37 -38    mlton/basis-library/posix/primitive.sml

Index: primitive.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/primitive.sml,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- primitive.sml	12 Feb 2004 23:13:38 -0000	1.21
+++ primitive.sml	13 Feb 2004 17:05:55 -0000	1.22
@@ -14,7 +14,6 @@
       type fd = int
       type uid = word
       type gid = word
-      type signal = int
       type size = int
       type ssize = int
       type mode = word
@@ -123,14 +122,14 @@
       
       structure Signal:>
 	 sig
-	    eqtype signal
+	    eqtype t
 	    type how
 
-	    val fromInt: int -> signal
-	    val toInt: signal -> int
+	    val fromInt: int -> t
+	    val toInt: t -> int
 	 end =
 	 struct
-	    type signal = signal
+	    type t = int
       	    type how = int
 
 	    val fromInt = fn s => s
@@ -141,46 +140,46 @@
 	 struct
 	    open Signal
 	       
-	    val abrt = _const "Posix_Signal_abrt": signal;
-	    val alrm = _const "Posix_Signal_alrm": signal;
-	    val bus = _const "Posix_Signal_bus": signal;
-	    val chld = _const "Posix_Signal_chld": signal;
-	    val cont = _const "Posix_Signal_cont": signal;
-	    val fpe = _const "Posix_Signal_fpe": signal;
-	    val hup = _const "Posix_Signal_hup": signal;
-	    val ill = _const "Posix_Signal_ill": signal;
-	    val int = _const "Posix_Signal_int": signal;
-	    val kill = _const "Posix_Signal_kill": signal;
-	    val pipe = _const "Posix_Signal_pipe": signal;
-	    val prof = _const "Posix_Signal_prof": signal;
-	    val quit = _const "Posix_Signal_quit": signal;
-	    val segv = _const "Posix_Signal_segv": signal;
-	    val stop = _const "Posix_Signal_stop": signal;
-	    val term = _const "Posix_Signal_term": signal;
-	    val tstp = _const "Posix_Signal_tstp": signal;
-	    val ttin = _const "Posix_Signal_ttin": signal;
-	    val ttou = _const "Posix_Signal_ttou": signal;
-	    val usr1 = _const "Posix_Signal_usr1": signal;
-	    val usr2 = _const "Posix_Signal_usr2": signal;
-	    val vtalrm = _const "Posix_Signal_vtalrm": signal;
+	    val abrt = _const "Posix_Signal_abrt": t;
+	    val alrm = _const "Posix_Signal_alrm": t;
+	    val bus = _const "Posix_Signal_bus": t;
+	    val chld = _const "Posix_Signal_chld": t;
+	    val cont = _const "Posix_Signal_cont": t;
+	    val fpe = _const "Posix_Signal_fpe": t;
+	    val hup = _const "Posix_Signal_hup": t;
+	    val ill = _const "Posix_Signal_ill": t;
+	    val int = _const "Posix_Signal_int": t;
+	    val kill = _const "Posix_Signal_kill": t;
+	    val pipe = _const "Posix_Signal_pipe": t;
+	    val prof = _const "Posix_Signal_prof": t;
+	    val quit = _const "Posix_Signal_quit": t;
+	    val segv = _const "Posix_Signal_segv": t;
+	    val stop = _const "Posix_Signal_stop": t;
+	    val term = _const "Posix_Signal_term": t;
+	    val tstp = _const "Posix_Signal_tstp": t;
+	    val ttin = _const "Posix_Signal_ttin": t;
+	    val ttou = _const "Posix_Signal_ttou": t;
+	    val usr1 = _const "Posix_Signal_usr1": t;
+	    val usr2 = _const "Posix_Signal_usr2": t;
+	    val vtalrm = _const "Posix_Signal_vtalrm": t;
 
 	    val block = _const "Posix_Signal_block": how;
-	    val default = _import "Posix_Signal_default": signal -> int;
+	    val default = _import "Posix_Signal_default": t -> int;
 	    val handleGC = _import "Posix_Signal_handleGC": unit -> unit;
-	    val handlee = _import "Posix_Signal_handle": signal -> int;
-	    val ignore = _import "Posix_Signal_ignore": signal -> int;
+	    val handlee = _import "Posix_Signal_handle": t -> int;
+	    val ignore = _import "Posix_Signal_ignore": t -> int;
 	    val isDefault =
-	       _import "Posix_Signal_isDefault": signal * bool ref -> int;
+	       _import "Posix_Signal_isDefault": t * bool ref -> int;
 	    val isGCPending = _import "Posix_Signal_isGCPending": unit -> bool;
-	    val isPending = _import "Posix_Signal_isPending": signal -> bool;
+	    val isPending = _import "Posix_Signal_isPending": t -> bool;
 	    val numSignals = _const "Posix_Signal_numSignals": int;
 	    val setmask = _const "Posix_Signal_setmask": how;
-	    val sigaddset = _import "Posix_Signal_sigaddset": signal -> int;
-	    val sigdelset = _import "Posix_Signal_sigdelset": signal -> int;
+	    val sigaddset = _import "Posix_Signal_sigaddset": t -> int;
+	    val sigdelset = _import "Posix_Signal_sigdelset": t -> int;
 	    val sigemptyset = _import "Posix_Signal_sigemptyset": unit -> int;
 	    val sigfillset = _import "Posix_Signal_sigfillset": unit -> int;
 	    val sigprocmask = _import "Posix_Signal_sigprocmask": how -> int;
-	    val suspend = _import "Posix_Signal_suspend": unit -> int;
+	    val suspend = _import "Posix_Signal_suspend": unit -> unit;
 	    val unblock = _const "Posix_Signal_unblock": how;
 	 end
       
@@ -209,11 +208,11 @@
 	    val ifSignaled = _import "Posix_Process_ifSignaled"
 	       : Status.t -> bool;
 	    val ifStopped = _import "Posix_Process_ifStopped": Status.t -> bool;
-	    val kill = _import "Posix_Process_kill": Pid.t * signal -> int;
+	    val kill = _import "Posix_Process_kill": Pid.t * Signal.t -> int;
 	    val pause = _import "Posix_Process_pause": unit -> int;
 	    val sleep = _import "Posix_Process_sleep": int -> int;
-	    val stopSig = _import "Posix_Process_stopSig": Status.t -> signal;
-	    val termSig = _import "Posix_Process_termSig": Status.t -> signal;
+	    val stopSig = _import "Posix_Process_stopSig": Status.t -> Signal.t;
+	    val termSig = _import "Posix_Process_termSig": Status.t -> Signal.t;
 	    val waitpid =
 	       _import "Posix_Process_waitpid"
 	       : Pid.t * Status.t ref * int -> Pid.t;



1.18      +8 -8      mlton/basis-library/posix/process.sml

Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/process.sml,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- process.sml	12 Feb 2004 23:13:38 -0000	1.17
+++ process.sml	13 Feb 2004 17:05:55 -0000	1.18
@@ -18,7 +18,7 @@
       val pidToWord = SysWord.fromInt o Pid.toInt
 
       structure MLton = Primitive.MLton
-
+	 
       fun fork () =
 	 let
 	    val p = Prim.fork ()
@@ -49,10 +49,10 @@
 	       fun doit () =
 		  case fork () of
 		     NONE => 
-			(PosixIO.writeVec (outfd,
-					   Word8VectorSlice.full
-					   (Word8Vector.tabulate
-					    (1, fn _ => 0w0)))
+			(ignore (PosixIO.writeVec (outfd,
+						   Word8VectorSlice.full
+						   (Word8Vector.tabulate
+						    (1, fn _ => 0w0))))
 			 ; NONE)
 		   | SOME n =>
 			let
@@ -111,9 +111,9 @@
 		     0 => W_EXITED
 		   | n => W_EXITSTATUS (Word8.fromInt n))
 	 else if Prim.ifSignaled status
-	    then W_SIGNALED (PosixSignal.fromInt (Prim.termSig status))
+	    then W_SIGNALED (Prim.termSig status)
 	 else if Prim.ifStopped status
-	    then W_STOPPED (PosixSignal.fromInt (Prim.stopSig status))
+	    then W_STOPPED (Prim.stopSig status)
 	 else raise Fail "Posix.Process.fromStatus"
 
       structure W =
@@ -178,7 +178,7 @@
 		| K_SAME_GROUP => ~1
 		| K_GROUP pid => ~ (Pid.toInt pid)
 	 in
-	    Error.checkResult (Prim.kill (Pid.fromInt pid, PosixSignal.toInt s))
+	    Error.checkResult (Prim.kill (Pid.fromInt pid, s))
 	 end
 
       local



1.4       +2 -0      mlton/basis-library/posix/signal.sml

Index: signal.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/signal.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- signal.sml	6 Jan 2004 00:00:19 -0000	1.3
+++ signal.sml	13 Feb 2004 17:05:55 -0000	1.4
@@ -9,6 +9,8 @@
    struct
       open PosixPrimitive.Signal
 
+      type signal = t
+
       val fromWord = fromInt o SysWord.toInt
       val toWord = SysWord.fromInt o toInt
    end



1.6       +2 -2      mlton/basis-library/posix/tty.sml

Index: tty.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/posix/tty.sml,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- tty.sml	11 Feb 2004 19:16:11 -0000	1.5
+++ tty.sml	13 Feb 2004 17:05:55 -0000	1.6
@@ -134,8 +134,8 @@
 		; Termios.setoflag oflag
 		; Termios.setcflag cflag
 		; Termios.setlflag lflag
-		; Termios.setospeed ospeed
-		; Termios.setispeed ispeed
+		; PosixError.checkResult (Termios.setospeed ospeed)
+		; PosixError.checkResult (Termios.setispeed ispeed)
 		; let val cs = Termios.cc () 
 		  in Util.naturalForeach
 		     (V.nccs, fn i => Cstring.update (cs, i, V.sub (cc, i)))



1.8       +4 -4      mlton/basis-library/real/pack-real.sml

Index: pack-real.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/real/pack-real.sml,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- pack-real.sml	27 Dec 2003 06:02:37 -0000	1.7
+++ pack-real.sml	13 Feb 2004 17:05:55 -0000	1.8
@@ -19,9 +19,9 @@
 fun update (a, i, r) =
    let
       val a = Word8Array.toPoly a
+      val _ = Array.checkSlice (a, i, SOME bytesPerElem)
    in
-      Array.checkSlice (a, i, SOME bytesPerElem)
-      ; up (a, i, r)
+      up (a, i, r)
    end
    
 local
@@ -35,9 +35,9 @@
 fun subVec (v, i) =
    let
       val v = Word8Vector.toPoly v
+      val _ = Vector.checkSlice (v, i, SOME bytesPerElem)
    in
-      Vector.checkSlice (v, i, SOME bytesPerElem)
-      ; sub (v, i)
+      sub (v, i)
    end
 
 fun fromBytes v = subVec (v, 0)



1.13      +1 -1      mlton/basis-library/system/process.sml

Index: process.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/process.sml,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -r1.12 -r1.13
--- process.sml	12 Feb 2004 23:13:38 -0000	1.12
+++ process.sml	13 Feb 2004 17:05:55 -0000	1.13
@@ -63,5 +63,5 @@
 
       fun sleep t = if Time.<= (t, Time.zeroTime)
 		       then ()
-		    else (Posix.Process.sleep t; ())
+		    else (ignore (Posix.Process.sleep t); ())
    end



1.14      +3 -1      mlton/basis-library/system/time.sml

Index: time.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/basis-library/system/time.sml,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- time.sml	16 Nov 2003 14:21:08 -0000	1.13
+++ time.sml	13 Feb 2004 17:05:55 -0000	1.14
@@ -63,7 +63,9 @@
  *)
 local
    fun getNow (): time =
-      (Prim.gettimeofday ()
+      (if ~1 = Prim.gettimeofday ()
+	  then raise Fail "Time.now"
+       else ()
        ; T (LargeInt.+ (LargeInt.* (LargeInt.fromInt (Prim.sec ()),
 				    ticksPerSecond),
 			LargeInt.fromInt (Prim.usec ()))))



1.103     +4 -0      mlton/doc/changelog

Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.102
retrieving revision 1.103
diff -u -r1.102 -r1.103
--- changelog	10 Feb 2004 12:05:37 -0000	1.102
+++ changelog	13 Feb 2004 17:05:55 -0000	1.103
@@ -1,5 +1,9 @@
 Here are the changes since version 20030716.
 
+* 2004-02-13
+  - Added flag -sequence-unit, which imposes the constraint that in
+    the sequence expression (e1; e2), e1 must be of type unit.
+
 * 2004-02-10
   - Lots of changes to MLton.Signal: name changes, removal of
     superfluous functions, additional functions.



1.48      +6 -0      mlton/doc/user-guide/man-page.tex

Index: man-page.tex
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/user-guide/man-page.tex,v
retrieving revision 1.47
retrieving revision 1.48
diff -u -r1.47 -r1.48
--- man-page.tex	10 Feb 2004 12:05:37 -0000	1.47
+++ man-page.tex	13 Feb 2004 17:05:56 -0000	1.48
@@ -134,6 +134,12 @@
 does not conform to the basis library specification, and may cause
 programs to seg fault.
 
+\option{-sequence-unit \falseTrue}
+If true, then in the sequence expression {\tt (e1; e2)}, it is a type
+error if {\tt e1} is not of type {\tt unit}.  This can be helpful in
+detecting curried applications that are mistakenly not fully applied.
+To silence spurious errors, you can use {\tt ignore e1}.
+
 \option{-show-basis \falseTrue}
 If true, {\mlton} prints the basis library and exits.  When used with
 an input file, {\mlton} prints the basis defined by the input program.



1.9       +3 -3      mlton/lib/mlton/basic/hash-set.sml

Index: hash-set.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/lib/mlton/basic/hash-set.sml,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- hash-set.sml	30 Jan 2003 01:42:38 -0000	1.8
+++ hash-set.sml	13 Feb 2004 17:05:56 -0000	1.9
@@ -204,9 +204,9 @@
       val s = new {hash = hash}
       val _ =
 	 List.foreach (l, fn a =>
-		       (lookupOrInsert (s, hash a,
-					fn b => equals (a, b),
-					fn _ => a)
+		       (ignore (lookupOrInsert (s, hash a,
+						fn b => equals (a, b),
+						fn _ => a)) 
 			; ()))
    in
       s



1.43      +7 -0      mlton/man/mlton.1

Index: mlton.1
===================================================================
RCS file: /cvsroot/mlton/mlton/man/mlton.1,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -r1.42 -r1.43
--- mlton.1	10 Feb 2004 12:05:38 -0000	1.42
+++ mlton.1	13 Feb 2004 17:05:56 -0000	1.43
@@ -141,6 +141,13 @@
 specification, and may cause programs to seg fault.
 
 .TP
+\fB-sequence-unit \fI{\fBfalse\fP|\fBtrue\fP}\fR
+If true, then in the sequence expression \fB(e1; e2)\fP, it is a type
+error if \fBe1\fP is not of type \fB unit\fP.  This can be helpful in
+detecting curried applications that are mistakenly not fully applied.
+To silence spurious errors, you can use \fBignore e1\fP.
+
+.TP
 \fB-show-basis \fI{\fBfalse\fP|\fBtrue\fP}\fR
 If true, \fBMLton\fP prints the basis library and exits.  When used
 with an input file, \fBmlton\fP prints the basis defined by the input



1.89      +3 -0      mlton/mlton/control/control.sig

Index: control.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sig,v
retrieving revision 1.88
retrieving revision 1.89
diff -u -r1.88 -r1.89
--- control.sig	31 Jan 2004 06:36:12 -0000	1.88
+++ control.sig	13 Feb 2004 17:05:56 -0000	1.89
@@ -211,6 +211,9 @@
       (* Array bounds checking. *)
       val safe: bool ref
 
+      (* in (e1; e2), require e1: unit. *)
+      val sequenceUnit: bool ref
+
       (* Show the basis library and exit. *)
       val showBasis: bool ref
 	 



1.109     +4 -0      mlton/mlton/control/control.sml

Index: control.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/control/control.sml,v
retrieving revision 1.108
retrieving revision 1.109
diff -u -r1.108 -r1.109
--- control.sml	31 Jan 2004 06:36:12 -0000	1.108
+++ control.sml	13 Feb 2004 17:05:56 -0000	1.109
@@ -393,6 +393,10 @@
 		    default = true,
 		    toString = Bool.toString}
 
+val sequenceUnit = control {name = "sequence unit",
+			    default = false,
+			    toString = Bool.toString}
+
 val showBasis = control {name = "show basis",
 			 default = false,
 			 toString = Bool.toString}



1.83      +34 -6     mlton/mlton/elaborate/elaborate-core.fun

Index: elaborate-core.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-core.fun,v
retrieving revision 1.82
retrieving revision 1.83
diff -u -r1.82 -r1.83
--- elaborate-core.fun	6 Feb 2004 23:00:30 -0000	1.82
+++ elaborate-core.fun	13 Feb 2004 17:05:56 -0000	1.83
@@ -306,7 +306,7 @@
 
 val unify =
    fn (t, t', preError, error) =>
-   Type.unify (t, t', {error = error,
+   Type.unify (t, t', {error = Control.error o error,
 		       preError = preError})
    
 fun unifyList (trs: (Type.t * Region.t) vector,
@@ -2120,12 +2120,40 @@
 	      | Aexp.Selector f => elab (Aexp.selector (f, region))
 	      | Aexp.Seq es =>
 		   let
-		      val es = Vector.map (es, elab)
-		   (* Could put warning here for expressions before a ; that
-		    * don't return unit.
-		    *)
+		      val es' = Vector.map (es, elab)
+		      val last = Vector.length es - 1
+		      (* Warning for expressions before a ; that don't return
+		       * unit.
+		       *)
+		      val _ =
+			 if not (!Control.sequenceUnit)
+			    then ()
+			 else
+			    Vector.foreachi
+			    (es', fn (i, e) =>
+			     if i = last
+				then ()
+			     else
+				let
+				   fun error _ =
+				      let
+					 val e = Vector.sub (es, i)
+					 open Layout
+				      in
+					 Control.warning
+					 (Aexp.region e,
+					  str "sequence expression not of type unit",
+					  seq [str "in: ",
+					       approximate (Aexp.layout e)])
+				      end
+				in
+				   Type.unify (Cexp.ty e, Type.unit,
+					       {error = error,
+						preError = preError})
+				end)
+
 		   in
-		      Cexp.make (Cexp.Seq es, Cexp.ty (Vector.last es))
+		      Cexp.make (Cexp.Seq es', Cexp.ty (Vector.sub (es', last)))
 		   end
 	      | Aexp.Var {name = id, ...} =>
 		   let



1.66      +2 -0      mlton/mlton/elaborate/elaborate-env.fun

Index: elaborate-env.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-env.fun,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -r1.65 -r1.66
--- elaborate-env.fun	12 Feb 2004 22:21:08 -0000	1.65
+++ elaborate-env.fun	13 Feb 2004 17:05:56 -0000	1.66
@@ -1563,6 +1563,7 @@
 	       let
 		  open Layout
 	       in
+		  Control.error
 		  (r,
 		   seq [str (concat [thing, " in structure disagrees with ",
 				     sign])],
@@ -1851,6 +1852,7 @@
 		      let
 			 open Layout
 		      in
+			 Control.error
 			 (region,
 			  seq [str "variable type in structure disagrees with ",
 			       str sign],



1.26      +3 -4      mlton/mlton/elaborate/type-env.fun

Index: type-env.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/type-env.fun,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -r1.25 -r1.26
--- type-env.fun	4 Feb 2004 15:33:13 -0000	1.25
+++ type-env.fun	13 Feb 2004 17:05:56 -0000	1.26
@@ -1724,11 +1724,10 @@
 	 end
 
       val unify =
-	 fn (t1: t, t2: t,
-	     {error: Layout.t * Layout.t -> Region.t * Layout.t * Layout.t,
-	      preError: unit -> unit}) =>
+	 fn (t1: t, t2: t, {error: Layout.t * Layout.t -> unit,
+			    preError: unit -> unit}) =>
 	 case unify (t1, t2, {preError = preError}) of
-	    NotUnifiable z => Control.error (error z)
+	    NotUnifiable z => error z
 	  | Unified => ()
    end
 



1.16      +2 -4      mlton/mlton/elaborate/type-env.sig

Index: type-env.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/type-env.sig,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- type-env.sig	3 Feb 2004 07:26:34 -0000	1.15
+++ type-env.sig	13 Feb 2004 17:05:56 -0000	1.16
@@ -50,10 +50,8 @@
 	    val toString: t -> string
 	    (* make two types identical (recursively).  side-effecting. *)
 	    val unify:
-	       t * t *
-	       {error: Layout.t * Layout.t -> Region.t * Layout.t * Layout.t,
-		preError: unit -> unit}
-	       -> unit 
+	       t * t * {error: Layout.t * Layout.t -> unit,
+			preError: unit -> unit} -> unit 
 	    val unresolvedInt: unit -> t
 	    val unresolvedReal: unit -> t
 	    val unresolvedWord: unit -> t



1.25      +3 -0      mlton/mlton/main/main.fun

Index: main.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/main/main.fun,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- main.fun	11 Feb 2004 17:58:43 -0000	1.24
+++ main.fun	13 Feb 2004 17:05:57 -0000	1.25
@@ -320,6 +320,9 @@
 	push runtimeArgs),
        (Normal, "safe", " {true|false}", "bounds checking and other checks",
 	boolRef safe),
+       (Normal, "sequence-unit", " {false|true}",
+	"in (e1; e2), require e1: unit",
+	boolRef sequenceUnit),
        (Normal, "show-basis", " {false|true}", "display the basis library",
 	boolRef showBasis),
        (Normal, "show-basis-used", " {false|true}",