factor/core/source-files/source-files.factor

! Copyright (C) 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays definitions generic assocs kernel math
namespaces prettyprint sequences strings vectors words
quotations inspector io.styles io combinators sorting
splitting math.parser effects continuations debugger
io.files io.crc32 io.streams.string io.streams.lines vocabs
hashtables graphs compiler.units ;
IN: source-files

SYMBOL: source-files

TUPLE: source-file
path
modified checksum
uses definitions ;

: (source-modified?) ( path modified checksum -- ? )
    pick file-modified rot [ 0 or ] 2apply >
    [ swap file-crc32 number= not ] [ 2drop f ] if ;

: source-modified? ( path -- ? )
    dup source-files get at [
        dup source-file-path ?resource-path
        over source-file-modified
        rot source-file-checksum
        (source-modified?)
    ] [
        ?resource-path exists?
    ] ?if ;

: record-modified ( source-file -- )
    dup source-file-path ?resource-path file-modified
    swap set-source-file-modified ;

: record-checksum ( source-file lines -- )
    lines-crc32 swap set-source-file-checksum ;

: (xref-source) ( source-file -- pathname uses )
    dup source-file-path <pathname> swap source-file-uses
    [ interned? ] subset ;

: xref-source ( source-file -- )
    (xref-source) crossref get add-vertex ;

: unxref-source ( source-file -- )
    (xref-source) crossref get remove-vertex ;

: xref-sources ( -- )
    source-files get [ nip xref-source ] assoc-each ;

: record-form ( quot source-file -- )
    dup unxref-source
    swap quot-uses keys over set-source-file-uses
    xref-source ;

: record-definitions ( file -- )
    new-definitions get swap set-source-file-definitions ;

: <source-file> ( path -- source-file )
    <definitions>
    { set-source-file-path set-source-file-definitions }
    \ source-file construct ;

: source-file ( path -- source-file )
    source-files get [ <source-file> ] cache ;

: reset-checksums ( -- )
    source-files get [
        swap ?resource-path dup exists?
        [ file-lines record-checksum ] [ 2drop ] if
    ] assoc-each ;

M: pathname where pathname-string 1 2array ;

M: pathname forget*
    pathname-string
    dup source-file
    dup unxref-source
    source-file-definitions [ keys forget-all ] each
    source-files get delete-at ;

: forget-source ( path -- )
    [ <pathname> forget ] with-compilation-unit ;

: rollback-source-file ( source-file -- )
    dup source-file-definitions new-definitions get [ union ] 2map
    swap set-source-file-definitions ;

SYMBOL: file

: with-source-file ( name quot -- )
    #! Should be called from inside with-compilation-unit.
    [
        swap source-file
        dup file set
        source-file-definitions old-definitions set
        [ ] [ file get rollback-source-file ] cleanup
    ] with-scope ; inline