basis/vocabs/refresh/refresh.factor

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