# Pair

Paradigm(s) Functional User:Hakerh400 2022 Turing complete Implementation in JavaScript `.txt`

Pair is a functional esoteric programming language invented by User:Hakerh400 in 2022. It is designed to be very simple to understand and use, but at the same time very powerful and expressive.

## Overview

Everything in this language is a value. A value can be either nil, a pair, a function, or something else:

• Nil is a unique value. It has no elements.
• Pair consists of two elements: the first and the second element.
• Function represents a computation. It takes a value as argument and returns the result.
• Something else represents something else. This is intentionally underspecified.

### Call

Every value can be called. The calee is called target and the argument is called argument. Depending on what the target is, there are three cases:

• If the target is a function, substitute the formal argument with the actual argument in the function's body.
• If the target is a pair, call the argument with the first element of the pair and then call the result with the second element of the pair.
• If the target is nil, return a function that takes two arguments and returns the first or the second argument, depending on whether the argument (of the nil) is a pair or nil, respectively. If the argument (of the nil) is neither a pair nor nil, the return value is a function that takes two arguments and returns nil.
• If the target is something else, the result is undefined.

## Syntax

Syntax is very simple. Source code consists of definitions. Each definition has a name, zero or more formal arguments and the function body. Example of a function definition:

```f a b c = a c (b c)
```

This function `f` takes three arguments and returns the result of calling `a` with `c` and `b c`. Call is left associative.

Nil is represented as `#`. Pair is represented as `(x, y)`. Example:

```nil = #
mk_pair a b = (a, b)
```

Constant `nil` is equal to nil. Function `mk_pair` takes two values and makes a pair of them.

Function definition may span to multiple lines, but each subsequent line must be indented by at least one space character.

### Syntactic sugar

On the left we show syntactic sugar and on the right we show desugared syntax.

```()               --->  #
a | b | c | ...  --->  a (b (c (...)))
(a, b, c, ...)   --->  (a, (b, (c, ...)))
[a, b, c, ...]   --->  (a, b, c, ..., #)
```

The square brackets thing is called a list. Literal natural number `n` is represented by a list of `n` nils.

Character `'x'` is represented by literal natural number representing its char code.

String `"abc"` is represented by a list of characters.

Semicolon is treated like the end of definition (it can be used to put multiple definitions in the same line).

## I/O format

There must be function `main` in the source code. The function is called with the input string and the result is the output string.

## Prelude

There are no builtin functions, so we need to define them:

