[MLton-commit] r6472
Vesa Karvonen
vesak at mlton.org
Thu Mar 13 16:34:27 PST 2008
Changed the type of pickle elements to Word8 (from Char). This emphasizes
that a pickle contains binary rather than (human readable) character data.
This also makes it less likely that one would accidentally read/write a
pickle from/to a TextIO stream rather than a BinIO stream.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
U mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml
U mltonlib/trunk/com/ssh/generic/unstable/public/value/pickle.sig
U mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
U mltonlib/trunk/org/mlton/vesak/parsec/unstable/detail/string-sequence.sml
U mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/export.sml
U mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/sequence.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2008-03-13 23:58:25 UTC (rev 6471)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/pickle.sml 2008-03-14 00:34:25 UTC (rev 6472)
@@ -32,13 +32,13 @@
structure Istream :> sig
include MONAD_CORE
- val run : 'a monad -> (Char.t, 's) IOSMonad.t -> ('a, 's) IOSMonad.t
- val read : Char.t monad
+ val run : 'a monad -> (Word8.t, 's) IOSMonad.t -> ('a, 's) IOSMonad.t
+ val read : Word8.t monad
end = struct
(* <-- SML/NJ workaround *)
open TopLevel
(* SML/NJ workaround --> *)
- datatype t = T of {st : Univ.t, rd : (Char.t, Univ.t) IOSMonad.t}
+ datatype t = T of {st : Univ.t, rd : (Word8.t, Univ.t) IOSMonad.t}
type 'a monad = ('a, t) IOSMonad.t
open IOSMonad
fun run f cM =
@@ -53,14 +53,14 @@
structure Ostream :> sig
include MONAD_CORE
- val run : ('a -> Unit.t monad) -> (Char.t -> (Unit.t, 's) IOSMonad.t)
- -> ('a -> (Unit.t, 's) IOSMonad.t)
- val write : Char.t -> Unit.t monad
+ val run : ('a -> Unit.t monad) -> (Word8.t -> (Unit.t, 's) IOSMonad.t)
+ -> ('a -> (Unit.t, 's) IOSMonad.t)
+ val write : Word8.t -> Unit.t monad
end = struct
(* <-- SML/NJ workaround *)
open TopLevel
(* SML/NJ workaround --> *)
- datatype t = T of {st : Univ.t, wr : Char.t -> (Unit.t, Univ.t) IOSMonad.t}
+ datatype t = T of {st : Univ.t, wr : Word8.t -> (Unit.t, Univ.t) IOSMonad.t}
type 'a monad = ('a, t) IOSMonad.t
open IOSMonad
fun run f c2uM =
@@ -155,15 +155,14 @@
val op <--> = Iso.<-->
val swap = Iso.swap
- val word8Ichar = (Byte.byteToChar, Byte.charToByte)
fun iso' (P {rd, wr, sz}) (a2b, b2a) =
P {rd = I.map b2a rd, wr = wr o a2b, sz = sz}
val unit = P {rd = I.return (), wr = O.return, sz = SOME 0}
- val char = P {rd = I.read, wr = O.write, sz = SOME 1}
- val word8 = iso' char word8Ichar
- val intAs8 = iso' char (swap Char.isoInt)
+ val word8 = P {rd = I.read, wr = O.write, sz = SOME 1}
+ val char = iso' word8 (Byte.charToByte, Byte.byteToChar)
+ val intAs8 = iso' word8 (swap Word8.isoInt)
val intAs0 = iso' unit (ignore, const 0)
(* Pickles a positive int using a variable length encoding. *)
@@ -544,10 +543,10 @@
fun pickle t =
case pickler t (IOSMonad.fromPutter (uncurry Buffer.push))
- of aP => fn a => Buffer.toString o Pair.snd o aP a |< Buffer.new ()
+ of aP => fn a => Buffer.toWord8Vector o #2 o aP a |< Buffer.new ()
fun unpickle t =
- Pair.fst o unpickler t (IOSMonad.fromReader StringSequence.get) o
- StringSequence.full
+ Pair.fst o unpickler t (IOSMonad.fromReader Word8VectorSequence.get) o
+ Word8VectorSequence.full
structure Open = LayerDepCases
(fun iso bT aIb = let
Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml 2008-03-13 23:58:25 UTC (rev 6471)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/read.sml 2008-03-14 00:34:25 UTC (rev 6472)
@@ -134,7 +134,7 @@
local
fun error s = let
val pos = StringSequence.pos s
- val str = StringSequence.string s
+ val str = StringSequence.vector s
val size = String.size str
val begin = Int.max (0, pos - 5)
val beyond = Int.min (pos + 5, size)
@@ -150,7 +150,7 @@
in
fun read t =
(fn INR (x, s) =>
- if StringSequence.pos s = size (StringSequence.string s)
+ if StringSequence.pos s = size (StringSequence.vector s)
then x
else error s
| INL s => error s) o
Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/pickle.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/pickle.sig 2008-03-13 23:58:25 UTC (rev 6471)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/pickle.sig 2008-03-14 00:34:25 UTC (rev 6472)
@@ -12,8 +12,8 @@
*> - val t = tuple2 (largeInt, list order) ;
*> val t = - : (IntInf.t * Order.t List.t) Rep.t
*> - val p = pickle t (31415926535897, [LESS, EQUAL, GREATER]) ;
- *> val p = "\^@\^F\2176$\151\146\^\\^@\^C\^@\^A\^B" : String.t
- *> - size p ;
+ *> val p = - : Word8Vector.t
+ *> - Word8Vector.length p ;
*> val it = 13 : Int.t
*> - val x = unpickle t p ;
*> val x = (31415926535897, [LESS, EQUAL, GREATER]) : IntInf.t * Order.t List.t
@@ -175,19 +175,19 @@
* pickle in memory as a whole.
*)
- val pickler : ('a, 'x) PickleRep.t -> (Char.t -> (Unit.t, 's) IOSMonad.t)
- -> ('a -> (Unit.t, 's) IOSMonad.t)
- val unpickler : ('a, 'x) PickleRep.t -> (Char.t, 's) IOSMonad.t
- -> ('a, 's) IOSMonad.t
+ val pickler : ('a, 'x) PickleRep.t -> (Word8.t -> (Unit.t, 's) IOSMonad.t)
+ -> ('a -> (Unit.t, 's) IOSMonad.t)
+ val unpickler : ('a, 'x) PickleRep.t -> (Word8.t, 's) IOSMonad.t
+ -> ('a, 's) IOSMonad.t
(** == Simplified Interface ==
*
* The {pickle} and {unpickle} functions provide a simplified interface
- * for pickling to strings and unpickling from strings.
+ * for pickling to and unpickling from {Word8Vector}s.
*)
- val pickle : ('a, 'x) PickleRep.t -> 'a -> String.t
- val unpickle : ('a, 'x) PickleRep.t -> String.t -> 'a
+ val pickle : ('a, 'x) PickleRep.t -> 'a -> Word8Vector.t
+ val unpickle : ('a, 'x) PickleRep.t -> Word8Vector.t -> 'a
end
signature PICKLE_CASES = sig
Modified: mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml 2008-03-13 23:58:25 UTC (rev 6471)
+++ mltonlib/trunk/com/ssh/generic/unstable/test/pickle.sml 2008-03-14 00:34:25 UTC (rev 6472)
@@ -154,13 +154,14 @@
exn = Fail "message",
rest = NIL}]
in
- thatEq string {expect = "\^A<\249=\^A\^@\^A\^@\^B\^A\^@\^@z\^@\^C\
- \U\240\^P\^C\166p\254\^DG\174\^T\^R\^@@\
- \\158^)\203\^P\199\241?@\158^)\203\^P\199\
- \\^A\192\^@\^Fstring\^@\^C\194\251\^A.\
- \\239\190\173\222\^DL]%Q\^@\^B\^@\^A\^@\
- \\^DFail\^@\amessage\^@",
- actual = pickle t x}
+ thatEq string
+ {expect = "\^A<\249=\^A\^@\^A\^@\^B\^A\^@\^@z\^@\^C\
+ \U\240\^P\^C\166p\254\^DG\174\^T\^R\^@@\
+ \\158^)\203\^P\199\241?@\158^)\203\^P\199\
+ \\^A\192\^@\^Fstring\^@\^C\194\251\^A.\
+ \\239\190\173\222\^DL]%Q\^@\^B\^@\^A\^@\
+ \\^DFail\^@\amessage\^@",
+ actual = Byte.bytesToString (pickle t x)}
end))
$
Modified: mltonlib/trunk/org/mlton/vesak/parsec/unstable/detail/string-sequence.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/parsec/unstable/detail/string-sequence.sml 2008-03-13 23:58:25 UTC (rev 6471)
+++ mltonlib/trunk/org/mlton/vesak/parsec/unstable/detail/string-sequence.sml 2008-03-14 00:34:25 UTC (rev 6472)
@@ -4,16 +4,25 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-structure StringSequence :> STRING_SEQUENCE = struct
+functor MkVectorSequence (ElemVector : MONO_VECTOR) :>
+ VECTOR_SEQUENCE
+ where type Pos.t = Int.t
+ where type ElemVector.elem = ElemVector.elem
+ where type ElemVector.t = ElemVector.t =
+struct
structure Pos = Int
- structure Elem = Char
- type t = {pos : Pos.t, data : String.t}
+ structure Elem = struct type t = ElemVector.elem end
+ structure ElemVector = ElemVector
+ type t = {pos : Pos.t, data : ElemVector.t}
fun full s : t = {pos = 0, data = s}
val pos : t -> Pos.t = #pos
- val string : t -> String.t = #data
+ val vector : t -> ElemVector.t = #data
val get : (Elem.t, t) Reader.t =
fn {pos, data} =>
- if pos < size data
- then SOME (String.sub (data, pos), {pos = pos+1, data = data})
+ if pos < ElemVector.length data
+ then SOME (ElemVector.sub (data, pos), {pos = pos+1, data = data})
else NONE
end
+
+structure StringSequence = MkVectorSequence (CharVector)
+structure Word8VectorSequence = MkVectorSequence (Word8Vector)
Modified: mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/export.sml 2008-03-13 23:58:25 UTC (rev 6471)
+++ mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/export.sml 2008-03-14 00:34:25 UTC (rev 6472)
@@ -8,11 +8,12 @@
signature PARSEC = PARSEC
signature SEQUENCE = SEQUENCE
-signature STRING_SEQUENCE = STRING_SEQUENCE
+signature VECTOR_SEQUENCE = VECTOR_SEQUENCE
(** == Exported Structures == *)
-structure StringSequence : STRING_SEQUENCE = StringSequence
+structure StringSequence : VECTOR_SEQUENCE = StringSequence
+structure Word8VectorSequence : VECTOR_SEQUENCE = Word8VectorSequence
(** == Exported Functors == *)
Modified: mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/sequence.sig
===================================================================
--- mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/sequence.sig 2008-03-13 23:58:25 UTC (rev 6471)
+++ mltonlib/trunk/org/mlton/vesak/parsec/unstable/public/sequence.sig 2008-03-14 00:34:25 UTC (rev 6472)
@@ -12,10 +12,10 @@
val get : (Elem.t, t) Reader.t
end
-signature STRING_SEQUENCE = sig
+signature VECTOR_SEQUENCE = sig
include SEQUENCE
- where type Pos.t = Int.t
- where type Elem.t = Char.t
- val full : String.t -> t
- val string : t -> String.t
+ structure ElemVector : MONO_VECTOR
+ sharing type Elem.t = ElemVector.elem
+ val full : ElemVector.t -> t
+ val vector : t -> ElemVector.t
end
More information about the MLton-commit
mailing list