! 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 ;
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 ( contents source-file -- )
    >r crc32 r> 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-contents 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