Number/Binary.bruijn

# MIT License, Copyright (c) 2023 Marvin Borner
# binary implementation of T.Æ. Mogensen (see refs in README)
# TODO: Use abstract representation for logic instead of listifying

:import std/Combinator .
:import std/List .
:import std/Logic .
:import std/Tuples .

# TODO: remove ternary conversion shortcuts
# TODO: then move functions to reflect order of std/Ternary

:import std/Number/Ternary T

# bit indicating a one, compatible with std/Logic
b¹ true ⧗ Bit

# bit indicating a zero, compatible with std/Logic
b⁰ false ⧗ Bit

# returns true if a bit is set
b¹? i ⧗ Bit → Boolean

:test (b¹? b¹) (true)
:test (b¹? b⁰) (false)

# returns true if a bit is unset
b⁰? not! ⧗ Bit → Boolean

:test (b⁰? b⁰) (true)
:test (b⁰? b¹) (false)

# shifts a one into a binary number
↑¹‣ [[[[1 (3 2 1 0)]]]] ⧗ Binary → Binary

:test (↑¹[[[0 2]]]) ([[[1 (0 2)]]])

# shifts a zero into a binary number
↑⁰‣ [[[[0 (3 2 1 0)]]]] ⧗ Binary → Binary

:test (↑⁰(+1b)) ((+2b))

# shifts a specified bit into a binary number
up [[[[[4 1 0 (3 2 1 0)]]]]] ⧗ Bit → Binary → Binary

:test (up b¹ [[[0 2]]]) ([[[1 (0 2)]]])
:test (up b⁰ (+1b)) ((+2b))

zero (+0b)

# returns true if a binary number is zero
zero? true : [false] : i ⧗ Binary → Boolean

=?‣ zero?

:test (=?zero) (true)
:test (=?[[[0 (0 2)]]]) (true)
:test (=?(+1b)) (false)

# extracts least significant bit from a binary number
lsb b⁰ : [b¹] : [b⁰] ⧗ Binary → Bit

:test (lsb (+0b)) (b⁰)
:test (lsb (+1b)) (b¹)
:test (lsb (+42b)) (b⁰)

# returns true if the number is even (remainder mod 2 == 0)
even? ¬‣ ∘ lsb ⧗ Binary → Boolean

=²?‣ even?

:test (even? (+0b)) (true)
:test (even? (+1b)) (false)
:test (even? (+41b)) (false)
:test (even? (+42b)) (true)

# converts the normal binary representation into abstract
abstract! z : a¹ : a⁰ ⧗ Binary → AbstractBinary
	z (+0b)
	a¹ [[[[1 3]]]]
	a⁰ [[[[0 3]]]]

→^‣ abstract!

:test (→^(+2b)) ([[[0 [[[1 [[[2]]]]]]]]])

# converts the abstracted binary representation back to normal
normal! y [z : a¹ : a⁰] ⧗ AbstractBinary → Binary
	z (+0b)
	a¹ [↑¹(1 0)]
	a⁰ [↑⁰(1 0)]

→_‣ normal!

:test (→_[[[0 [[[1 [[[2]]]]]]]]]) ((+2b))

# returns true if two binary numbers are equal
# → ignores leading 0s!
# also: ⋀?‣ ∘∘ (ψ* zip-with xnor? list!)
eq? [[abs 1 →^0]] ⧗ Binary → Binary → Boolean
	abs z : a¹ : a⁰
		z [=?(→_0)]
		a¹ [false : [1 0] : [false]]
		a⁰ [[0 (1 0) [false] [2 0]]]

…=?… eq?

:test ((+0b) =? (+0b)) (true)
:test ([[[1 (0 2)]]] =? [[[1 (0 2)]]]) (true)
:test ([[[1 2]]] =? (+2b)) (false)

# rshifts least significant bit of a binary number
div² [~(0 z a¹ a⁰)] ⧗ Binary → Binary
	z (+0b) : (+0b)
	a¹ &[[↑¹1 : 1]]
	a⁰ &[[↑⁰1 : 1]]

/²‣ div²

:test (/²(+6b) =? (+3b)) (true)
:test (/²(+5b) =? (+2b)) (true)

# adds 1 to a binary number (can introduce leading 0s)
inc [~(0 z a¹ a⁰)] ⧗ Binary → Binary
	z (+0b) : (+1b)
	a¹ &[[↑¹1 : ↑⁰0]]
	a⁰ &[[↑⁰1 : ↑¹1]]

