1(*
2    Title:      Standard Basis Library: ListPair Structure
3    Author:     David Matthews
4    Copyright   David Matthews 1999, 2005
5
6    This library is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public
8    License as published by the Free Software Foundation; either
9    version 2.1 of the License, or (at your option) any later version.
10    
11    This library is distributed in the hope that it will be useful,
12    but WITHOUT ANY WARRANTY; without even the implied warranty of
13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14    Lesser General Public License for more details.
15    
16    You should have received a copy of the GNU Lesser General Public
17    License along with this library; if not, write to the Free Software
18    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
19*)
20(*
21   G&R 2004 status: Done.
22*)
23signature LIST_PAIR =
24  sig
25    exception UnequalLengths
26    val zip : ('a list * 'b list) -> ('a * 'b) list
27    val zipEq : ('a list * 'b list) -> ('a * 'b) list
28    val unzip : ('a * 'b) list -> ('a list * 'b list)
29    val app : ('a * 'b -> unit) -> ('a list * 'b list) -> unit
30    val appEq : ('a * 'b -> unit) -> ('a list * 'b list) -> unit
31    val map : ('a * 'b -> 'c) -> ('a list * 'b list) -> 'c list
32    val mapEq : ('a * 'b -> 'c) -> ('a list * 'b list) -> 'c list
33    val foldl : (('a * 'b * 'c) -> 'c) -> 'c -> ('a list * 'b list) -> 'c
34    val foldr : (('a * 'b * 'c) -> 'c) -> 'c -> ('a list * 'b list) -> 'c
35    val foldlEq : (('a * 'b * 'c) -> 'c) -> 'c -> ('a list * 'b list) -> 'c
36    val foldrEq : (('a * 'b * 'c) -> 'c) -> 'c -> ('a list * 'b list) -> 'c
37    val all : ('a * 'b -> bool) -> ('a list * 'b list) -> bool
38    val exists : ('a * 'b -> bool) -> ('a list * 'b list) -> bool
39    val allEq : ('a * 'b -> bool) -> ('a list * 'b list) -> bool
40  end;
41
42structure ListPair : LIST_PAIR =
43    struct
44    exception UnequalLengths
45    
46    fun zip (h::t, h'::t') = (h, h') :: zip(t, t')
47     |  zip (_, _) = [] (* Stop as soon as either list is exhausted. *)
48     
49    fun zipEq (h::t, h'::t') = (h, h') :: zipEq(t, t')
50     |  zipEq ([], []) = []
51     |  zipEq (_, _) = raise UnequalLengths
52
53    fun unzip ((a, b) :: l) =
54        let
55        (* TODO: This is quite inefficient in Poly/ML.  It might be
56           better to unzip each of the lists separately. *)
57        val (x, y) = unzip l
58        in
59        (a :: x, b :: y)
60        end
61     | unzip [] = ([], [])
62     
63    fun map f (h::t, h'::t') = f(h, h') :: map f (t, t')
64      | map _ _ = []
65
66    fun mapEq f (h::t, h'::t') = f(h, h') :: mapEq f (t, t')
67      | mapEq _ ([], []) = []
68      | mapEq _ _ = raise UnequalLengths
69
70    fun app f (h::t, h'::t') = (f(h, h'); app f (t, t'))
71      | app _ _ = ()
72
73    fun appEq f (h::t, h'::t') = (f(h, h'); appEq f (t, t'))
74      | appEq _ ([], []) = ()
75      | appEq _ _ = raise UnequalLengths
76
77    fun foldl f b (h::t, h'::t') = foldl f (f(h, h', b)) (t, t')
78      | foldl _ b _ = b
79
80    fun foldr f b (h::t, h'::t') = f(h, h', foldr f b (t, t'))
81      | foldr _ b _ = b
82
83    fun foldlEq f b (h::t, h'::t') = foldlEq f (f(h, h', b)) (t, t')
84      | foldlEq _ b ([], []) = b
85      | foldlEq _ _ _ = raise UnequalLengths
86
87    fun foldrEq f b (h::t, h'::t') = f(h, h', foldrEq f b (t, t'))
88      | foldrEq _ b ([], []) = b
89      | foldrEq _ _ _ = raise UnequalLengths
90
91    fun exists f (h::t, h'::t') = if f(h, h') then true else exists f (t, t')
92      | exists _ _ = false
93
94    (* all and allEq differ in the way they handle lists of different lengths.
95       all returns true if the predicate holds up to the shorter of the lists whereas
96       allEq returns false if the lists have different lengths. *)
97    fun all f (h::t, h'::t') = if f(h, h') then all f (t, t') else false
98      | all _ _ = true
99
100    (* Is it better to check the lengths first? *)
101    fun allEq f (h::t, h'::t') = if f(h, h') then allEq f (t, t') else false
102      | allEq _ ([], []) = true
103      | allEq _ _ = false
104
105    end;
106