core/source-files/source-files.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays definitions generic assocs kernel math namespaces
   4 sequences strings vectors words quotations io io.files
   5 io.pathnames combinators sorting splitting math.parser effects
   6 continuations checksums checksums.crc32 vocabs hashtables graphs
   7 compiler.units io.encodings.utf8 accessors ;
   8 IN: source-files
   9
  10 SYMBOL: source-files
  11
  12 TUPLE: source-file
  13 path
  14 checksum
  15 uses definitions ;
  16
  17 : record-checksum ( lines source-file -- )
  18     [ crc32 checksum-lines ] dip (>>checksum) ;
  19
  20 : (xref-source) ( source-file -- pathname uses )
  21     [ path>> <pathname> ]
  22     [ uses>> [ crossref? ] filter ] bi ;
  23
  24 : xref-source ( source-file -- )
  25     (xref-source) crossref get add-vertex ;
  26
  27 : unxref-source ( source-file -- )
  28     (xref-source) crossref get remove-vertex ;
  29
  30 : xref-sources ( -- )
  31     source-files get [ nip xref-source ] assoc-each ;
  32
  33 : record-form ( quot source-file -- )
  34     tuck unxref-source
  35     quot-uses keys >>uses
  36     xref-source ;
  37
  38 : record-definitions ( file -- )
  39     new-definitions get >>definitions drop ;
  40
  41 : <source-file> ( path -- source-file )
  42     \ source-file new
  43         swap >>path
  44         <definitions> >>definitions ;
  45
  46 ERROR: invalid-source-file-path path ;
  47
  48 : source-file ( path -- source-file )
  49     dup string? [ invalid-source-file-path ] unless
  50     source-files get [ <source-file> ] cache ;
  51
  52 : reset-checksums ( -- )
  53     source-files get [
  54         swap dup exists? [
  55             utf8 file-lines swap record-checksum
  56         ] [ 2drop ] if
  57     ] assoc-each ;
  58
  59 M: pathname where string>> 1 2array ;
  60
  61 : forget-source ( path -- )
  62     [
  63         source-file
  64         [ unxref-source ]
  65         [ definitions>> [ keys forget-all ] each ]
  66         bi
  67     ]
  68     [ source-files get delete-at ]
  69     bi ;
  70
  71 M: pathname forget*
  72     string>> forget-source ;
  73
  74 : rollback-source-file ( file -- )
  75     [
  76         new-definitions get [ assoc-union ] 2map
  77     ] change-definitions drop ;
  78
  79 SYMBOL: file
  80
  81 TUPLE: source-file-error error file ;
  82
  83 : <source-file-error> ( msg -- error )
  84     \ source-file-error new
  85         file get >>file
  86         swap >>error ;
  87
  88 : with-source-file ( name quot -- )
  89     #! Should be called from inside with-compilation-unit.
  90     [
  91         swap source-file
  92         dup file set
  93         definitions>> old-definitions set
  94         [
  95             file get rollback-source-file
  96             <source-file-error> rethrow
  97         ] recover
  98     ] with-scope ; inline