basis/vocabs/refresh/refresh.factor

   1 ! Copyright (C) 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs checksums checksums.crc32
   4 combinators.short-circuit io.encodings.utf8 io.files kernel
   5 namespaces sequences sets source-files vocabs vocabs.errors
   6 vocabs.loader ;
   7 FROM: namespaces => set ;
   8 IN: vocabs.refresh
   9
  10 : source-modified? ( path -- ? )
  11     dup source-files get at [
  12         dup path>>
  13         dup exists? [
  14             utf8 file-lines crc32 checksum-lines
  15             swap checksum>> = not
  16         ] [
  17             2drop f
  18         ] if
  19     ] [
  20         exists?
  21     ] ?if ;
  22
  23 SYMBOL: changed-vocabs
  24
  25 : changed-vocab ( vocab -- )
  26     dup lookup-vocab changed-vocabs get and
  27     [ dup changed-vocabs get set-at ] [ drop ] if ;
  28
  29 : mark-unchanged-vocab  ( vocab-name -- )
  30     changed-vocabs get delete-at ;
  31
  32 : mark-unchanged-vocabs  ( vocab-names -- )
  33     [ mark-unchanged-vocab ] each ;
  34
  35 : changed-vocab-by-name? ( vocab -- ? )
  36     changed-vocabs get [ key? ] [ drop t ] if* ;
  37
  38 : (to-refresh) ( vocab-name loaded? path -- ? )
  39     [
  40         swap [
  41             swap changed-vocab-by-name? [
  42                 source-modified?
  43             ] [ drop f ] if
  44         ] [ 2drop t ] if
  45     ] [ 2drop f ] if* ;
  46
  47 : vocab-source-modified? ( vocab-name -- ? )
  48     [ ]
  49     [ lookup-vocab source-loaded?>> ]
  50     [ vocab-source-path ] tri (to-refresh) ;
  51
  52 : vocab-docs-modified? ( vocab-name -- ? )
  53     [ ]
  54     [ lookup-vocab docs-loaded?>> ]
  55     [ vocab-docs-path ] tri (to-refresh) ;
  56
  57 : to-refresh ( prefix -- modified-sources modified-docs unchanged )
  58     loaded-child-vocab-names [ ".private" tail? ] reject
  59     [
  60         [ [ vocab-source-modified? ] filter ]
  61         [ [ vocab-docs-modified? ] filter ] bi
  62     ] [
  63         [ 2dup append ] dip swap diff
  64     ] bi ;
  65
  66 : do-refresh ( modified-sources modified-docs unchanged -- )
  67     mark-unchanged-vocabs
  68     [
  69         [ [ lookup-vocab f >>source-loaded? drop ] each ]
  70         [ [ lookup-vocab f >>docs-loaded? drop ] each ] bi*
  71     ]
  72     [
  73         union
  74         [ mark-unchanged-vocabs ]
  75         [ require-all load-failures. ] bi
  76     ] 2bi ;
  77
  78
  79 : refresh ( prefix -- ) to-refresh do-refresh ;
  80
  81 : refresh-all ( -- ) "" refresh ;