```-- Basic

is_nil x = # x 0 1
is_pair x = # x 1 0

-- Function

id a = a
const a b = a
flip f x y = f y x
dot f g x = f | g x
dot2 f g x y = f | g x y
fst_arg a b = a
snd_arg a b = b
comb_I = id
comb_K = const
comb_S a b c = a c | b c
comb_iota f = f comb_S comb_K
fix f = f | fix f

-- Proposition

false = 0
true = 1
ite x a b = nil x a b
ite' a b x = nil x a b
not a = ite a 0 1
to_prop = dot not not
and a b = ite a b 0
or a b = ite a 1 b
xor a b = ite a (not b) b
xnor a b = ite a b (not b)

-- Tuple

tuple_to_list n xs = ite n (tuple_to_list' (dec n) xs) []
tuple_to_list' n xs = ite n (cons (head xs) | tuple_to_list' (dec n) | tail xs) [xs]
list_to_tuple = cases_list list_to_tuple' unit
list_to_tuple' x xs = ite_null xs x | cons x | list_to_tuple xs
map_tuple = dot2 list_to_tuple map_tuple'
map_tuple' fs tp = zip_with id fs | tuple_to_list (length fs) tp
show_tuple fs tp = concat ["(", intercalate ", " (map_tuple' fs tp), ")"]

-- Unit

unit = nil
show_unit = show_tuple []

-- Pair

pair a b = (a, b)
fst p = p fst_arg
snd p = p snd_arg
curry f a b = f (a, b)
uncurry f p = f (fst p) (snd p)
map_pair f g = map_tuple [f, g]
show_pair f g = show_tuple [f, g]
map_pair' f = map_pair f f
show_pair' f = show_pair f f
pair_to_list = tuple_to_list 2
swap p = (snd p, fst p)

-- Maybe

nothing = nil
just = pair nil
is_nothing = null
is_just = not_null
from_just = snd
maybe z f x = ite x (f | from_just x) z
show_maybe f = maybe "Nothing" | dot (append "Just ") f

-- Natural number

zero = nil
succ = cons zero
inc = succ
dec = tail
iter = dot foldr const
mk_nat = foldl (dot add | mul 10) 0
show_nat n = ite n (show_nat' n) "0"
show_nat' n = ite n (snoc (show_nat' | div n 10) | add '0' | mod n 10) []
read_nat = dot mk_nat | map | flip sub '0'
odd n = mod n 2
even = dot not odd
min a b = ite (le a b) a b
max a b = ite (le a b) b a
nat_find f = nat_find' f 0
nat_find' f n = ite (f n) n | nat_find' f | succ n
nat_find1 = dot dec nat_find
suba a b = sub (max a b) (min a b)
pow' = flip pow
sqrt = root 2
between a b c = and (ge c a) (le c b)
nats = iterate inc 0
mod' = flip mod
mk_nats f = map f nats
const_nats = dot mk_nats const
dvd = dot2 not mod'

-- Optimized functions

eq* a b = ite a (ite b (and (eq (fst a) (fst b)) (eq (snd a) (snd b))) 0) (not b)
le* = dot2 null sub
lt* = dot le succ
sub* = iter dec
mul* n = iter (add n) 0
div* m n = ite (lt m n) 0 | succ | div (sub m n) n
mod* m n = ite (lt m n) m | mod (sub m n) n
pow* n = iter (mul n) 1
ge* = dot2 not lt
gt* = dot2 not le
root* k n = nat_find1 | root' k n
root' k n x = gt (pow x k) n
log* k n = nat_find1 | log' k n
log' k n x = gt (pow k x) n

-- Integer

int_of_nat = pair 0
int_neg_succ_of_nat = pair 1
sign = fst
show_int n = concat [ite (sign n) "-" "", show_nat (int_val n)]
mk_int sign val = (ite val sign 0, sub val sign)
same_sign a b = eq (sign a) (sign b)
neg a = mk_int (not | sign a) | int_val a
int_of_sub_nat s a b = mk_int (xor s | lt a b) | suba a b
add_int a b = ite (same_sign a b) int_of_add_nat int_of_sub_nat (sign a) (int_val a) (int_val b)
sub_int a b = add_int a | neg b
mul_int a b = mk_int (not | same_sign a b) | mul (int_val a) (int_val b)
int_0 = mk_int 0 0
int_1 = mk_int 0 1
int_neg_1 = mk_int 1 1
dec_int = flip sub_int int_1
is_zero_int = dot not int_val
is_neg = sign
is_pos a = and (not | sign a) (to_prop | int_val a)
is_nneg = dot not is_neg
is_npos = dot not is_pos
pow_int a b = ite (is_neg b) int_0 | mk_int (and (sign a) | odd | int_val b) | pow (int_val a) | int_val b
pow_int' = flip pow_int
abs = dot (mk_int 0) int_val

-- List

nil = []
cons = pair
tail xs = ite_null xs nil | snd xs
null = is_nil
not_null = dot not null
ite_null = dot ite null
foldr f z xs = ite_null xs z | f (fst xs) | foldr f z | snd xs
foldl f z xs = ite_null xs z | foldl f (f z (fst xs)) | snd xs
map f = foldr (dot cons f) nil
append xs ys = foldr cons ys xs
singleton x = cons x nil
snoc xs = dot (append xs) singleton
concat = foldr append nil
index n xs = head | iter tail xs n
reverse = foldl (flip cons) []
length = foldr (const inc) 0
product = foldr mul 1
filter f = foldr (filter' f) []
filter' f x xs = ite (f x) (cons x xs) xs
intersperse x xs = ite xs (tail | foldr (intersperse' x) [] xs) []
intersperse' x y ys = cons x | cons y ys
intercalate x xs = concat | intersperse x | xs
repeat x = cons x | repeat x
replicate n x = take n | repeat x
take n xs = ite n (cons (head xs) (take (dec n) (tail xs))) []
drop n xs = iter tail xs n
concat_map = dot2 concat map
show_list f xs = concat ["[", intercalate ", " (map f xs), "]"]
cases_list f z xs = ite_null xs z | f (fst xs) (snd xs)
all f = foldr (dot and f) 1
any f = foldr (dot or f) 0
zip xs ys = cases_list (zip'1 ys) [] xs
zip'1 ys x xs = cases_list (zip'2 x xs) [] ys
zip'2 x xs y ys = cons (x, y) | zip xs ys
zip_with f = dot2 (map | uncurry f) zip
same_length xs ys = eq (length xs) (length ys)
tails = cases_list tails' [[]]
tails' x xs = cons (cons x xs) | tails xs
inits xs = map reverse | reverse | tails | reverse xs
range0 n = ite_null n [] | range0' | dec n
range0' = dot reverse tails
range1 = range 1
range a b = range' a | inc b
range' a b = map (add a) | range0 | sub b a
mk_list f = dot (map f) range0
mk_list' f = dot (mk_list f) inc
mk_list1 f = mk_list (dot f inc)
split_at_each f z xs = reverse | fst | foldl (split_at_each'1 f) ("", nothing) | snoc xs z
split_at_each'1 f acc c = split_at_each'2 (fst acc) c (ite | f c) | snd acc
split_at_each'2 xs c sp = maybe (xs, sp nothing (just [c])) (split_at_each'3 xs c sp)
split_at_each'3 xs c sp x = sp (cons (reverse x) xs, nothing) (xs, just (cons c x))
iterate f z = cons z | iterate f | f z
elem z = any | eq z
find_index f xs = foldr (find_index' f) nothing | zip xs nats
find_index' f x xs = ite (f | fst x) (just | snd x) xs
elem_index z = find_index (eq z)
elem_index' z xs = from_just | elem_index z xs
split_at n xs = ite (or (null n) (null xs)) ([], xs) | uncurry (split_at' | dec n) xs
split_at' n x xs = map_pair (cons x) id | split_at n xs
replace n x xs = uncurry append | map_pair id (dot (cons x) tail) | split_at n xs

-- Vector

vec_const = replicate
vec_zero n = vec_const n 0
show_vec = show_list show_nat
dist_norm k v1 v2 = root k | sum | zip_with (dist_norm' k) v1 v2
dist_norm' k x y = suba (pow x k) (pow y k)
dist = dist_norm 2
distm = dist_norm 1
hypot v = dist v | vec_zero | length v

-- Matrix

mk_mat f w h = mk_list (mk_mat' (flip f) w) h
mk_mat' f w y = mk_list (f y) w
show_mat = dot show_list show_list
map_mat = dot map map
foldl_mat f z m = foldl f z | concat m
foldr_mat f z m = foldr f z | concat m

-- Character

chr = id
ord = id
show_char c = ['\, c, '\]
is_space = eq ' '
is_new_line c = or (eq c '\r') (eq c '\n')
is_lower_letter = between 'a' 'z'
is_upper_letter = between 'A' 'Z'
is_letter c = or (is_lower_letter c) (is_upper_letter c)
to_lower_char c = ite (is_upper_letter c) (add c 32) c
to_upper_char c = ite (is_lower_letter c) (sub c 32) c

-- String

words = split_at_each is_space ' '
lines = split_at_each is_new_line '\n'
unwords = intercalate " "
unlines = intercalate "\n"
show_str xs = concat ["\"", xs, "\""]
to_lower = map to_lower_char
to_upper = map to_upper_char
capitalize = cases_list (dot cons to_upper_char) ""
split_at_char c = split_at_each (eq c) c

map_m f = cases_list (map_m'1 f) | pure []
map_m'1 f x xs = do
y <- f x
ys <- map_m f xs
return cons y ys

-- State

pure = pair
bind m f s = uncurry f | m s
seq m m1 = bind m | const m1
run_state = id
eval_state = dot2 fst run_state
exec_state = dot2 snd run_state
get s = (s, s)
put s1 s = (unit, s1)
gets = dot (bind get) | dot pure
modify = dot (bind get) | dot put
get' = dot gets index
put' = dot2 modify replace
modify' i = dot (bind | get' i) | dot | put' i
gets' i = dot (bind | get' i) | dot pure
```

