Pair

Pair

Paradigm(s)	Functional
Designed by	User:Hakerh400
Appeared in	2022
Computational class	Turing complete
Major implementations	Implementation in JavaScript
File extension(s)	.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
add* = iter 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
int_val = uncurry add
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_add_nat s a b = mk_int s | add a b
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
inc_int = add_int int_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
head = fst
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
sum = foldr add 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

-- Monad

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

Monads

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

inc_val = add_val 1
move_left = move 3 4
move_right = move 4 3
advance = modify tail
dec_val = add_val 255
basic_insts = "<>+-,."
get_val = gets' 4 head
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

parse_char adv = do
  src <- get
  ite adv advance | pure ()
  return head src

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

Deadfish interpreter

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

Implementation

Implementation