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.loader ;
   6 IN: vocabs.refresh
   7
   8 : source-modified? ( path -- ? )
   9     dup source-files get at [
  10         dup path>>
  11         dup exists? [
  12             utf8 file-lines crc32 checksum-lines
  13             swap checksum>> = not
  14         ] [
  15             2drop f
  16         ] if
  17     ] [
  18         exists?
  19     ] ?if ;
  20
  21 SYMBOL: changed-vocabs
  22
  23 : changed-vocab ( vocab-name -- )
  24     dup lookup-vocab changed-vocabs get and
  25     [ changed-vocabs get adjoin ] [ drop ] if ;
  26
  27 : mark-unchanged-vocab  ( vocab-name -- )
  28     changed-vocabs get delete ;
  29
  30 : mark-unchanged-vocabs  ( vocab-names -- )
  31     [ mark-unchanged-vocab ] each ;
  32
  33 : changed-vocab? ( vocab-name -- ? )
  34     changed-vocabs get [ in? ] [ drop t ] if* ;
  35
  36 : (to-refresh) ( vocab-name loaded? path -- ? )
  37     [
  38         swap [
  39             swap changed-vocab? [
  40                 source-modified?
  41             ] [ drop f ] if
  42         ] [ 2drop t ] if
  43     ] [ 2drop f ] if* ;
  44
  45 : vocab-source-modified? ( vocab-name -- ? )
  46     [ ]
  47     [ lookup-vocab source-loaded?>> ]
  48     [ vocab-source-path ] tri (to-refresh) ;
  49
  50 : vocab-docs-modified? ( vocab-name -- ? )
  51     [ ]
  52     [ lookup-vocab docs-loaded?>> ]
  53     [ vocab-docs-path ] tri (to-refresh) ;
  54
  55 : to-refresh ( prefix -- modified-sources modified-docs unchanged )
  56     loaded-child-vocab-names [ ".private" tail? ] reject
  57     [
  58         [ [ vocab-source-modified? ] filter ]
  59         [ [ vocab-docs-modified? ] filter ] bi
  60     ] [
  61         [ 2dup append ] dip swap diff
  62     ] bi ;
  63
  64 : do-refresh ( modified-sources modified-docs unchanged -- )
  65     mark-unchanged-vocabs
  66     [
  67         [ [ lookup-vocab f >>source-loaded? drop ] each ]
  68         [ [ lookup-vocab f >>docs-loaded? drop ] each ] bi*
  69     ] [
  70         union
  71         [ mark-unchanged-vocabs ]
  72         [ require-all ] bi
  73     ] 2bi ;
  74
  75 : refresh ( prefix -- ) to-refresh do-refresh ;
  76
  77 : refresh-all ( -- ) "" refresh ;