The language supports special syntax for monads. We introduce additional syntactic sugar (`\n` represents new line):

```f args = do \n x = expr \n g   --->  f args = f' args expr \n f' args x = do \n g
f args = do \n x <- expr \n g  --->  f args = bind expr | f' args \n f' args x = do \n g
f args = do \n expr \n g       --->  f args = seq expr | f' args \n f' args = do \n g
f args = do \n g               --->  f args = g
return                         --->  pure |
```

The prelude supports only the state monad. Here is an example:

```main n = show_list show_nat | exec_state (func | read_nat n) [1, 2, 3, 4]

func n = do
xs <- get
ys = cons n xs
put ys
return ()
```

This program reads a natural number `n` and outputs the list `[n, 1, 2, 3, 4]`

## Examples

### Cat program

```main = id
```

### Hello, World!

```main = const "Hello, World!"
```

### Reverse the input

```main = reverse
```

### Sum odd numbers

Read a list of space-separated natural numbers in base 10 and output the sum of odd numbers from the list.

```main inp = show_nat | sum | filter odd | map read_nat | words inp
```

### Quine

Modulo the prelude.

```a="main=const|concat[[97,61],show_str a,[10],a]"
main=const|concat[[97,61],show_str a,[10],a]
```

### Truth-machine

```main inp = ite (eq inp "0") "0" | repeat '1'
```

