basis/compiler/cfg/parallel-copy/parallel-copy.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs compiler.cfg.hats compiler.cfg.instructions
   4 deques dlists fry kernel locals namespaces sequences
   5 sets hashtables ;
   6 IN: compiler.cfg.parallel-copy
   7
   8 SYMBOLS: mapping dependency-graph work-list ;
   9
  10 : build-dependency-graph ( mapping -- deps )
  11     H{ } clone [ '[ _ conjoin-at ] assoc-each ] keep ;
  12
  13 : build-work-list ( mapping graph -- work-list )
  14     [ keys ] dip '[ _ key? not ] filter <dlist> [ push-all-front ] keep ;
  15
  16 : init ( mapping -- work-list )
  17     dup build-dependency-graph
  18     [ [ >hashtable mapping set ] [ dependency-graph set ] bi* ]
  19     [ build-work-list dup work-list set ]
  20     2bi ;
  21
  22 :: retire-copy ( dst src -- )
  23     dst mapping get delete-at
  24     src dependency-graph get at :> deps
  25     dst deps delete-at
  26     deps assoc-empty? [
  27         src mapping get key? [
  28             src work-list get push-front
  29         ] when
  30     ] when ;
  31
  32 : perform-copy ( dst -- )
  33     dup mapping get at
  34     [ ##copy ] [ retire-copy ] 2bi ;
  35
  36 : break-cycle ( dst src -- dst src' )
  37     [ i dup ] dip ##copy ;
  38
  39 : break-cycles ( mapping -- )
  40     >alist [ break-cycle ] { } assoc-map-as [ ##copy ] assoc-each ;
  41
  42 : parallel-copy ( mapping -- )
  43     [
  44         init [ perform-copy ] slurp-deque
  45         mapping get dup assoc-empty? [ drop ] [ break-cycles ] if
  46     ] with-scope ;