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     [ quot-uses keys ] dip
  35     [ unxref-source ] [ (>>uses) ] [ xref-source ] tri ;
  36
  37 : record-definitions ( file -- )
  38     new-definitions get >>definitions drop ;
  39
  40 : <source-file> ( path -- source-file )
  41     \ source-file new
  42         swap >>path
  43         <definitions> >>definitions ;
  44
  45 ERROR: invalid-source-file-path path ;
  46
  47 : source-file ( path -- source-file )
  48     dup string? [ invalid-source-file-path ] unless
  49     source-files get [ <source-file> ] cache ;
  50
  51 : reset-checksums ( -- )
  52     source-files get [
  53         swap dup exists? [
  54             utf8 file-lines swap record-checksum
  55         ] [ 2drop ] if
  56     ] assoc-each ;
  57
  58 M: pathname where string>> 1 2array ;
  59
  60 : forget-source ( path -- )
  61     [
  62         source-file
  63         [ unxref-source ]
  64         [ definitions>> [ keys forget-all ] each ]
  65         bi
  66     ]
  67     [ source-files get delete-at ]
  68     bi ;
  69
  70 M: pathname forget*
  71     string>> forget-source ;
  72
  73 : rollback-source-file ( file -- )
  74     [
  75         new-definitions get [ assoc-union ] 2map
  76     ] change-definitions drop ;
  77
  78 SYMBOL: file
  79
  80 TUPLE: source-file-error error file ;
  81
  82 : <source-file-error> ( msg -- error )
  83     \ source-file-error new
  84         file get >>file
  85         swap >>error ;
  86
  87 : with-source-file ( name quot -- )
  88     #! Should be called from inside with-compilation-unit.
  89     [
  90         swap source-file
  91         dup file set
  92         definitions>> old-definitions set
  93         [
  94             file get rollback-source-file
  95             <source-file-error> rethrow
  96         ] recover
  97     ] with-scope ; inline