Реализация целочисленной арифметики на Haskell

Долгое время считалось, что натуральные числа, как и числа в целом, являются неопределяемыми понятиями, первичными; их можно познать только интуицией. Однако в настоящее время всем числовым множествам было дано четкое определение.

Наиболее удобным способом является определение по Пеано. Однако оно определяет счетные множества, но не даёт определенного сконструированного множества. Другой подход — определить натуральное число как специальное кардинальное, а именно мощность конечного множества. Третий — нумералы Чёрча.

Я же предложу Вам подумать над тем, следует ли при всех выше перечисленных определениях считать числа предопреденными понятиями. Давайте представим, что вдруг в один момент весь мир встанет с ног на голову и ниодин компьютер не сможет хранить числовые данные. Тогда программистам станет очень худо. Но стоит лишь вспомнить всё выше сказанное и сразу всё станет на своё место. Реализуем тип натурального и целого числа на Haskell, как пример определения «с нуля». В качестве базы возьмём понятие списка и определим нат. число как его длину (при условии конечности последней).

data [a] = [] | a:[a] -- определение списка, [] и : — конструкторы, [] — имя типа
head x:_ = x; tail _:x = x;
data () = () -- пустой тип, имя которого совпадает с именем единственного безаргументного конструктора

Немного теории:
конечный список ::= x: (x==[]) || (tail x — конечный)
Равенство списков определяется []==[] = True; (a:as)==(b:bs) = (a==b) && (as==bs)при условии, что элементы сравниваемые.
Подобно теоретико-множественному подходу, определим понятие «равнодлинности» списков, а именно:
a~b ::= (a==[] && b==[]) || (tail a ~ tail b)
Данное отношение эквивалентное (симметричное-транзитивное-рефлексивное), потому можно построить класс эквивалентности для каждого списка. За базу возьмем последовательность списков [], [()], [(),()], [(),(),()], ..., то есть множество [()].
Между собой они не равнодлинны, однако для любого конечного списка найдется список из множества [()] той же длины. Посему будем отождествлять класс эквивалентности его представителю из [()].

type N = [](); -- синоним [()]
data Natural = MkN N; -- собственно, тип натурального числа

Опишем несколько примитивных операций для натуральных чисел:
toList :: Natural -> N; -- введено для удобства
toList (MkN x) = x;
incN :: Natural -> Natural; -- инкремент, существенная функция
incN = MkN.(():).toList;

-- сумма чисел есть длина конкатенации представителей
sumN :: Natural -> Natural -> Natural;
sumN (MkN x) = MkN.(++x).toList;

copy :: a->[a]; copy x = x: copy x;
concatAll :: [[a]] -> [a];
concatAll = foldl(++)[];
table :: Natural -> a -> [a]; -- создает список заданной длины с заданным элементом
table x y = map (\_->y) $ toList x;

-- произведение чисел a*b есть сумма a раз числа b (неформально),
-- или свертка к нулю суммы списка из b длины a (то же самое, но формально)
-- в реализации свертка суммы упрощена и заменена на concatAll
multN :: Natural -> Natural -> Natural;
multN x y = MkN $ concatAll $ table x (toList y);
decN :: Natural -> Natural;
decN (MkN(_:xs)) = MkN xs;
decN (MkN []) = error "Cannot decrease 0 staying being Natural";
zeroN :: Natural;
zeroN = MkN [];
oneN :: Natural;
oneN = MkN [()];
equalN :: Natural -> Natural -> Bool;
equalN (MkN a) (MkN b) = a==b;

Остается ещё несколько функций:
subN :: Natural -> Natural -> Natural;
subN x y | y==oneN = decN x -- x-1=decN(x)
| y/=zeroN = decN $ subN x $ decN y -- x-y=(x-1)-(y-1)
| True = x; -- x-0=x
divmodN :: Natural -> Natural -> (Natural, Natural);
divmodN (MkN []) _ = error "cannot divide by zero";
divmodN base x | moreThanN base x = (zeroN, x)
| True = let (d,m) = divmodN base (subN x base) in (incN d,m);
moreThanN :: Natural -> Natural -> Bool;
moreThanN (MkN []) _ = False;
moreThanN _ (MkN []) = True;
moreThanN x y = moreThanN (decN x) (decN y);
lengthN :: [a] -> Natural;
lengthN = MkN . map (\_->());

Теперь обобщим до понятия целого числа:
data Integer = Positive Natural | Negative Natural;
Обобщим некоторые функции натурального аргумента:
absInt :: Integer -> Natural;
absInt (Positive x) = x;
absInt (Negative x) = x;
equalInt :: Integer -> Integer -> Bool;
equalInt (Positive x) (Positive y) = x `equalN` y;
equalInt (Negative x) (Negative y) = x `equalN` y;
equalInt (Negative x) (Positive y) | x==zeroN && y==zeroN = True;
equalInt (Positive x) (Negative y) | x==zeroN && y==zeroN = True;
equalInt _ _ = False;
negate :: Integer -> Integer;
negate (Positive x) = (Negative x);
negate (Negative x) = (Positive x);
sumInt :: Integer -> Integer -> Integer;
sumInt (Positive x) (Positive y) = Positive (sumN x y);
sumInt (Positive x) (Negative y) = if x `moreThanN` y then Positive (subN x y) else Negative (subN y x);
sumInt (Negative x) (Positive y) = if y `moreThanN` x then Positive (subN y x) else Negative (subN x y);
sumInt (Negative x) (Negative y) = Negative (sumN x y);

Дальше приводить не буду с целью экономии места.

Последний штрих: преобразование в строку. В примере реализуется троичная система (по длине figures)
figures = ['0', '1', '2'];
naturalseries = zeroInt : map incInt naturalseries;
figuretoInt = compare $ zip figures naturalseries where{compare ((a,b):c) x | a==x = b | True = compare c x;};
inttoFigure = getElement figures where {getElement (h:t) n = if n==zeroInt then h else getElement t $ decInt n;};
base :: Integer;
base = lengthInt figures;
showInt :: Integer -> [Char];
showInt x | x<zeroInt = '-' : showInt (negate x)
| x==zeroInt = "0"
| x<base = [inttoFigure x]
| True = let (d,m) = divmodInt base x
in (show d) ++ [inttoFigure m];
readInt :: [Char] -> (Integer, [Char]);
readInt "" = error "No integer to read on input";
readInt str@(f:r)
| f=='-' = let (i,s) = readInt r in (negate i,s)
| f=='+' = readInt r
| True = let (num,rest) = split str in (parse $ map figuretoInt num, rest);
split :: [Char] -> ([Char],[Char]);
split "" = ("","");
split (x:y) | x~->figures = let (a,b)=split y in (x:a,b)
| True = ("", x:y);
parse :: [Integer] -> Integer;
parse = foldl (\g h->sumInt h $ multInt base g) zeroInt;

Использовалась функция принадлежности элемента списку (~->) :: (Eq a) => a -> [a] -> Bool;
a ~-> [] = False;
a ~-> (b:c) = (a==b) || (a ~-> c);

Все, мiръ спасенъ!

P.S. ничего серьёзного. Я хотел лишь показать, что те типы, которые являются базовыми почти всюду, и во многих языках не допускают переопределения, могут быть спокойно определены как-бы «с нуля».
P.P.S. тем не менее я использовал Bool, поэтому всегда можно сказать, что этот тип есть аналог бита, затем же как-то сгрупировать по 8, 16, 32, 64 элемента, что даст аналоги типов Byte, Word,…