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