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