# Copyright 2011  Petter Urkedal
#
# This file is part of the Viz Standard Library <http://www.vizlang.org/>.
#
# The Viz Standard Library (VSL) is free software: you can redistribute it
# and/or modify it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation, either version 3 of the License,
# or (at your option) any later version.
#
# The VSL is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public License for
# more details.
#
# You should have received a copy of the GNU Lesser General Public License
# along with the VSL.  If not, see <http://www.gnu.org/licenses/>.

open prereq
open effect

#?ffoc type t α := list α
#?ffoc {#

type t α
inj [] : t α
inj [;] : α → t α → t α

#?ffoc #}


let init n f
    let loop n zs
	if n = 0 be zs
	else be loop (n - 1) [f (n - 1); zs]
    be loop n []

let head at [] fail "An empty list was passed to list.head."
	 at [x; _] be x
let tail at [] fail "An empty list was passed to list.tail."
	 at [_; xs] be xs

let nth i
    at [] be none
    at [x; xs] be i = 0 ⇒ some x; nth (i - 1) xs

let fold f
    at [] be ident
    at [x; xs] be fold f xs ∘ f x

let foldr f xs be fold f (rev xs)

let fold2 f
    at [], [] be ident
    at [], _ fail "fold2: left list is smaller."
    at _, [] fail "fold2: right list is smaller."
    at [x; xs], [y; ys] be fold2 f (xs, ys) ∘ f (x, y)

let iter f
    at [] be return ()
    at [x; xs] be f x >> iter f xs

let for_all f
    at [] be true
    at [x; xs] be f x ∧ for_all f xs

let for_some f
    at [] be false
    at [x; xs] be f x ∨ for_some f xs

let count f
    let add_count n
	at [] be n
	at [x; xs] be add_count (f x ⇒ n + 1; n) xs
    be add_count 0

let length xs
    let add_length n
	at [] be n
	at [x; xs] be add_length (n + 1) xs
    be add_length 0 xs

let find f
    at [] be none
    at [x; xs] if f x be some x
	       else be find f xs

let filter f
    let loop zs
	at [] be rev zs
	at [x; xs] if f x be loop [x; zs] xs
		   else be loop zs xs
    be loop []

let bifilter f
    let loop xs ys
	at [] be (rev xs, rev ys)
	at [z; zs] if f z be loop [z; xs] ys zs
		   else   be loop xs [z; ys] zs
    be loop [] []

let drop_while f
    at [] be []
    at [x; xs] if f x be drop_while f xs
	       else be [x; xs]

let take_while f xs
    let loop zs
	at [] be xs
	at [y; ys] if f y be loop [y; zs] ys
		   else be rev zs
    be loop [] xs

let mapr f
    let loop ys
	at [] be ys
	at [x; xs] be loop [f x; ys] xs
    be loop []

let map f xs be rev (mapr f xs)

let mapi f
    let loop i zs
	at [] be rev zs
	at [x; xs] be loop (i + 1) [f i x; zs] xs
    be loop 0 []

let catr xs ys
    be that xs which
    at [] be ys
    at [x; xs] be catr xs [x; ys]

let rev xs be catr xs []

let cat xs ys be catr (rev xs) ys

let flatten
    at [] be []
    at [xs] be xs
    at [xs; xss] be cat xs (flatten xss)

let zip (xs, ys)
    let loop zs
	at [x; xs]
	    at [y; ys] be loop [(x, y); zs] xs ys
	    at [] fail "list.zip: The first list is longer than the second."
	at []
	    at [] be rev zs
	    at _ fail "list.zip: The second list is longer than the first."
    be loop [] xs ys

let zip_trunc (xs, ys)
    let loop zs
	at [x; xs] at [y; ys] be loop [(x, y); zs] xs ys
		   at [] be rev zs
	at [] at _ be rev zs
    be loop [] xs ys

let unzip zs
    let loop xs ys
	at [(x, y); zs] be loop [x; xs] [y; ys] zs
	at [] be (rev xs, rev ys)
    be loop [] [] zs