++‣ inc

:test (++(+0b)) ((+1b))
:test (++(+2b)) ((+3b))

# subs 1 from a binary number (can introduce leading 0s)
dec [~(0 z a¹ a⁰)] ⧗ Binary → Binary
	z (+0b) : (+0b)
	a¹ &[[↑¹1 : ↑⁰1]]
	a⁰ &[[↑⁰1 : ↑¹0]]

--‣ dec

:test (--(+0b)) ((+0b))
:test (--(+1b)) ([[[0 2]]])
:test (--(+3b)) ((+2b))

# TODO: Remove (duplicate of std/Conversion because of dep loop)
binary→ternary [y [[[rec]]] [0] 0 (+0t)] ⧗ Binary → Ternary
	rec zero? 0 case-end case-rec
		case-rec even? 0 (2 (1 ∘ (T.mul (+2t))) (div² 0)) (2 (1 ∘ T.inc) (dec 0))
		case-end 1

# returns eq, gt, lt depending on comparison of two numbers
# TODO: remove ternary conversion
compare-case [[[(T.compare-case 2 1 0) ⋔ binary→ternary]]] ⧗ a → b → c → Binary → Binary → d

<?>‣ &compare-case

# decides comparison result when bits differ
cmp-bit [&[[1 (false : 2) (false : 0)]]]

# returns true if number is greater than other number
gt? [[~(abs 1 →^0)]] ⧗ Binary → Binary → Boolean
	abs z : a¹ : a⁰
		z [(=?(→_0)) : false]
		a¹ [(cmp-bit true (0 (+0b))) : [1 0] : [cmp-bit true (1 0)]]
		a⁰ [(0 (+0b)) : [cmp-bit false (1 0)] : [1 0]]

…>?… gt?

:test ((+1b) >? (+2b)) (false)
:test ((+2b) >? (+2b)) (false)
:test ((+3b) >? (+2b)) (true)
:test ((+0b) >? (+0b)) (false)
:test ((+1b) >? (+0b)) (true)
:test ((+0b) >? (+1b)) (false)
:test ((+9b) >? (+3b)) (true)
:test ((+3b) >? (+9b)) (false)
:test ((+16b) >? (+15b)) (true)
:test ((+15b) >? (+16b)) (false)

# ============================================================================ #
# most relevant functions are defined - we can now derive from Generic/Number! #
# ============================================================================ #

:input std/Generic/Number

# converts a binary number to a list of bits
list! z : a¹ : a⁰ ⧗ Binary → (List Bit)
	z empty
	a¹ [b¹ : 0]
	a⁰ [b⁰ : 0]

:test (list! (+0b)) (empty)
:test (list! (+6b)) (b⁰ : (b¹ : {}b¹))

# converts a list of bits to a binary number
binary! foldr up (+0b) ⧗ (List Bit) → Binary

:test (binary! (list! (+0b))) ((+0b))
:test (binary! (list! (+42b))) ((+42b))

# strips leading 0s from a binary number
strip [^(0 z a¹ a⁰)] ⧗ Binary → Binary
	z (+0b) : true
	a¹ &[[↑¹1 : false]]
	a⁰ &[[(0 (+0b) ↑⁰1) : 0]]

%‣ strip

:test (%[[[0 2]]]) ((+0b))
:test (%[[[1 (0 (0 (0 (0 2))))]]]) ((+1b))
:test (%(+2b)) ((+2b))

# strips trailing 0s from a binary number
strip-trailing [[[[3 z a¹ a⁰ k]]]] ⧗ Binary → Binary
	z 2 : 2
	a¹ &[[(3 0) : (3 0)]]
	a⁰ &[[1 : (2 0)]]

:test (strip-trailing (+0b)) ((+0b))
:test (strip-trailing (+1b)) ((+1b))
:test (strip-trailing (+2b)) ((+1b))
:test (strip-trailing (+4b)) ((+1b))
:test (strip-trailing (+100b)) ((+25b))

# counts trailing zeroes of a binary number
ctz [(+0b)] : [(+0b)] : inc ⧗ Binary → Binary

# extracts most significant bit from a binary number
# not really useful for binary numbers, but part of interface
msb [=?0 b⁰ b¹] ⧗ Binary → Bit

