Mercurial > urweb

annotate lib/ur/listPair.ur @ 2289:78820fa8f5a7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix bugs for lock calculation and SQL parsing and add support for tasks.
author Ziv Scully <ziv@mit.edu>
date Sun, 15 Nov 2015 14:18:35 -0500
parents 8297968cf7ef
children
rev   line source
adamc@850 1 fun foldlAbort [a] [b] [c] f =
adamc@846 2 let
adamc@850 3 fun foldlAbort' acc ls1 ls2 =
adamc@846 4 case (ls1, ls2) of
adamc@846 5 ([], []) => Some acc
adamc@846 6 | (x1 :: ls1, x2 :: ls2) =>
adamc@846 7 (case f x1 x2 acc of
adamc@846 8 None => None
adamc@850 9 | Some acc' => foldlAbort' acc' ls1 ls2)
adamc@846 10 | _ => None
adamc@846 11 in
adamc@850 12 foldlAbort'
adamc@846 13 end
adamc@846 14
adamc@826 15 fun mapX [a] [b] [ctx ::: {Unit}] f =
adamc@801 16 let
adamc@801 17 fun mapX' ls1 ls2 =
adamc@801 18 case (ls1, ls2) of
adamc@801 19 ([], []) => <xml/>
adamc@801 20 | (x1 :: ls1, x2 :: ls2) => <xml>{f x1 x2}{mapX' ls1 ls2}</xml>
adamc@801 21 | _ => error <xml>ListPair.mapX: Unequal list lengths</xml>
adamc@801 22 in
adamc@801 23 mapX'
adamc@801 24 end
adamc@844 25
adamc@844 26 fun all [a] [b] f =
adamc@844 27 let
adamc@844 28 fun all' ls1 ls2 =
adamc@844 29 case (ls1, ls2) of
adamc@844 30 ([], []) => True
adamc@844 31 | (x1 :: ls1, x2 :: ls2) => f x1 x2 && all' ls1 ls2
adamc@844 32 | _ => False
adamc@844 33 in
adamc@844 34 all'
adamc@844 35 end
adam@1884 36
adam@1885 37 fun mp [a] [b] [c] (f : a -> b -> c) =
adam@1884 38 let
adam@1885 39 fun map' ls1 ls2 =
adam@1884 40 case (ls1, ls2) of
adam@1884 41 ([], []) => []
adam@1885 42 | (x1 :: ls1, x2 :: ls2) => f x1 x2 :: map' ls1 ls2
adam@1884 43 | _ => error <xml>ListPair.map2: Unequal list lengths</xml>
adam@1884 44 in
adam@1885 45 map'
adam@1884 46 end