Pragmatic Perl

Выпуск 12. Февраль 2014

Обход дерева директорий на Perl и Haskell (часть 2)

Напомню, в первой части этой статьи (см. предыдущий номер журнала) мы написали обобщенный обход дерева директорий на языках Perl и Haskell. Он представляет собой функцию dir_walk, которая в качестве аргументов принимает два коллбека — один для файлов, один для директорий — и обходит дерево, вызывая соответствующий коллбек на каждом элементе дерева.

Одним из ограничений написанной нами функции dir_walk является тот факт, что из коллбеков мы не можем остановить обход. Предположим, нам надо узнать, есть ли в дереве файл с данным именем. Если мы нашли файл, нет смысла продолжать обход дальше.

Есть несколько способов решить эту проблему.

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

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

Речь идет о продолжениях (continuations) и CPS (стиль передачи продолжений — continuation-passing style).

CPS знаком каждому, кто использовал IO::Async или похожие библиотеки. Сравните получение ввода в традиционном стиле:

my $line = <>;
print "Got $line";

и в CPS-стиле:

my $stream = IO::Async::Stream->new(
   read_handle  => \*STDIN,
   on_read => sub {
     my ( $self, $buf, $eof ) = @_;
     print "Got $$buf";
     ...
   }
);

В традиционном стиле функции (в нашем случае оператор <>) возвращают значение напрямую. В стиле передачи продолжений функции принимают дополнительный аргумент (в нашем случае — on_read), который представляет собой коллбек. Этот коллбек принимает в качестве аргумента возвращаемое значение функции ($buf) и дальше делает с ним все то, что в традиционном стиле происходило бы после вызова рассматриваемой функции (отсюда его название — продолжение). Обратите внимание, что print вызывается после read в традиционном стиле и внутри on_read в CPS.

Мы только что увидели, как вызывать функцию, написанную в CPS — надо ей передать коллбек (продолжение), которое делает все то, что мы хотели бы сделать с результатом функции после ее завершения. Но как преобразовать саму функцию в CPS? Для этого надо добавить еще один аргумент-коллбек, и вместо return передать возвращаемое значение этому коллбеку. Также, в случае необходимости, само тело функции аналогично можно преобразовать в CPS.

Например, рассмотрим код

sub square($) {
  return $_[0] * $_[0];
}

sub inc($) {
  return $_[0] + 1;
}

print square inc 5;

После преобразование в CPS функции inc получим

sub square($) {
  return $_[0] * $_[0];
}

sub inc($$) {
  $_[1]->($_[0] + 1);
}

inc(5,
  sub { print square $_[0], "\n" }
);

Если применить CPS-преобразование еще и к square, то код будет выглядеть так:

sub square($$) {
  $_[1]->($_[0] * $_[0]);
}

sub inc($$) {
  $_[1]->($_[0] + 1);
}

inc(5,
  sub { square($_[0],
    sub { print $_[0], "\n"; }
  )}
);

Чем же хорошо CPS-преобразование? Тем, что у CPS-функции есть контроль над тем, что будет происходить после ее завершения. Ведь вместо того, чтобы послушно передавать возвращаемое значение продолжению, она может взбунтоваться и не вызывать продолжение вовсе. Именно так мы и реализуем раннее завершение обхода дерева директорий.

Напомню, вот определение функции dir_walk (в традиционном стиле):

# From Higher-Order Perl by Mark Dominus, published by Morgan Kaufmann Publishers
# Copyright 2005 by Elsevier Inc
# LICENSE: http://hop.perl.plover.com/LICENSE.txt

sub dir_walk {
  my ($top, $filefunc, $dirfunc) = @_;
  my $DIR;

  if (-d $top) {
    my $file;
    unless (opendir $DIR, $top) {
      warn "Couldn't open directory $code: $!; skipping.\n";
      return;
    }

    my @results;
    while ($file = readdir $DIR) {
      next if $file eq '.' || $file eq '..';
      push @results, dir_walk("$top/$file", $filefunc, $dirfunc);
    }
    return $dirfunc->($top, @results);
  } else {
    return $filefunc->($top);
  }
}

