1 (* Copyright (C
) 1999-2006 Henry Cejtin
, Matthew Fluet
, Suresh
2 * Jagannathan
, and Stephen Weeks
.
3 * Copyright (C
) 1997-2000 NEC Research Institute
.
5 * MLton is released under a BSD
-style license
.
6 * See the file MLton
-LICENSE for details
.
9 structure ListPair: LIST_PAIR
=
11 exception UnequalLengths
15 fun ul _
= raise UnequalLengths
18 List.foldr (fn ((x
, y
), (xs
, ys
)) => (x
:: xs
, y
:: ys
)) ([], []) l
20 fun foldl
' w f
b (l1
, l2
) =
22 fun loop (l1
, l2
, b
) =
25 |
(x1
:: l1
, x2
:: l2
) => loop (l1
, l2
, f (x1
, x2
, b
))
31 fun foldl f
= foldl
' id f
33 fun foldlEq f
= foldl
' ul f
35 fun foldr
' w f
b (l1
, l2
) =
40 |
(x1
:: l1
, x2
:: l2
) => f (x1
, x2
, loop (l1
, l2
))
46 fun foldr f
= foldr
' id f
48 fun foldrEq f
= foldr
' ul f
51 rev (foldl
' w (fn (x
, x
', l
) => (x
, x
') :: l
) [] (l1
, l2
))
53 fun zip (l1
, l2
) = zip
' id (l1
, l2
)
55 fun zipEq (l1
, l2
) = zip
' ul (l1
, l2
)
57 fun map
' w f
= rev
o (foldl
' w (fn (x1
, x2
, l
) => f (x1
, x2
) :: l
) [])
61 fun mapEq f
= map
' ul f
63 fun app
' w f
= foldl
' w (fn (x1
, x2
, ()) => f (x1
, x2
)) ()
67 fun appEq f
= app
' ul f
69 fun exists
p (l1
, l2
) =
73 (x1
:: l1
, x2
:: l2
) => p (x1
, x2
) orelse loop (l1
, l2
)
79 fun all p ls
= not (exists (not
o p
) ls
)
86 |
(x1
:: l1
, x2
:: l2
) => p (x1
, x2
) andalso loop (l1
, l2
)