Игра Жизнь на языке программирования Mercury

    В рамках экспериментов с языком программирования Mercury а также под впечатлением уже неоднократно поднимавшейся в последнее время здесь темы игры Жизнь (1, 2, 3) захотелось написать свою реализацию на этом интересном языке программирования.

    В двух словах о Mercury. Этот язык функционально-логического программирования замышлялся как усовершенствование prolog'а. Усовершенствование заключается в введении в пролог статической типизации (а так же декларирование режима детерминизма). Как результат — больше возможностей у компилятора создать эффективный исполнимый код, больший контроль на этапе компиляции. Любителям пролога, наверняка знаком анекдот:
    Q: How many Prolog programmers does it take to change a light bulb?
    A: False.

    В царстве прологов нишу типизированных прочно занимает Visual Prolog. Но, стоит отметить, что подходы Visual Prolog и Mercury весьма отличны.

    Поход VIP более консервативен, а Mercury — более радикален. Например, из mercury были выкинуты все императивные возможности классических прологов, как например assert/retract, failure-driven loops, и т.д., а методы работы с вводом-выводом напоминают таковые в Haskell, а именно, каждая функция, использующая ввод-вывод обязана принять две дополнительные переменные: WorldIn и WorldOut, описывающие состояние внешнего мира до и после вызова этой функции. Эти две переменные служат для задания параметрической зависимости между двумя последовательными вызовами функций, что запрещает компилятору переставлять их местами. В отсутствие такой зависимости компилятор волен тасовать вызовы функций/предикатов как ему заблагорассудится в угоду оптимизации результирующей программы. Разработчики VIP, напротив, не только не убрали императивные возможности, но даже добавили ООП в свою реализацию Prolog.

    Вообще, тут можно много еще рассказать, однако перейдем к коду. (Дополнительную информацию по теме Mercury, вы, при желании, можете найти на официальном сайте, или на этом русскоязычном сайте).

    Реализация на самом деле, основывается на подходе решения на APL, показанного в этом видео на youtube:
    Игра Жизнь в одну строку APL кода.

    Уверен, что знатоки Prolog и Erlang найдут синтаксис Mercury весьма знакомым.

    :- module life.
    
    :- interface.
    
    :- import_module io.
    
    :- pred main(io, io).
    :- mode main(di, uo) is det.
    
    :- implementation.
    
    :- import_module int, list, require.
    
    :- type row == list(int).
    :- type grid == list(row).
    :- type sign ---> sum; mul; or_.
    
    :- type lr ---> left; right; no.
    :- type ud ---> up; down; no.
    
    eq([R | RR], N) = [eq_row(R, N) | eq(RR, N)].
    eq([], _) = [].
    
    eq_row([H|T], N) = [(H=N->1;0) | eq_row(T,N)].
    eq_row([],_) = [].
    
    sum(M1, M2) = R :- R1 = agg(M1, M2, sum) -> R = R1 ; error("can't sum").
    or(M1, M2) = R :- R1 = agg(M1, M2, or_) -> R = R1 ; error("can't or").
    mul(M1, M2) = R :- R1 = agg(M1, M2, mul) -> R = R1 ; error("can't mul").
    
    sum_lst(L) = R :- (
    	L = [M1,M2|MM] -> R = sum_lst([sum(M1,M2)|MM])
    	;
    	L=[M] -> R = M
    	;
    	error("sum_lst")
    	).
    
    :-func agg(grid, grid, sign) = grid is semidet.
    agg([R1 | RR1], [R2 | RR2], Sign) = [agg_rows(R1, R2, Sign) | agg(RR1, RR2, Sign)].
    agg([], [], _) = [].
    
    :-func agg_rows(row, row, sign) = row is semidet.
    agg_rows([E1 | EE1], [E2 | EE2], Sign) = [agg_elts(E1, E2, Sign) | agg_rows(EE1, EE2, Sign)].
    agg_rows([], [], _) = [].
    
    agg_elts(E1, E2, sum) = E1 + E2. 
    agg_elts(E1, E2, mul) = E1 * E2. 
    agg_elts(E1, E2, or_) = E1 \/ E2. 
    
    hor([H | T], LR) = [hor_row(H, LR) | hor(T, LR)].
    hor([], _) = [].
    
    head_det(L) = E :- (
    	L = [], error("empty list")
    	;
    	L=[E1|_], E = E1
    	).
    	
    gen(T, N) = R :- (
    	N=0 -> R = []
    	;
    	R = [T|gen(T,N-1)]
    	).
    
    vert(M, up) = [zeros(M) | without_last(M)].
    vert(M, down) = without_first(M) ++ [zeros(M)].
    vert(M, no) = M.
    
    zeros(M) = gen(0, length(head_det(M))).
    
    without_first(L) = R :- (
    	L = [], error("without_first fail")
    	;
    	L=[_ | T], R=T
    	).
    
    without_last(L) = R :- ( 
    	L=[], error("without_last fail")
    	;
    	L=[_], R=[]
    	;
    	L=[H,H1|T], R=[H|without_last([H1|T])]
    	).
    
    hor_row(L, left) = [0 | without_last(L)].
    hor_row(L, right) = without_first(L) ++ [0].
    hor_row(L, no) = L.
    
    :- func move(grid, ud, lr) = grid.
    move(M, UD, LR) = hor(vert(M, UD), LR).
    
    neighbours(M) = sum_lst([
    	move(M, up, left),
    	move(M, up, no),
    	move(M, up, right),
    	
    	move(M, no, left),
    	move(M, no, no),
    	move(M, no, right),
    
    	move(M, down, left),
    	move(M, down, no),
    	move(M, down, right)
    	]).
    
    
    %% this is GoL algorithm
    %%
    next(M) = or(eq(MN,3), eq(mul(M,MN),4)) :- MN = neighbours(M).
    
    
    %% grid pretty-print
    %%
    print_m([H|T]) --> print_r(H), nl, print_m(T).
    print_m([]) --> [].
    
    print_r([H | T]) --> print_el(H), print_r(T).
    print_r([]) --> [].
    
    print_el(H) --> print(H=0->".";"#").
    
    trace(M, N) --> (
    	{N = 0} -> []
    	;
    	print_m(M),
    	nl,
    	trace(next(M), N-1)
    	).
    
    m1 = [
    	[0,1,0,0,0,0,0,0,0,0],
    	[0,0,1,0,0,0,0,0,0,0],
    	[1,1,1,0,0,0,0,0,0,0],
    	[0,0,0,0,0,0,0,0,0,0],
    	[0,0,0,0,0,0,0,0,0,0],
    	[0,0,0,0,0,0,0,0,0,0],
    	[0,0,0,0,0,0,0,0,0,0],
    	[0,0,0,0,0,0,0,0,0,0],
    	[0,0,0,0,0,0,0,0,0,0]
    	].
    
    main -->
    	trace(m1,25).


    Фактически, ключевой строкой всего алгоритма является:

    %% this is GoL algorithm
    %%
    next(M) = or(eq(MN,3), eq(mul(M,MN),4)) :- MN = neighbours(M).


    которая дословно значит: клетка будет жива на следующем шаге, если её число соседей, включая себя, равно 3, или число соседей, включая себя, равно 4 и клетка жива.

    Еще одной интересной особенностью mercury является умение выводить типы, так же как и haskell. Для этого надо компилировать с ключем --infer-all:

    D:\stuff\test\mercury>mmc.bat --infer-all -s hlc.gc life.m
    life.m:021: Inferred :- func eq(list.list(list.list(T2)), T2) =
    life.m:021:   list.list(list.list(int)).
    life.m:024: Inferred :- func eq_row(list.list(T2), T2) = list.list(int).
    life.m:027: Inferred :- func sum(list.list(list.list(int)),
    life.m:027:   list.list(list.list(int))) = list.list(list.list(int)).
    life.m:028: Inferred :- func or(list.list(list.list(int)),
    life.m:028:   list.list(list.list(int))) = list.list(list.list(int)).
    life.m:029: Inferred :- func mul(list.list(list.list(int)),
    life.m:029:   list.list(list.list(int))) = list.list(list.list(int)).
    life.m:031: Inferred :- func sum_lst(list.list(list.list(list.list(int)))) =
    life.m:031:   list.list(list.list(int)).
    life.m:047: Inferred :- func agg_elts(int, int, life.sign) = int.
    life.m:051: Inferred :- func hor(list.list(list.list(int)), life.lr) =
    life.m:051:   list.list(list.list(int)).
    life.m:054: Inferred :- func head_det(list.list(T)) = T.
    life.m:060: Inferred :- func gen(T, int) = list.list(T).
    life.m:066: Inferred :- func vert(list.list(list.list(int)), life.ud) =
    life.m:066:   list.list(list.list(int)).
    life.m:070: Inferred :- func zeros(list.list(list.list(T))) = list.list(int).
    life.m:072: Inferred :- func without_first(list.list(T)) = list.list(T).
    life.m:078: Inferred :- func without_last(list.list(T)) = list.list(T).
    life.m:086: Inferred :- func hor_row(list.list(int), life.lr) = list.list(int).
    life.m:093: Inferred :- func neighbours(list.list(list.list(int))) =
    life.m:093:   list.list(list.list(int)).
    life.m:110: Inferred :- func next(list.list(list.list(int))) =
    life.m:110:   list.list(list.list(int)).
    life.m:115: Inferred :- pred print_m(list.list(list.list(int)), io.state,
    life.m:115:   io.state).
    life.m:115: Inferred :- mode print_m(in, di, uo) is det.
    life.m:118: Inferred :- pred print_r(list.list(int), io.state, io.state).
    life.m:118: Inferred :- mode print_r(in, di, uo) is det.
    life.m:121: Inferred :- pred print_el(int, io.state, io.state).
    life.m:121: Inferred :- mode print_el(in, di, uo) is det.
    life.m:123: Inferred :- pred trace(list.list(list.list(int)), int, io.state,
    life.m:123:   io.state).
    life.m:123: Inferred :- mode trace(in, di, di, uo) is det.
    life.m:131: Inferred :- func m1 = list.list(list.list(int)).


    (Без этого ключа все сигнатуры надо указывать в коде).
    Ну и собственно запуск, иллюстрирующий эволюцию глайдера:

    
    D:\stuff\test\mercury>life.exe
    .#........
    ..#.......
    ###.......
    ..........
    ..........
    ..........
    ..........
    ..........
    ..........
    
    ..........
    #.#.......
    .##.......
    .#........
    ..........
    ..........
    ..........
    ..........
    ..........
    
    ..........
    ..#.......
    #.#.......
    .##.......
    ..........
    ..........
    ..........
    ..........
    ..........
    
    ..........
    .#........
    ..##......
    .##.......
    ..........
    ..........
    ..........
    ..........
    ..........
    
    ..........
    ..#.......
    ...#......
    .###......
    ..........
    ..........
    ..........
    ..........
    ..........
    
    ..........
    ..........
    .#.#......
    ..##......
    ..#.......
    ..........
    ..........
    ..........
    ..........
    
    ..........
    ..........
    ...#......
    .#.#......
    ..##......
    ..........
    ..........
    ..........
    ..........
    
    ..........
    ..........
    ..#.......
    ...##.....
    ..##......
    ..........
    ..........
    ..........
    ..........
    
    ..........
    ..........
    ...#......
    ....#.....
    ..###.....
    ..........
    ..........
    ..........
    ..........
    
    ..........
    ..........
    ..........
    ..#.#.....
    ...##.....
    ...#......
    ..........
    ..........
    ..........
    
    ..........
    ..........
    ..........
    ....#.....
    ..#.#.....
    ...##.....
    ..........
    ..........
    ..........
    
    ..........
    ..........
    ..........
    ...#......
    ....##....
    ...##.....
    ..........
    ..........
    ..........
    
    ..........
    ..........
    ..........
    ....#.....
    .....#....
    ...###....
    ..........
    ..........
    ..........
    
    ..........
    ..........
    ..........
    ..........
    ...#.#....
    ....##....
    ....#.....
    ..........
    ..........
    
    ..........
    ..........
    ..........
    ..........
    .....#....
    ...#.#....
    ....##....
    ..........
    ..........
    
    ..........
    ..........
    ..........
    ..........
    ....#.....
    .....##...
    ....##....
    ..........
    ..........
    
    ..........
    ..........
    ..........
    ..........
    .....#....
    ......#...
    ....###...
    ..........
    ..........
    
    ..........
    ..........
    ..........
    ..........
    ..........
    ....#.#...
    .....##...
    .....#....
    ..........
    
    ..........
    ..........
    ..........
    ..........
    ..........
    ......#...
    ....#.#...
    .....##...
    ..........
    
    ..........
    ..........
    ..........
    ..........
    ..........
    .....#....
    ......##..
    .....##...
    ..........
    
    ..........
    ..........
    ..........
    ..........
    ..........
    ......#...
    .......#..
    .....###..
    ..........
    
    ..........
    ..........
    ..........
    ..........
    ..........
    ..........
    .....#.#..
    ......##..
    ......#...
    
    ..........
    ..........
    ..........
    ..........
    ..........
    ..........
    .......#..
    .....#.#..
    ......##..
    
    ..........
    ..........
    ..........
    ..........
    ..........
    ..........
    ......#...
    .......##.
    ......##..
    
    ..........
    ..........
    ..........
    ..........
    ..........
    ..........
    .......#..
    ........#.
    ......###.
    


    Пожалуй, на сегодня всё.

    Еще несколько ссылок:
    1. Windows дистрибутив языка mercury доступен здесь: code.google.com/p/winmercury
    2. Еще пару примеров на этом ЯП: langexplr.blogspot.com/search/label/mercury
    3. Освежить представление о Prolog: 1, 2
    4. Еще пару one-liner'ов игры жизнь на k и q (потомки APL, kx.com): k, q

    Похожие публикации

    Средняя зарплата в IT

    113 000 ₽/мес.
    Средняя зарплата по всем IT-специализациям на основании 5 444 анкет, за 2-ое пол. 2020 года Узнать свою зарплату
    AdBlock похитил этот баннер, но баннеры не зубы — отрастут

    Подробнее
    Реклама

    Комментарии 12

      +5
      Сделайте обзорную статью о этом языке, пожалуйста.
        0
        ок, сделаю как-нибудь
        0
        Насколько я знаю, в Mercury есть линейные типы. Этот самый World наверное имеет линейный тип? И правила такие же, наверное, как в линейной логике (предположение линейного типа можно использовать один раз).

        И еще такой вопрос: в статье на википедии написано, что Mercury сочетает логическое программирование с функциональным. Предполагаю, что, например, алгоритм проверки типов на нем реализовывать — сплошное удовольствие. Это так?
          0
          Это так?

          Могу только сказать, что компилятор меркури написан на нём самом. А самая первая версия писалась на prolog.
            0
            Но вы ведь уже использовали линейные типы? Что думаете на этот счет? Мне кажется, что линейные типы просто офигенны. Ну точнее, мне совсем не это кажется (и не кажется вовсе), но хабр не располагает к таким дискуссиям.

            Можете посмотреть по ссылке ниже, что можно сделать с помощью линейных типов:

            sourceforge.net/mailarchive/forum.php?thread_name=AANLkTinQPh5M-APbeWT1%3D2ebFiL0Kprd2sgkChtZwiiV%40mail.gmail.com&forum_name=ats-lang-users

            В Mercury должно быть то же самое, только вот для вычисления используется, как я понимаю, поиск (даны предикаты/judgements, ищем доказательство/derivation) вместо подстановки. Так вот, есть подозрение, что линейные типы — хорошая, «правильная» штука. Надо, конечно, побольше конструктивных свидетельств этому подготовить, и глядишь, в следующем Mainstream PL будут линейные типы.
          +7
          Жизнь на Меркурии? Фантастика!
          0
          Язык можно спутать с Эрлангом.
            0
            Erlang разрабатывался с оглядкой на Prolog и во многом унаследовал его синтаксис.
            0
            Оффтоп: Вот это листинги!!! А кто-то боится шаблонов в С++… :)
              0
              imo, шаблоны C++ таки страшнее =)
              0
              Немного причесал и укоротил, используя встроенные предикаты/функции:

              :- module life.
              
              :- interface.
              
              :- import_module io.
              
              :- pred main(io, io).
              :- mode main(di, uo) is det.
              
              :- implementation.
              
              :- import_module int, list, require.
              
              :- type row == list(int).
              :- type grid == list(row).
              :- type sign ---> sum_; mul_; or_.
              
              :- type lr ---> left; right; no.
              :- type ud ---> up; down; no.
              
              eq(M, N) = map(map(func(E)=(E=N->1;0)),M).
              
              sum(M1, M2) = agg(sum_, M1, M2).
              or(M1, M2) = agg(or_, M1, M2).
              mul(M1, M2) = agg(mul_, M1, M2).
              
              sum_lst(L) = foldl(sum, det_tail(L), det_head(L)).
              
              agg(Sign, M1, M2) = map_corresponding(map_corresponding(agg_elts(Sign)),M1,M2).
              
              agg_elts(sum_, E1, E2) = E1 + E2. 
              agg_elts(mul_, E1, E2) = E1 * E2. 
              agg_elts(or_, E1, E2) = E1 \/ E2. 
              
              hor(M, LR) = map(hor_row(LR), M).
              
              gen(T, N) = R :- (
              	N=0 -> R = []
              	;
              	R = [T|gen(T,N-1)]
              	).
              
              vert(M, up) = [zeros(M) | without_last(M)].
              vert(M, down) = det_tail(M) ++ [zeros(M)].
              vert(M, no) = M.
              
              zeros(M) = gen(0, length(det_head(M))).
              
              without_last(L) = R :- det_split_last(L,R,_).
              
              hor_row(left, L) = [0 | without_last(L)].
              hor_row(right, L) = det_tail(L) ++ [0].
              hor_row(no, L) = L.
              
              :- func move(grid, ud, lr) = grid.
              move(M, UD, LR) = hor(vert(M, UD), LR).
              
              neighbours(M) = sum_lst([
              	move(M, up, left),
              	move(M, up, no),
              	move(M, up, right),
              	
              	move(M, no, left),
              	move(M, no, no),
              	move(M, no, right),
              
              	move(M, down, left),
              	move(M, down, no),
              	move(M, down, right)
              	]).
              
              
              %% this is GoL algorithm
              %%
              next(M) = or(eq(MN,3), eq(mul(M,MN),4)) :- MN = neighbours(M).
              
              
              %% grid pretty-print
              %%
              print_m([H|T]) --> print_r(H), nl, print_m(T).
              print_m([]) --> [].
              
              print_r([H | T]) --> print_el(H), print_r(T).
              print_r([]) --> [].
              
              print_el(H) --> print(H=0->".";"#").
              
              trace(M, N) --> (
              	{N = 0} -> []
              	;
              	print_m(M),
              	nl,
              	trace(next(M), N-1)
              	).
              
              m1 = [
              	[0,1,0,0,0,0,0,0,0,0],
              	[0,0,1,0,0,0,0,0,0,0],
              	[1,1,1,0,0,0,0,0,0,0],
              	[0,0,0,0,0,0,0,0,0,0],
              	[0,0,0,0,0,0,0,0,0,0],
              	[0,0,0,0,0,0,0,0,0,0],
              	[0,0,0,0,0,0,0,0,0,0],
              	[0,0,0,0,0,0,0,0,0,0],
              	[0,0,0,0,0,0,0,0,0,0]
              	].
              
              main -->
              	trace(m1,25).
              

              Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.

              Самое читаемое