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 io.encodings.utf8 io.files kernel namespaces sequences sets
   5 source-files vocabs vocabs.errors vocabs.loader ;
   6 FROM: namespaces => set ;
   7 IN: vocabs.refresh
   8
   9 : source-modified? ( path -- ? )
  10     dup source-files get at [
  11         dup path>>
  12         dup exists? [
  13             utf8 file-lines crc32 checksum-lines
  14             swap checksum>> = not
  15         ] [
  16             2drop f
  17         ] if
  18     ] [
  19         exists?
  20     ] ?if ;
  21
  22 SYMBOL: changed-vocabs
  23
  24 : changed-vocab ( vocab -- )
  25     dup lookup-vocab changed-vocabs get and
  26     [ dup changed-vocabs get set-at ] [ drop ] if ;
  27
  28 : unchanged-vocab ( vocab -- )
  29     changed-vocabs get delete-at ;
  30
  31 : unchanged-vocabs ( vocabs -- )
  32     [ unchanged-vocab ] each ;
  33
  34 : changed-vocab? ( vocab -- ? )
  35     changed-vocabs get [ key? ] [ drop t ] if* ;
  36
  37 : filter-changed ( vocabs -- vocabs' )
  38     [ changed-vocab? ] filter ;
  39
  40 SYMBOL: modified-sources
  41 SYMBOL: modified-docs
  42
  43 : (to-refresh) ( vocab variable loaded? path -- )
  44     dup [
  45         swap [
  46             pick changed-vocab? [
  47                 source-modified? [ get push ] [ 2drop ] if
  48             ] [ 3drop ] if
  49         ] [ drop get push ] if
  50     ] [ 4drop ] if ;
  51
  52 : to-refresh ( prefix -- modified-sources modified-docs unchanged )
  53     [
  54         V{ } clone modified-sources set
  55         V{ } clone modified-docs set
  56
  57         child-vocabs [ ".private" tail? ] reject [
  58             [
  59                 [
  60                     [ modified-sources ]
  61                     [ lookup-vocab source-loaded?>> ]
  62                     [ vocab-source-path ]
  63                     tri (to-refresh)
  64                 ] [
  65                     [ modified-docs ]
  66                     [ lookup-vocab docs-loaded?>> ]
  67                     [ vocab-docs-path ]
  68                     tri (to-refresh)
  69                 ] bi
  70             ] each
  71
  72             modified-sources get
  73             modified-docs get
  74         ]
  75         [ modified-docs get modified-sources get append diff ] bi
  76     ] with-scope ;
  77
  78 : do-refresh ( modified-sources modified-docs unchanged -- )
  79     unchanged-vocabs
  80     [
  81         [ [ lookup-vocab f >>source-loaded? drop ] each ]
  82         [ [ lookup-vocab f >>docs-loaded? drop ] each ] bi*
  83     ]
  84     [
  85         union
  86         [ unchanged-vocabs ]
  87         [ require-all load-failures. ] bi
  88     ] 2bi ;
  89
  90 : refresh ( prefix -- ) to-refresh do-refresh ;
  91
  92 : refresh-all ( -- ) "" refresh ;