Trivial is a pure functional Haskell-like programming language based on the Hot calculus. Each Trivial program is internally compiled directly to a Hot combinator.
Overview
Source code consists of functions. Unlike in Haskell, Trivial has no types (everything is a function and everything can be called). Each function technically takes exactly one argument, but multi-argument functions can be implemented using currying. Each function has a name, formal arguments and resulting expression. This is an example of a function:
func x y z = x z (y z);
The name of this function is func and it takes three arguments (technically takes only one argument and returns a function that takes the remaining two arguments). Arguments are also functions, so they can be called. The resulting expression is x z (y z), which means: call x with argument z and then call the result of x z with the result of calling y with z. Semicolon is mandatory after each function definition.
Function name and identifiers (arguments) can contain any character except whitespace, parentheses and semicolons. Also, an identifier cannot consist of a single = character (but == or != are allowed). All functions are in prefix notation. We can implement operators (literally name a function +), but it is still a prefix function, not an infix operator (so we must use + x y to add two numbers).
One important thing to note is that functional Eta reduction is always implicit in Hot calculus (because of the way Hot reduction rules work). Therefore, any two Eta-equivalent functions in Trivial are interchangeable. For example, if we have a function that calculates a square of a number, like this:
square x = * x x;
It basically calls function * (assuming we already implemented it) and passes arguments x and x, which multiplies number x by itself. The result is, of course, a number. However, according to the Eta reduction, the following function is equivalent:
square' x y = * x x y;
Function square' is equivalent to square and it is totally interchangeable with square. At first sight, * x x is a number and it looks weird to have * x x y, which is basically (* x x) y. It means that we are calling number * x x with argument y. However, as we said, everything in this language is a function, so calling a number is perfectly fine. Also, the only way to inspect a value is to call it, so the only way to inspect a number (or a list, or a pair, or any other structure) is to call it.
There are no local function definitions or lambda functions. All functions are global and all values are constants (there are no variables).
Builtin functions
There are literally no builtin functions. The first function that appears in the source code is the main function (it can have any name). It is transformed to a Hot combinator and evaluated according to the Hot's reduction rules.
I/O format
If bit stream is used, then I/O format is the same as Hot's I/O format. If ASCII text is used as I/O, then convert each byte to 8 bits (padded with zeros), then reverse bits in each byte, concatenate all bits and parse according to the Hot's I/O format.
Example
Instead of providing many smaller examples, we provide one large example. In this example, we read an array of space-separated non-negative integers in base-10 and output the sum of odd integers from the array. It should be trivial from this example how to implement pairs, lists, integers, list operations, integer operations, etc. We also show how to implement most of the Haskell's built-in list functions (such as map, foldl, foldr, etc).
There are some exceptions. For example, in Haskell ++ is concatenation, while in this example ++ stands for incrementing an integer and concatenation is join. Also, uncons in this example has different purpose than Haskell's uncons.
// **********************************************************
// **
// ** I/O operations
// **
// **********************************************************
start io = readStr io (onReadStr io);
onReadStr io str = writeStr io (mainWrap str);
mainWrap str = bytes2bits (main (bits2bytes str));
bits2bytes str = map (Int B0) (splitAtLength 8 str);
bytes2bits str = concatMap (. (padEnd B0 8) getBits) str;
read io = io B0;
write io = io B1;
readStr io cb = readStr' io cb [];
readStr' io cb str = read io (onReadFlag io cb str);
onReadFlag io cb str flag = flag (readBit io cb str) (cb (reverse str));
readBit io cb str = read io (onReadBit io cb str);
onReadBit io cb str bit = readStr' io cb (: bit str);
writeStr io str = write io (fst str) (writeStr io (snd str));
// **********************************************************
// **
// ** Basic functions
// **
// **********************************************************
K = B1;
S a b c = a c (b c);
id a = a;
const = B1;
. a b c = a (b c);
swap f a b = f b a;
while f g z = f z
(while f g (g z))
z;
until f g z = f z
z
(until f g (g z));
repeat f z n = nz n
(repeat f (f z) (-- n))
z;
// **********************************************************
// **
// ** Ord
// **
// **********************************************************
EQ = Pair B1 B0;
LT = Pair B0 B0;
GT = Pair B0 B1;
== = fst;
!= = . ! fst;
< = pmap && ! !;
<= = . ! snd;
> = snd;
>= = unpair ||;
// **********************************************************
// **
// ** Bit
// **
// **********************************************************
B0 a b = b;
B1 a b = a;
cmp{bit} x y = x
(y EQ GT)
(y LT EQ);
! bit = bit B0 B1;
|| bit1 bit2 = bit1 B1 bit2;
&& bit1 bit2 = bit1 bit2 B0;
^^ bit1 bit2 = bit1 (! bit2) bit2;
!^ bit1 bit2 = bit1 bit2 (! bit2);
// **********************************************************
// **
// ** Pair
// **
// **********************************************************
Pair a b c = c b a;
fst pair = pair B0;
snd pair = pair B1;
unpair f pair = f (fst pair) (snd pair);
unpair2 f pair1 pair2 = f
(fst pair1)
(snd pair1)
(fst pair2)
(snd pair2);
pmap f g h pair = f (g (fst pair)) (h (snd pair));
// **********************************************************
// **
// ** Maybe
// **
// **********************************************************
Nothing = Pair B0 B0;
Just a = Pair B1 a;
unmaybe f z m = fst m
(f (snd m))
z;
// **********************************************************
// **
// ** List
// **
// **********************************************************
[] = Pair B0 B0;
: a b = Pair B1 (Pair a b);
uncons f z list = nempty list
(f (head list) (tail list))
z;
uncons1 f = uncons f [];
uncons2 f z1 z2 list1 list2 = f
(head1 z1 list1)
(tail2 list1)
(head1 z2 list2)
(tail2 list2);
nempty list = fst list;
empty list = ! (nempty list);
head list = fst (snd list);
tail list = snd (snd list);
head1 z list = nempty list (head list) z;
tail1 z list = nempty list (tail list) z;
tail2 = tail1 [];
rawList = rawList' [];
rawList' acc flag elem = flag
(rawList' (: elem acc))
(reverse acc elem);
rawList1 n = rawList1' n [];
rawList1' n acc elem = nz n
(rawList1' (-- n) (: elem acc))
(reverse acc elem);
map func list = uncons (map' func) [] list;
map' func x xs = : (func x) (map func xs);
foldl f z list = uncons (foldl' f z) z list;
foldl' f z x xs = foldl f (f z x) xs;
foldl1 f list = foldl f (head list) (tail list);
foldr f z list = uncons (foldr' f z) z list;
foldr' f z x xs = f x (foldr f z xs);
foldr1 f list = uncons (foldr1' f) B0 list;
foldr1' f x xs = nempty xs
(f x (foldr1 f xs))
x;
scanl f z list = reverse (foldl (scanl' f) (: z []) list);
scanl' f acc elem = : (f (head acc) elem) acc;
scanr f z list = foldr (scanr' f) (: z []) list;
scanr' f elem acc = : (f elem (head acc)) acc;
scanl1 f list = uncons1 (scanl f) list;
scanr1 f list = scanr f (last list) (init list);
join = swap (foldr :);
joinRev = swap (foldl (swap :));
reverse = swap joinRev [];
concat = foldr join [];
concatMap f list = concat (map f list);
singleton = swap : [];
prependToAll sep list = foldr (prependToAll' sep) [] list;
prependToAll' sep elem acc = : sep (: elem acc);
intersperse sep list = uncons (intersperse' sep) [] list;
intersperse' sep x xs = : x (prependToAll sep xs);
intercalate x list = foldr (intercalate' x) [] list;
intercalate' x elem acc = empty acc
elem
(join elem (join x acc));
filter f list = foldr (filter' f) [] list;
filter' f elem acc = f elem
(: elem acc)
acc;
init = uncons1 init';
init' x xs = nempty xs
(: x (init xs))
[];
last = foldl1 B0;
inits list = scanr inits' list list;
inits' elem acc = init acc;
tails list = scanr : [] list;
replicate n elem = repeat (: elem) [] n;
length = foldl length' 0;
length' acc elem = ++ acc;
splitAtLength len list = splitAtLength' len len list [] [];
splitAtLength' len index list sub acc = nz index
(nempty list
(splitAtLength'
len
(-- index)
(tail list)
(: (head list) sub)
acc)
(reverse (nempty sub (: (reverse sub) acc) acc)))
(splitAtLength' len len list [] (: (reverse sub) acc));
padStart elem len list = join
(replicate
(max (- len (length list)) 0)
elem)
list;
padEnd elem len list = join
list
(replicate
(max (- len (length list)) 0)
elem);
split func list = split'1 func 0 [] list [] [];
split'1 func skip prev list sub acc = uncons
(split'2 func skip prev list sub acc)
(unmaybe
(const (reverse (: [] (: (reverse sub) acc))))
(reverse (: (reverse sub) acc))
(func prev list))
list;
split'2 func skip prev list sub acc x xs = nz skip
(split'1 func (-- skip) (: x prev) xs sub acc)
(unmaybe
(split'3 func prev sub acc x xs)
(split'1 func 0 (: x prev) xs (: x sub) acc)
(func prev list));
split'3 func prev sub acc x xs n = nz n
(split'1 func (-- n) (: x prev) xs [] (: (reverse sub) acc))
(split'1 func 0 (: x prev) xs (: x []) (: (reverse sub) acc));
// **********************************************************
// **
// ** Integer
// **
// **********************************************************
Int sign bits = Pair sign (sanitizeIntBits sign bits);
sanitizeIntBits sign bits = foldr (sanitizeIntBits' sign) [] bits;
sanitizeIntBits' sign bit bits = || (nempty bits) (^^ bit sign)
(: bit bits)
[];
cmp{int} a b = cmp{int}' (- a b);
cmp{int}' a = nz a
(nonNegative a GT LT)
EQ;
getSign = fst;
getBits = snd;
unint = unpair;
unint2 = unpair2;
0 = Int B0 [];
1 = ++ 0; 2 = ++ 1; 3 = ++ 2;
4 = ++ 3; 5 = ++ 4; 6 = ++ 5;
7 = ++ 6; 8 = ++ 7; 9 = ++ 8;
nz = pmap || id nempty;
nonNegative = . ! getSign;
negative = getSign;
fstBit = unint head1;
~ = pmap Int ! (map !);
neg = . ~ --;
++ = unint (++'1 []);
++'1 bitsNew sign bits = uncons
(++'2 bitsNew sign)
(Int B0 (sign
[]
(joinRev bitsNew (singleton B1))
))
bits;
++'2 bitsNew sign bit bits = bit
(++'1 (: B0 bitsNew) sign bits)
(Int sign (joinRev bitsNew (: B1 bits)));
-- = unint (--'1 []);
--'1 bitsNew sign bits = uncons
(--'2 bitsNew sign)
(Int B1 (sign
(joinRev bitsNew (singleton B0))
[]
))
bits;
--'2 bitsNew sign bit bits = bit
(Int sign (joinRev bitsNew (: B0 bits)))
(--'1 (: B1 bitsNew) sign bits);
+ = unpair2 (+'1 B0 []);
+'1 carry bitsNew sign1 bits1 sign2 bits2 = || (nempty bits1) (nempty bits2)
(uncons2 (+'2 carry bitsNew sign1 sign2) sign1 sign2 bits1 bits2)
(Int
(carry && || sign1 sign2)
(reverse (: (carry !^ ^^ sign1 sign2) bitsNew))
);
+'2 carry bitsNew sign1 sign2 x xs y ys = +'1
(carry || && x y)
(: (carry !^ ^^ x y) bitsNew)
sign1 xs sign2 ys;
- a b = + a (neg b);
* a b = *' a b 0;
*' a b acc = nz a
(*'
(>>1 a)
(<<1 b)
(fstBit a (+ acc b) acc)
)
acc;
/U N D = /U' N D 0 N;
/U' N D Q R = >= (cmp{int} R D)
(/U' N D (++ Q) (- R D))
(Pair Q R);
/QR N D = negative D
(pmap neg id (/QR N (neg D)))
(negative N
(unpair (/QR' D) (/QR (neg N) D))
(/U N D));
/QR' D Q R = nz R
(Pair (~ Q) (- D R))
(Pair (neg Q) 0);
/ a b = fst (/QR a b);
% a b = snd (/QR a b);
<<1 = pmap Int id (: B0);
>>1 = pmap Int id tail2;
<< a b = nonNegative b
(repeat <<1 a b)
(>> a (neg b));
>> a b = nonNegative b
(repeat >>1 a b)
(<< a (neg b));
min a b = < (cmp{int} a b) a b;
max a b = > (cmp{int} a b) a b;
lowestBit = unint (uncons B1);
// **********************************************************
// **
// ** Main program
// **
// **********************************************************
10 = ++ 9;
0x20 = * 4 8;
0x30 = * 6 8;
bin2str = map bin2str';
bin2str' bit = + 0x30 (bit 1 0);
str2int = foldl str2int' 0;
str2int' acc digit = + (* acc 10) (- digit 0x30);
int2str n = nz n
(int2str' n [])
(singleton 0x30);
int2str' n acc = nz n
(int2str' (/ n 10) (: (+ 0x30 (% n 10)) acc))
acc;
main str = int2str (
foldl + 0 (
filter lowestBit (
map str2int (
split splitFunc str))));
splitFunc s1 s2 = uncons splitFunc' Nothing s2;
splitFunc' x xs = == (cmp{int} x 0x20)
(Just 1)
Nothing;
Usage:
Input: 0 1 10 6 67 5 5 97 559 911 44 8 696 8 5 763 8 590 100
Output: 2413
Interpreters
Interpreter