:test (msb (+0b)) (b⁰)
:test (msb (+1b)) (b¹)
:test (msb (+42b)) (b¹)

# extracts nth bit from a binary number
nth …!!… ∘ list! ⧗ Binary → Number → Bit

# logical and on two binary numbers
and! binary! ∘∘ (ψ* zip-with …⋀?… list!) ⧗ Binary → Binary → Binary

…⋀!… and!

:test ((+1b) ⋀! (+0b)) ((+0b))
:test ((+5b) ⋀! (+4b)) ((+4b))
:test ((+10b) ⋀! (+12b)) ((+8b))

# logical or on two binary numbers
# TODO: Fix for numbers with different length (→ zero padding?)
or! binary! ∘∘ (ψ* zip-with …⋁?… list!) ⧗ Binary → Binary → Binary

…⋁!… or!

:test ((+10b) ⋁! (+12b)) ((+14b))

# :test (or! (+1b) (+0b)) ((+1b))
# :test (or! (+5b) (+3b)) ((+7b))

# logical or on two binary numbers
# TODO: Fix for numbers with different length (→ zero padding?)
xor! binary! ∘∘ (ψ* zip-with …^?… list!) ⧗ Binary → Binary → Binary

…^!… xor!

:test (((+10b) ^! (+12b)) =? (+6b)) (true)

# flips the bits of a binary number (1's complement)
complement [[[[3 2 0 1]]]] ⧗ Binary → Binary

-*‣ complement

:test (-*(+0b) =? (+0b)) (true)
:test (-*(+1b) =? (+0b)) (true)
:test (-*(+42b)) ([[[1 (0 (1 (0 (1 (0 2)))))]]])

# inverts a binary number by complementing and incrementing (2's complement)
# don't forget to pad the number with 0s if needed
invert ++‣ ∘ -*‣ ⧗ Binary → Binary

-‣ invert

:test (-(+0b)) ((+1b))
:test (-(+1b)) ((+1b))

# pads a binary number with 0s until it's as long a another binary number
# TODO: this could be done without list magic (see Ternary)
pad [[binary! (pad-right ∀(list! %1) b⁰ (list! %0))]] ⧗ Binary → Binary → Binary

:test (pad (+5b) [[[1 2]]]) ([[[1 (0 (0 2))]]])

