Pair

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
Category:Languages
Category:Turing complete
Category:2022
Category:Implemented
Category:Functional paradigm