[MLton-commit] r4195

Stephen Weeks MLton@mlton.org
Thu, 10 Nov 2005 16:14:38 -0800


Hid the mistakenly exposed fact that {Bin,Text}IO.outstream is an
equality type.


----------------------------------------------------------------------

U   mlton/trunk/basis-library/io/imperative-io.fun
U   mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
U   mlton/trunk/basis-library/mlton/bin-io.sig
U   mlton/trunk/basis-library/mlton/text-io.sig

----------------------------------------------------------------------

Modified: mlton/trunk/basis-library/io/imperative-io.fun
===================================================================
--- mlton/trunk/basis-library/io/imperative-io.fun	2005-11-10 23:37:14 UTC (rev 4194)
+++ mlton/trunk/basis-library/io/imperative-io.fun	2005-11-11 00:14:33 UTC (rev 4195)
@@ -77,19 +77,37 @@
 (*                     outstream                     *)
 (* ------------------------------------------------- *)
 
-datatype outstream = Out of SIO.outstream ref
+(* The following :> hides the fact that Outstream.t is an eqtype.  Doing it
+ * here is much easier than putting :> on the functor result.
+ *)
+structure Outstream:>
+   sig
+      type t
 
-fun output (Out os, v) = SIO.output (!os, v)
-fun output1 (Out os, v) = SIO.output1 (!os, v)
-fun outputSlice (Out os, v) = SIO.outputSlice (!os, v)
-fun flushOut (Out os) = SIO.flushOut (!os)
-fun closeOut (Out os) = SIO.closeOut (!os)
-fun mkOutstream os = Out (ref os)
-fun getOutstream (Out os) = !os
-fun setOutstream (Out os, os') = os := os'
-fun getPosOut (Out os) = SIO.getPosOut (!os)
-fun setPosOut (Out os, outPos) = os := SIO.setPosOut outPos
+      val get: t -> SIO.outstream
+      val make: SIO.outstream -> t
+      val set: t *  SIO.outstream -> unit
+   end =
+   struct 
+      datatype t = T of SIO.outstream ref
 
+      fun get (T r) = !r
+      fun set (T r, s) = r := s
+      fun make s = T (ref s)
+   end
+
+type outstream = Outstream.t
+fun output (os, v) = SIO.output (Outstream.get os, v)
+fun output1 (os, v) = SIO.output1 (Outstream.get os, v)
+fun outputSlice (os, v) = SIO.outputSlice (Outstream.get os, v)
+fun flushOut os = SIO.flushOut (Outstream.get os)
+fun closeOut os = SIO.closeOut (Outstream.get os)
+val mkOutstream = Outstream.make
+val getOutstream = Outstream.get
+val setOutstream  = Outstream.set
+val getPosOut = SIO.getPosOut o Outstream.get
+fun setPosOut (os, outPos) = Outstream.set (os, SIO.setPosOut outPos)
+
 fun newOut {appendMode, bufferMode, closeAtExit, fd, name} =
    let
       val writer = mkWriter {appendMode = appendMode, 

Modified: mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig
===================================================================
--- mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig	2005-11-10 23:37:14 UTC (rev 4194)
+++ mlton/trunk/basis-library/libs/basis-extra/top-level/basis.sig	2005-11-11 00:14:33 UTC (rev 4195)
@@ -622,6 +622,10 @@
       sharing type Word64VectorSlice.vector = Word64Vector.vector
       sharing type Word64Array2.elem = Word64.word
       sharing type Word64Array2.vector = Word64Vector.vector
+      sharing type MLton.BinIO.instream = BinIO.instream
+      sharing type MLton.BinIO.outstream = BinIO.outstream
+      sharing type MLton.TextIO.instream = TextIO.instream
+      sharing type MLton.TextIO.outstream = TextIO.outstream
    end
    (* bool is already defined as bool and so cannot be shared.
     * So, we where these to get the needed sharing.
@@ -696,6 +700,9 @@
    where type Word8ArraySlice.vector_slice = Word8ArraySlice.vector_slice
    where type Word8Vector.vector = Word8Vector.vector
 
+   where type 'a MLton.Thread.t = 'a MLton.Thread.t
+   where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t
+
    (* Types that must be exposed because constants denote them. *)
    where type Int1.int = Int1.int
    where type Int2.int = Int2.int
@@ -765,6 +772,3 @@
    where type Word31.word = Word31.word
    where type Word32.word = Word32.word
    where type Word64.word = Word64.word
-
-   where type 'a MLton.Thread.t = 'a MLton.Thread.t
-   where type MLton.Thread.Runnable.t = MLton.Thread.Runnable.t

Modified: mlton/trunk/basis-library/mlton/bin-io.sig
===================================================================
--- mlton/trunk/basis-library/mlton/bin-io.sig	2005-11-10 23:37:14 UTC (rev 4194)
+++ mlton/trunk/basis-library/mlton/bin-io.sig	2005-11-11 00:14:33 UTC (rev 4195)
@@ -5,7 +5,5 @@
  * See the file MLton-LICENSE for details.
  *)
 
-signature MLTON_BIN_IO =
-   MLTON_IO
-   where type instream = BinIO.instream
-   where type outstream = BinIO.outstream
+signature MLTON_BIN_IO = MLTON_IO
+

Modified: mlton/trunk/basis-library/mlton/text-io.sig
===================================================================
--- mlton/trunk/basis-library/mlton/text-io.sig	2005-11-10 23:37:14 UTC (rev 4194)
+++ mlton/trunk/basis-library/mlton/text-io.sig	2005-11-11 00:14:33 UTC (rev 4195)
@@ -6,7 +6,4 @@
  * See the file MLton-LICENSE for details.
  *)
 
-signature MLTON_TEXT_IO =
-   MLTON_IO
-   where type instream = TextIO.instream
-   where type outstream = TextIO.outstream
+signature MLTON_TEXT_IO = MLTON_IO