# adds two binary numbers (can introduce leading 0s)
# second argument gets abstracted (performance)
add [[abs 1 →^0]] ⧗ Binary → Binary → Binary
	abs [c (0 z a¹ a⁰)]
		c¹ [1 ↑⁰(3 0 b¹) ↑¹(3 0 b⁰)]
		a¹ [[[1 (c¹ 1) c¹' c¹]]]
			c¹' [up 1 (3 0 b¹)]
		a⁰ [[[1 (c⁰ 1) c¹ c⁰]]]
			c⁰ [up 1 (3 0 b⁰)]
		z [++(→_0) : →_0]
		c [[1 0 b⁰]]

…+… add

:test ((+0b) + (+0b) =? (+0b)) (true)
:test ((+0b) + (+3b) =? (+3b)) (true)
:test ((+1b) + (+2b) =? (+3b)) (true)
:test ((+42b) + (+1b) =? (+43b)) (true)
:test ((+1b) + (+42b) =? (+43b)) (true)

# subs two binary numbers (can introduce leading 0s)
# second argument gets abstracted (performance)
sub [[abs 1 →^0]] ⧗ Binary → Binary → Binary
	abs [c (0 z a¹ a⁰)]
		s== [up 1 (3 0 1)]
		s¹⁰ [1 ↑⁰(3 0 b⁰) ↑¹(3 0 b⁰)]
		s⁰¹ [1 ↑⁰(3 0 b¹) ↑¹(3 0 b¹)]
		a¹ [[[1 (s¹⁰ 1) s== s¹⁰]]]
		a⁰ [[[1 (s== 1) s⁰¹ s==]]]
		z [--(→_0) : →_0]
		c [[1 0 b⁰]]

…-… sub

:test ((+42b) - (+12b) =? (+30b)) (true)
:test ((+3b) - (+0b) =? (+3b)) (true)
:test ((+3b) - (+2b) =? (+1b)) (true)
:test ((+1b) - (+0b) =? (+1b)) (true)
:test ((+1b) - (+1b) =? (+0b)) (true)
:test ((+4b) - (+3b) =? (+1b)) (true)

# muls two binary numbers (can introduce leading 0s)
mul [[1 z a¹ a⁰]] ⧗ Number → Number → Number
	z (+0b)
	a¹ [↑⁰0 + 1]
	a⁰ [↑⁰0]

…⋅… mul

:test ((+42b) ⋅ (+0b) =? (+0b)) (true)
:test ((+3b) ⋅ (+11b) =? (+33b)) (true)

# takes a binary 2 to the power of a unary number (FAST)
pow² ↑⁰‣ : (+1b) ⧗ Unary → Binary

# ceiled integer log2 by counting bits
# also counts leading 0s
log₂* (+0b) : inc : inc ⧗ Binary → Binary

# ceiled integer log2 by counting bits
log₂ log₂* ∘ strip ⧗ Binary → Binary

:test ((log₂ (+1b)) =? (+1b)) (true)
:test ((log₂ (+2b)) =? (+2b)) (true)
:test ((log₂ (+3b)) =? (+2b)) (true)
:test ((log₂ (+4b)) =? (+3b)) (true)
:test ((log₂ (+32b)) =? (+6b)) (true)
:test ((log₂ (+48b)) =? (+6b)) (true)

# prepends min(ctz(a), ctz(b)) zero-bits to a number
common-shift [[[2 z a¹ a⁰ →^1 0]]] ⧗ Binary → Binary → Binary → Binary
	z [[0]]
	a¹ [[[0]]]
	a⁰ [[[1 0 [1] [↑⁰(3 0 1)]]]]

:test ((common-shift (+1b) (+1b) (+3b)) =? (+3b)) (true)
:test ((common-shift (+2b) (+4b) (+3b)) =? (+6b)) (true)
:test ((common-shift (+4b) (+6b) (+3b)) =? (+6b)) (true)
:test ((common-shift (+4b) (+4b) (+3b)) =? (+12b)) (true)
:test ((common-shift (+8b) (+12b) (+3b)) =? (+12b)) (true)

# greatest common divisor using Stein's algorithm
# TODO: efficient expmod
gcd [[=?1 0 (=?0 1 (common-shift 1 0 (odd 1 0)))]] ⧗ Binary → Binary → Binary
	odd [[^((a + b) (a : b) step step)]]
		a strip-trailing 1
		b strip-trailing 0
		step &[[(1 =? 0) case-eq ((1 >? 0) case-gr case-le)]]
			case-eq 1 : 0
			case-gr ((strip-trailing (1 - 0)) : 0)
			case-le (1 : (strip-trailing (0 - 1)))

:test ((gcd (+0b) (+0b)) =? (+0b)) (true)
:test ((gcd (+0b) (+5b)) =? (+5b)) (true)
:test ((gcd (+7b) (+0b)) =? (+7b)) (true)
:test ((gcd (+1b) (+1b)) =? (+1b)) (true)
:test ((gcd (+2b) (+2b)) =? (+2b)) (true)
:test ((gcd (+2b) (+4b)) =? (+2b)) (true)
:test ((gcd (+3b) (+9b)) =? (+3b)) (true)
:test ((gcd (+10b) (+5b)) =? (+5b)) (true)
:test ((gcd (+3b) (+8b)) =? (+1b)) (true)
:test ((gcd (+12b) (+8b)) =? (+4b)) (true)
:test ((gcd (+6b) (+4b)) =? (+2b)) (true)
:test ((gcd (+14b) (+21b)) =? (+7b)) (true)
:test ((gcd (+17b) (+13b)) =? (+1b)) (true)
:test ((gcd (+48b) (+36b)) =? (+12b)) (true)
:test ((gcd (+100b) (+75b)) =? (+25b)) (true)
:test ((gcd (+36b) (+24b)) =? (+12b)) (true)
:test ((gcd (+1b) (+100b)) =? (+1b)) (true)
:test ((gcd (+128b) (+96b)) =? (+32b)) (true)
:test ((gcd (+55b) (+34b)) =? (+1b)) (true)
:test ((gcd (+64b) (+48b)) =? (+16b)) (true)
:test ((gcd (+105b) (+30b)) =? (+15b)) (true)
:test ((gcd (+42b) (+56b)) =? (+14b)) (true)
:test ((gcd (+99b) (+66b)) =? (+33b)) (true)

main [[0]]