Итак, давайте применим CPS-преобразование к нашему обходу.

sub dir_walk($$$$) {
  my ($top, $filefunc, $dirfunc, $dir_walk_cb) = @_;

  if (-d $top) {
    my (@results, $DIR);
    if (opendir $DIR, $top) {
      my $while_loop;
      $while_loop = sub {
        my $file = readdir $DIR;
        unless ($file) {
          closedir $DIR;
          $dirfunc->($top, \@results, $dir_walk_cb);
        }
        if ($file eq '.' || $file eq '..') {
          $while_loop->()
        } else {
          dir_walk("$top/$file", $filefunc, $dirfunc,
            sub {
              push @results, @$_[0];
              $while_loop->();
            }
          );
        }
      };

      $while_loop->();

    } else {
      warn "Couldn't open directory $top: $!; skipping.\n";
      $dir_walk_cb->();
    };
  } else {
    $filefunc->($top, $dir_walk_cb);
  }
}

Код стал менее читаемым, и в нескольких местах его пришлось переделать — например, цикл while был преобразован в рекурсивную функцию.

Тем не менее, код работает (кроме случаев, когда он упирается в предел по глубине рекурсии — см. раздел 5.4.1 Tail-Call Elimination книги Higher-Order Perl).

Например, вот аналог find -type f:

dir_walk(
    $ARGV[0],
    sub { print $_[0]; $_[1]->(); },
    sub { $_[2]->(); },
    sub { });

А вот пример программы, которая заканчивает обход досрочно — то, зачем мы и стали преобразовывать код в CPS:

dir_walk(
    '/etc',
    sub { if ($_[0] =~ /\.conf$/) { print $_[0]; } else { $_[1]->(); } },
    sub { $_[2]->(); },
    sub { });

Этот код находит в иерархии /etc первый файл с расширением conf, печатает его имя, и на этом завершается. Так происходит из-за того, что передаваемый коллбек не вызывает свое продолжение, когда имя файла удовлетворяет регулярному выражению.

Теперь перейдем к Haskell. Там тоже можно сделать аналогичное CPS-преобразование вручную, но можно поступить и лучше. Как писалось выше, при CPS-преобразовании к каждой функции добавляется еще один аргумент — продолжение ($dir_walk_cb в нашем коде на Perl). В силу эффекта, который называется каррированием (см. раздел 7.1 Currying в Higher-Order Perl), это равносильно тому, что функция возвращает другую функцию. Эта вторая функция принимает в качестве своего единственного аргумента продолжение и возвращает конечный результат. Мы можем определить новый тип

newtype Cont r a = Cont ((a -> r) -> r)

Тогда функция, до CPS-преобразования возвращавшая a, в CPS будет возвращать Cont r a, где r — это тип результата всей программы.

Красота этого подхода заключается в том, что после определенных объявлений мы можем интерпретировать Cont r a как тип действий, возвращающих результат типа a. (Читателю рекомендуется обратится к первой части статьи, чтобы вспомнить, что такое действия и как с ними работать.)

Точно так же, как IO a — тип действий, которые могут, помимо обычных вычислений, производить ввод-вывод и другое взаимодействие с внешним миром, Cont r a — тип действий, у которых есть доступ к собственному продолжению. Иными словами, функции, которые возвращают Cont r a, уже преобразованы в CPS.

Вместо того, чтобы использовать свой собственный тип Cont, мы воспользуемся готовыми определениями из модуля Control.Monad.Cont библиотеки mtl. Однако подчеркнем, что это не специальная «магия», встроенная в компилятор Haskell, а обычная библиотека, аналог который мы могли бы написать и сами. Некоторые другие языки (например, Scheme), напротив, имеют встроенную поддержку продолжений.

Вот как выглядит CPS-версия функции dir_walk на Haskell:

import System.FilePath
import System.Directory
import Control.Monad.Cont

