# MIT License, Copyright (c) 2022 Marvin Borner
# Lists in Church/Boehm-Berarducci encoding using pairs

:import std/Combinator .

:import std/Pair P

:import std/Logic .

:import std/Number .

# empty list element
empty false

# returns whether a list is empty
empty? [0 [[[false]]] true]

<>?( empty?

:test (<>?empty) (true)
:test (<>?(cons (+2) empty)) (false)

# prepends an element to a list
cons P.pair

(:) cons

:test ((+1) : ((+2) : empty)) (P.pair (+1) (P.pair (+2) empty))
:test ('a' : ('b' : ('c' : empty))) ("abc")

# returns the head of a list or empty
head P.fst

^( head

:test (^((+1) : ((+2) : empty))) ((+1))

# returns the tail of a list or empty
tail P.snd

~( tail

:test (~((+1) : ((+2) : empty))) ((+2) : empty)

# returns the length of a list in balanced ternary
length Z [[[case-some]]] case-empty
	case-some <>?0 case-end case-inc
		case-inc 2 ++1 ~0
		case-end 1
	case-empty (+0)

#( length

:test (#((+1) : ((+2) : empty))) ((+2))
:test (#empty) ((+0))

# returns the element at index in list
index Z [[[case-some]]]
	case-some <>?0 case-end case-index
		case-index =?1 ^0 (2 --1 ~0)
		case-end empty

(!!) \index

:test (((+1) : ((+2) : ((+3) : empty))) !! (+0)) ((+1))
:test (((+1) : ((+2) : ((+3) : empty))) !! (+2)) ((+3))
:test (((+1) : ((+2) : ((+3) : empty))) !! (-1)) (empty)
:test (((+1) : ((+2) : ((+3) : empty))) !! (+3)) (empty)

# applies a left fold on a list
foldl Z [[[[case-some]]]]
	case-some <>?0 case-end case-fold
		case-fold 3 2 (2 1 ^0) ~0
		case-end 1

:test ((foldl add (+0) ((+1) : ((+2) : ((+3) : empty)))) =? (+6)) (true)
:test ((foldl sub (+6) ((+1) : ((+2) : ((+3) : empty)))) =? (+0)) (true)

# foldl without starting value
foldl1 [[foldl 1 ^0 ~0]]

# applies a right fold on a list
foldr [[[Z [[case-some]] case-empty]]]
	case-some <>?0 case-end case-fold
		case-fold 4 ^0 (1 ~0)
		case-end 3
	case-empty 0

:test ((foldr add (+0) ((+1) : ((+2) : ((+3) : empty)))) =? (+6)) (true)
:test ((foldr sub (+2) ((+1) : ((+2) : ((+3) : empty)))) =? (+0)) (true)

# foldr without starting value
foldr1 [[foldl 1 ^0 ~0]]

# applies or to all list elements
lor? foldr or? false

||( lor?

:test (||(true : (true : empty))) (true)
:test (||(true : (false : empty))) (true)
:test (||(false : (false : empty))) (false)

# applies and to all list elements
land? foldr and? true

&&( land?

:test (&&(true : (true : empty))) (true)
:test (&&(true : (false : empty))) (false)
:test (&&(false : (false : empty))) (false)

# multiplies all values in list
product foldl mul (+1)

Π product

:test (Π ((+1) : ((+2) : ((+3) : empty)))) ((+6))

# adds all values in list
sum foldl add (+0)

Σ sum

:test (Σ ((+1) : ((+2) : ((+3) : empty)))) ((+6))

# returns max value of list
lmax foldl1 max

:test (lmax ((+1) : ((+3) : ((+2) : empty)))) ((+3))

# returns min value of list
lmin foldl1 min

:test (lmin ((+2) : ((+1) : ((+0) : empty)))) ((+0))

# reverses a list
reverse foldl \cons empty

<~>( reverse

:test (<~>((+1) : ((+2) : ((+3) : empty)))) ((+3) : ((+2) : ((+1) : empty)))

# creates list out of n terms
# TODO: fix for balanced ternary
list [0 [[[2 (0 : 1)]]] reverse empty]

# appends two lists
append Z [[[case-some]]]
	case-some <>?1 case-end case-merge
		case-merge ^1 : (2 ~1 0)
		case-end 0

(++) append

:test (((+1) : ((+2) : ((+3) : empty))) ++ ((+4) : empty)) ((+1) : ((+2) : ((+3) : ((+4) : empty))))

# appends an element to a list
snoc [[1 ++ (0 : empty)]]

(;) snoc

:test (empty ; (+1)) ((+1) : empty)
:test (((+1) : empty) ; (+2)) ((+1) : ((+2) : empty))

# maps each element to a function
map Z [[[case-some]]]
	case-some <>?0 case-end case-map
		case-map (1 ^0) : (2 1 ~0)
		case-end empty

(<$>) map

:test (inc <$> ((+1) : ((+2) : ((+3) : empty)))) ((+2) : ((+3) : ((+4) : empty)))

# filters a list based on a predicate
filter Z [[[case-some]]]
	case-some <>?0 case-end case-filter
		case-filter 1 ^0 (cons ^0) I (2 1 ~0)
		case-end empty

(<#>) \filter

:test (((+1) : ((+0) : ((+3) : empty))) <#> zero?) ((+0) : empty)

# returns the last element of a list
last Z [[case-some]]
	case-some <>?0 case-end case-last
		case-last <>?(~0) ^0 (1 ~0)
		case-end empty

_( last

:test (last ((+1) : ((+2) : ((+3) : empty)))) ((+3))

# returns everything but the last element of a list
init Z [[case-some]]
	case-some <>?0 case-end case-init
		case-init <>?(~0) empty (^0 : (1 ~0))
		case-end empty

:test (init ((+1) : ((+2) : ((+3) : empty)))) ((+1) : ((+2) : empty))

# concatenates a list of lists to one list
concat foldr append empty

# TODO: ?
# :test (concat ((((+1) : ((+2) : empty)) : ((+3) : ((+4) : empty))) : empty)) ((+1) : ((+2) : ((+3) : ((+4) : empty))))
:test (concat ("a" : ("b" : empty))) ("ab")

# maps a function returning list of list and concatenates
concat-map [foldr (append . 0) empty]

:test (concat-map [-0 : (0 : empty)] ((+1) : ((+2) : empty))) ((-1) : ((+1) : ((-2) : ((+2) : empty))))

# zips two lists discarding excess elements
zip Z [[[case-some]]]
	case-some <>?1 case-end case-zip
		case-zip <>?0 empty ((^1 : ^0) : (2 ~1 ~0))
		case-end empty

:test (zip ((+1) : ((+2) : empty)) ((+2) : ((+1) : empty))) (((+1) : (+2)) : (((+2) : (+1)) : empty))

# applies pairs of the zipped list as arguments to a function
zip-with Z [[[[case-some]]]]
	case-some <>?1 case-end case-zip
		case-zip <>?0 empty ((2 ^1 ^0) : (3 2 ~1 ~0))
		case-end empty

:test (zip-with add ((+1) : ((+2) : empty)) ((+2) : ((+1) : empty))) ((+3) : ((+3) : empty))

# returns first n elements of a list
take Z [[[case-some]]]
	case-some <>?0 case-end case-take
		case-take =?1 empty (^0 : (2 --1 ~0))
		case-end empty

:test (take (+2) ((+1) : ((+2) : ((+3) : empty)))) ((+1) : ((+2) : empty))

# takes elements while a predicate is satisfied
take-while Z [[[case-some]]]
	case-some <>?0 case-end case-take
		case-take 1 ^0 (^0 : (2 1 ~0)) empty
		case-end empty

:test (take-while zero? ((+0) : ((+0) : ((+1) : empty)))) ((+0) : ((+0) : empty))

# removes first n elements of a list
drop Z [[[case-some]]]
	case-some <>?0 case-end case-drop
		case-drop =?1 0 (2 --1 ~0)
		case-end empty

:test (drop (+2) ((+1) : ((+2) : ((+3) : empty)))) ((+3) : empty)

# removes elements from list while a predicate is satisfied
drop-while Z [[[case-some]]]
	case-some <>?0 case-end case-drop
		case-drop 1 ^0 (2 1 ~0) 0
		case-end empty

:test (drop-while zero? ((+0) : ((+0) : ((+1) : empty)))) ((+1) : empty)

# returns true if any element in a list matches a predicate
any? [lor? . (map 0)]

:test (any? (\gre? (+2)) ((+1) : ((+2) : ((+3) : empty)))) (true)
:test (any? (\gre? (+2)) ((+1) : ((+2) : ((+2) : empty)))) (false)

# returns true if all elements in a list match a predicate
all? [land? . (map 0)]

:test (all? (\gre? (+2)) ((+3) : ((+4) : ((+5) : empty)))) (true)
:test (all? (\gre? (+2)) ((+4) : ((+3) : ((+2) : empty)))) (false)

# returns true if element is part of a list based on eq predicate
in? [[any? (\1 0)]]

:test (in? eq? (+3) ((+1) : ((+2) : ((+3) : empty)))) (true)
:test (in? eq? (+0) ((+1) : ((+2) : ((+3) : empty)))) (false)

# returns true if all elements of one list are equal to corresponding elements of other list
# TODO: Better name
leq? [[[land? (zip-with 2 1 0)]]]

:test (leq? eq? ((+1) : ((+2) : empty)) ((+1) : ((+2) : empty))) (true)
:test (leq? eq? ((+1) : ((+2) : empty)) ((+2) : ((+2) : empty))) (false)
:test (leq? eq? empty empty) (true)

# removes first element that match an eq predicate
remove Z [[[[case-some]]]]
	case-some <>?0 case-end case-remove
		case-remove (2 ^0 1) ~0 (^0 : (3 2 1 ~0))
		case-end empty

:test (remove eq? (+2) ((+1) : ((+2) : ((+3) : ((+2) : empty))))) ((+1) : ((+3) : ((+2) : empty)))

# removes duplicates from list based on eq predicate (keeps first occurrence)
nub Z [[[case-some]]]
	case-some <>?0 case-end case-nub
		case-nub ^0 : (2 1 (~0 <#> [!(2 0 ^1)]))
		case-end empty

:test (nub eq? ((+1) : ((+2) : ((+3) : empty)))) (((+1) : ((+2) : ((+3) : empty))))
:test (nub eq? ((+1) : ((+2) : ((+1) : empty)))) (((+1) : ((+2) : empty)))

# returns a list with infinite-times a element
repeat Z [[case-some]]
	case-some 0 : (1 0)

:test (take (+3) (repeat (+4))) ((+4) : ((+4) : ((+4) : empty)))

# returns a list with n-times a element
replicate [[take 1 (repeat 0)]]

:test (replicate (+3) (+4)) ((+4) : ((+4) : ((+4) : empty)))

# returns an infinite list repeating a finite list
cycle Z [[case-some]]
	case-some 0 ++ (1 0)

:test (take (+6) (cycle "ab")) ("ababab")

# returns a list with infinite-times previous (or start) value applied to a function
iterate Z [[[case-some]]]
	case-some 0 : (2 1 (1 0))

:test (take (+5) (iterate inc (+0))) (((+0) : ((+1) : ((+2) : ((+3) : ((+4) : empty))))))
:test (take (+2) (iterate dec (+5))) (((+5) : ((+4) : empty)))
:test (take (+5) (iterate I (+4))) (repeat (+5) (+4))
:test (take (+0) (iterate inc (+0))) (empty)