# 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 true if a list is empty
empty? [0 [[[false]]] true]

∅?‣ empty?

:test (∅?empty) (true)

# prepends an element to a list
cons P.pair

…:… cons

:test ((+1) : ((+2) : empty)) (P.pair (+1) (P.pair (+2) empty))
:test (∅?((+2) : empty)) (false)

# 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 [[[rec]]] (+0)
	rec ∅?0 case-end case-inc
		case-inc 2 ++1 ~0
		case-end 1

∀‣ length

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

# returns the element at index in list
index z [[[rec]]]
	rec ∅?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 [[[[rec]]]]
	rec ∅?0 case-end case-fold
		case-fold 3 2 (2 1 ^0) ~0
		case-end 1

:test ((foldl …+… (+0) ((+1) : ((+2) : ((+3) : empty)))) =? (+6)) (true)
:test ((foldl …-… (+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 [[rec]] 0]]]
	rec ∅?0 case-end case-fold
		case-fold 4 ^0 (1 ~0)
		case-end 3

:test ((foldr …+… (+0) ((+1) : ((+2) : ((+3) : empty)))) =? (+6)) (true)
:test ((foldr …-… (+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)

# 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]

# creates list with single element
singleton [0 : empty]

{…} singleton

:test ({ (+1) }) ((+1) : empty)

# appends two lists
append z [[[rec]]]
	rec ∅?1 case-end case-append
		case-append ^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 })]]

…;… snoc

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

# maps each element to a function
map z [[[rec]]]
	rec ∅?0 case-end case-map
		case-map (1 ^0) : (2 1 ~0)
		case-end empty

…<$>… map

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

# filters a list based on a predicate
filter z [[[rec]]]
	rec ∅?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
# - slow algorithm:
#   last z [[rec]]
#   	rec ∅?0 case-end case-last
#   		case-last ∅?(~0) ^0 (1 ~0)
#   		case-end empty
# - taking the first element of the reversed list is actually way faster because laziness
last ^‣ ∘ <~>‣

_‣ last

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

# returns everything but the last element of a list
init z [[rec]]
	rec ∅?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 concat ∘∘ map

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

# zips two lists discarding excess elements
zip z [[[rec]]]
	rec ∅?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 [[[[rec]]]]
	rec ∅?1 case-end case-zip
		case-zip ∅?0 empty ((2 ^1 ^0) : (3 2 ~1 ~0))
		case-end empty

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

# list comprehension
{…|…} map

:test ({ ++‣ | ((+0) : ((+2) : empty)) }) ((+1) : ((+3) : empty))

# doubled list comprehension
{…|…,…} zip-with

:test ({ …+… | ((+0) : ((+2) : empty)) , ((+1) : ((+3) : empty)) }) ((+1) : ((+5) : empty))

# returns first n elements of a list
take z [[[rec]]]
	rec ∅?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 [[[rec]]]
	rec ∅?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 [[[rec]]]
	rec ∅?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 [[[rec]]]
	rec ∅?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 pair of take-while and drop-while
span z [[[rec]]]
	rec ∅?0 case-end case-drop
		case-drop 1 ^0 ((^0 : ^recced) : ~recced) (empty : 0)
			recced 2 1 ~0
		case-end empty : empty

:test (span (\les? (+3)) ((+1) : ((+2) : ((+4) : ((+1) : empty))))) (((+1) : ((+2) : empty)) : ((+4) : ((+1) : empty)))

# same as span but with inverted predicate
break span ∘ (…∘… ¬‣)

:test (break (\gre? (+3)) ((+1) : ((+2) : ((+4) : ((+1) : empty))))) (((+1) : ((+2) : empty)) : ((+4) : ((+1) : empty)))

# splits a list into two lists based on predicate
split-at z [[[rec]]]
	rec ∅?dropped case-end case-split
		dropped drop-while 1 0
		case-split ^broken : (2 1 ~broken)
			broken break 1 dropped
		case-end empty

:test (split-at (…=?… (+1)) ((+2) : ((+1) : ((+3) : ((+2) : empty))))) ((((+2) : empty) : (((+3) : ((+2) : empty)) : empty)))

# returns true if any element in a list matches a predicate
any? ⋁?‣ ∘∘ map

: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? ⋀?‣ ∘∘ map

: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?

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

# returns true if all elements of one list are equal to corresponding elements of other list
eq? ⋀?‣ ∘∘∘ zip-with

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

# removes first element that match an eq predicate
remove z [[[[rec]]]]
	rec ∅?0 case-end case-remove
		case-remove (2 ^0 1) ~0 (^0 : (3 2 1 ~0))
		case-end empty

:test (remove …=?… (+2) ((+1) : ((+2) : ((+3) : ((+2) : empty))))) ((+1) : ((+3) : ((+2) : empty)))

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

:test (nub …=?… ((+1) : ((+2) : ((+3) : empty)))) (((+1) : ((+2) : ((+3) : empty))))
:test (nub …=?… ((+1) : ((+2) : ((+1) : empty)))) (((+1) : ((+2) : empty)))

# returns a list with infinite-times a element
repeat z [[rec]]
	rec 0 : (1 0)

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

# returns a list with n-times a element
replicate \(g take repeat)

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

# returns an infinite list repeating a finite list
cycle z [[rec]]
	rec 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 [[[rec]]]
	rec 0 : (2 1 (1 0))

:test (take (+5) (iterate ++‣ (+0))) (((+0) : ((+1) : ((+2) : ((+3) : ((+4) : empty))))))
:test (take (+2) (iterate (%‣ ∘ dec) (+5))) (((+5) : ((+4) : empty)))
:test (take (+5) (iterate i (+4))) (take (+5) (repeat (+4)))
:test (take (+0) (iterate ++‣ (+0))) (empty)