### N-th digit of pi

```main inp = show_nat | func | read_nat inp
func i = func'1 i | pow 10 | succ i
func'1 i w = mod (div (mul 4 | mul (pow 10 i) | foldr_mat (func'2 w) 0 | mk_mat pair w w) | pow w 2) 10
func'2 w p c = add c | lt (hypot | pair_to_list p) w
```

### Fibonacci sequence

Output the first `n` Fibonacci numbers.

```main n = show_list show_nat | mk_list fib | read_nat n
fib n = ite n (fib' | dec n) 0
fib' n = ite n (add (fib n) (fib | dec n)) 1
```

### 99 bottles of beer

```main = const | intercalate "\n\n" | reverse | mk_list func 100
func n = concat [capitalize (bottles_of_beer_wall n), ", ", bottles_of_beer n, ".\n", ite n (take_one_down n) go_to_the_store]
bottles_of_beer n = concat [ite n (show_nat n) "no more", " bottle", ite (eq n 1) "" "s", " of beer"]
bottles_of_beer_wall n = concat [bottles_of_beer n, " on the wall"]
take_one_down n = concat ["Take one down and pass it around, ", bottles_of_beer_wall (dec n), "."]
go_to_the_store = concat ["Go to the store and buy some more, ", bottles_of_beer_wall 99, "."]
```

### Factorial

```main n = show_list show_nat | mk_list' (dot product range1) | read_nat n
```

### Prime numbers

Output the first `n` prime numbers.

```main n = show_list show_nat | take (read_nat n) | filter prime nats
prime n = and (ge n 2) | all (mod n) | range 2 | dec n
```

### Disan count

```main n = show_list show_nat | filter even | range0 | read_nat n
```

### Digital root calculator

```main n = show_nat | func | read_nat n
func n = ite (lt n 10) n | func | sum | digits n
digits n = ite (lt n 10) [n] | cons (mod n 10) | digits | div n 10
```

### Brainfuck interpreter

Input string consists of the brainfuck source code and the brainfuck input, separated by a semicolon.

```main src = uncurry run | map_pair parse id | list_to_tuple | split_at_char ';' src

move_left = move 3 4
move_right = move 4 3
basic_insts = "<>+-,."
pure_inst i = pure (i, nil)
exec_insts = map_m exec_inst
parse src = eval_state parse_insts src
eof = bind get | ite' eof' | pure true
set_val val = modify' 4 | replace 0 val
output = bind get_val | dot (modify' 2) cons
parse_loop = bind parse_insts | dot pure | pair 6
parse_insts = bind eof | ite' (pure []) parse_insts'
exec_inst inst = index (fst inst) inst_funcs | snd inst
add_val n = bind get_val | dot (dot set_val | mod' 256) | add n
run insts inp = eval_state run' [insts, inp, "", const_nats 0, const_nats 0]
run' = bind (get' 0) | dot (flip seq | bind (get' 2) | dot pure reverse) | exec_insts
exec_loop insts = bind get_val | ite' (seq (exec_insts insts) | exec_loop insts) | pure ()
eof' = bind (parse_char 0) | dot (ite' (seq advance | pure true) | pure false) | eq ']'
inst_funcs = snoc (map const [move_left, move_right, inc_val, dec_val, input, output]) exec_loop
parse_inst = bind (parse_char 1) | dot (maybe parse_loop pure_inst) | flip elem_index basic_insts

parse_insts' = do
inst <- parse_inst
insts <- parse_insts
return cons inst insts

src <- get

move a b = do
mem <- get' a
put' a | tail mem
modify' b | cons | head mem

input = do
inp <- get' 1
put' 1 | tail inp
set_val | cases_list fst_arg 0 inp
```

```output_as_string = false
main src = format_output | reverse | index 1 | exec_state (map_m run src) [int_0, ""]

format_output = ite output_as_string (map | dot int_val abs) | show_list show_int
run x = index (elem_index' x "idso") inst_funcs
inst_funcs = [increment, decrement, square, output]
normalize n = ite (elem n [int_neg_1, mk_int 0 256]) int_0 n
modify_val f = modify' 0 | dot normalize f
increment = modify_val inc_int
decrement = modify_val dec_int
square = modify_val | pow_int' | mk_int 0 2
output = bind (get' 0) | dot (modify' 1) cons
```

### FizzBuzz

```main n = unlines | mk_list1 func | read_nat n
func n = func' n (dvd 3 n) (dvd 5 n)
func' n m3 m5 = ite (or m3 m5) (concat [ite m3 "Fizz" "", ite m5 "Buzz" ""]) | show_nat n
```