[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