[MLton] Bug report
Stephen Weeks
MLton@mlton.org
Sun, 11 Jul 2004 00:32:15 -0700
> The following program raises exception "UnequalLengths". I am
> guessing it shouldn't.
Thanks for the bug report. The problem was in our basis library
implementation of the ListPair structure. I've checked a fix into our
CVS. If you want to apply the fix immediately, you can replace the
contents of
/usr/lib/mlton/sml/basis-library/list/list-pair.sml
on your machine with the code below.
--------------------------------------------------------------------------------
(* Copyright (C) 1999-2004 Henry Cejtin, Matthew Fluet, Suresh
* Jagannathan, and Stephen Weeks.
* Copyright (C) 1997-1999 NEC Research Institute.
*
* MLton is released under the GNU General Public License (GPL).
* Please see the file MLton-LICENSE for license information.
*)
structure ListPair: LIST_PAIR =
struct
exception UnequalLengths
fun id x = x
fun ul _ = raise UnequalLengths
fun unzip l =
List.foldr (fn ((x, y), (xs, ys)) => (x :: xs, y :: ys)) ([], []) l
fun foldl' w f b (l1, l2) =
let
fun loop (l1, l2, b) =
case (l1, l2) of
([], []) => b
| (x1 :: l1, x2 :: l2) => loop (l1, l2, f (x1, x2, b))
| _ => w b
in
loop (l1, l2, b)
end
fun foldl f = foldl' id f
fun foldlEq f = foldl' ul f
fun foldr' w f b (l1, l2) =
let
fun loop (l1, l2) =
case (l1, l2) of
([], []) => b
| (x1 :: l1, x2 :: l2) => f (x1, x2, loop (l1, l2))
| _ => w b
in
loop (l1, l2)
end
fun foldr f = foldr' id f
fun foldrEq f = foldr' ul f
fun zip' w (l1, l2) =
rev (foldl' w (fn (x, x', l) => (x, x') :: l) [] (l1, l2))
fun zip (l1, l2) = zip' id (l1, l2)
fun zipEq (l1, l2) = zip' ul (l1, l2)
fun map' w f = rev o (foldl' w (fn (x1, x2, l) => f (x1, x2) :: l) [])
fun map f = map' id f
fun mapEq f = map' ul f
fun app' w f = foldl' w (fn (x1, x2, ()) => f (x1, x2)) ()
fun app f = app' id f
fun appEq f = app' ul f
fun exists p (l1, l2) =
let
fun loop (l1, l2) =
case (l1, l2) of
(x1 :: l1, x2 :: l2) => p (x1, x2) orelse loop (l1, l2)
| _ => false
in
loop (l1, l2)
end
fun all p ls = not (exists (not o p) ls)
fun allEq p =
let
fun loop (l1, l2) =
case (l1, l2) of
([], []) => true
| (x1 :: l1, x2 :: l2) => p (x1, x2) andalso loop (l1, l2)
| _ => false
in
loop
end
end