dir_walk
  :: FilePath
  -> (FilePath -> ContT r IO a)
  -> (FilePath -> [a] -> ContT r IO a)
  -> ContT r IO a
dir_walk top filefunc dirfunc = do
  isDirectory <- liftIO $ doesDirectoryExist top

  if isDirectory
    then do
      files <- liftIO $ getDirectoryContents top
      let nonDotFiles = filter (not . (`elem` [".", ".."])) files
      results <- mapM (\file -> dir_walk (top </> file) filefunc dirfunc) nonDotFiles
      dirfunc top results
    else
      filefunc top

В отличие от Perl-версии, изменения здесь настолько минимальны, что я не могу удержаться и не показать diff классической и CPS-версий:

--- dirwalk.hs  2014-02-02 17:30:35.260611983 +0200
+++ dirwalk-cps.hs  2014-02-02 17:32:00.820418259 +0200
@@ -1,17 +1,18 @@
 import System.FilePath
 import System.Directory
+import Control.Monad.Cont
 
 dir_walk
   :: FilePath
-  -> (FilePath -> IO a)
-  -> (FilePath -> [a] -> IO a)
-  -> IO a
+  -> (FilePath -> ContT r IO a)
+  -> (FilePath -> [a] -> ContT r IO a)
+  -> ContT r IO a
 dir_walk top filefunc dirfunc = do
-  isDirectory <- doesDirectoryExist top
+  isDirectory <- liftIO $ doesDirectoryExist top
 
   if isDirectory
     then do
-      files <- getDirectoryContents top
+      files <- liftIO $ getDirectoryContents top
       let nonDotFiles = filter (not . (`elem` [".", ".."])) files
       results <- mapM (\file -> dir_walk (top </> file) filefunc dirfunc) nonDotFiles
       dirfunc top results

Изменения сводятся к замене типов вида IO a на ContT r IO a и использованию liftIO для преобразования IO-действий в Cont-действия.

Поиск в /etc conf-файла с ранним завершением будет выглядеть так:

import Control.Monad.Cont
import Data.List (isSuffixOf)

main = runContT walk (\result -> return ())
  where
    walk = dir_walk
      "/etc"
      (\file -> ContT $ \k -> if ".conf" `isSuffixOf` file
          then putStrLn file
          else k ())
      (\dir results -> return ())

Если к этому моменту у вас все еще остались сомнения по поводу того, что такое продолжения и как они работают, рекомендую еще посмотреть раздел 8.8.1 книги Higher-Order Perl.

Другим интересным подходом к проблеме обхода дерева, тесно перекликающимся с предыдущим, являются итераторы. Ни в Perl, ни в Haskell встроенной поддержки итераторов нет, хотя она есть во многих других языках — например, в Python.

Тем не менее, и в Perl, и в Haskell итераторы можно реализовать. Про итераторы на Perl можно почитать в главе 4 Higher-Order Perl. В частности, в разделе 4.2.2 приводится реализация dir_walk с помощью итераторов. Реализация итераторов на Perl использует изменяемые переменные в замыканиях — не очень функционально, но что поделаешь.

На Haskell итераторы можно реализовать без использования изменяемых переменных (хотя, конечно, можно и с ними). Заинтересованному читателю рекомендуется попробовать реализовать обход дерева с использованием библиотеки pipes (и, в частности, функции yield).

Совсем храбрые и заинтересованные читатели могут обратиться к трудам Олега Киселёва о продолжениях и итераторах (генераторах).

Заключение

Надеюсь, понятно, что эта статья — не о том, как обходить дерево директорий в практических программах (иронично, учитывая название журнала). Тем не менее, какие-то идеи, изложенные здесь, могут когда-нибудь пригодиться и в реальных задачах.

Скорее, моей целью было показать, что даже если вы знаете регулярные выражения и имеете опыт использования 30 модулей с CPAN, вам есть еще чему учиться и куда развиваться в программировании. Если статья подстегнет кого-то к изучению Haskell или к прочтению Higher-Order Perl, она писалась не зря.

■ Роман Чепляка