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

79 lines
2.0 KiB
Factor
Raw Normal View History

! Copyright (C) 2007, 2009 Slava Pestov.
2007-09-20 18:09:08 -04:00
! See http://factorcode.org/license.txt for BSD license.
2013-03-05 13:34:47 -05:00
USING: accessors arrays assocs checksums checksums.crc32
compiler.units continuations definitions io.encodings.utf8
io.files io.pathnames kernel namespaces sequences
source-files.errors strings words ;
2007-09-20 18:09:08 -04:00
IN: source-files
SYMBOL: source-files
TUPLE: source-file
path
top-level-form
checksum
definitions
main ;
: record-top-level-form ( quot file -- )
top-level-form<<
[ ] [ H{ } notify-definition-observers ] if-bootstrapping ;
2007-09-20 18:09:08 -04:00
2008-01-09 21:13:59 -05:00
: record-checksum ( lines source-file -- )
[ crc32 checksum-lines ] dip checksum<< ;
2007-09-20 18:09:08 -04:00
: record-definitions ( file -- )
2008-08-30 13:34:37 -04:00
new-definitions get >>definitions drop ;
2007-09-20 18:09:08 -04:00
: <source-file> ( path -- source-file )
\ source-file new
swap >>path
<definitions> >>definitions ;
2007-09-20 18:09:08 -04:00
2008-08-30 13:34:37 -04:00
ERROR: invalid-source-file-path path ;
2007-09-20 18:09:08 -04:00
: source-file ( path -- source-file )
2008-08-30 13:34:37 -04:00
dup string? [ invalid-source-file-path ] unless
2007-09-20 18:09:08 -04:00
source-files get [ <source-file> ] cache ;
: reset-checksums ( -- )
source-files get [
swap dup exists? [
utf8 file-lines swap record-checksum
2008-03-03 17:44:24 -05:00
] [ 2drop ] if
2007-09-20 18:09:08 -04:00
] assoc-each ;
M: pathname where string>> 1 2array ;
2007-09-20 18:09:08 -04:00
2008-01-09 19:13:26 -05:00
: forget-source ( path -- )
source-files get delete-at*
[ definitions>> [ keys forget-all ] each ] [ drop ] if ;
2007-09-20 18:09:08 -04:00
2008-01-09 19:13:26 -05:00
M: pathname forget*
string>> forget-source ;
2008-03-11 20:51:58 -04:00
: rollback-source-file ( file -- )
2008-08-30 13:34:37 -04:00
[
new-definitions get [ assoc-union ] 2map
] change-definitions drop ;
SYMBOL: file
: wrap-source-file-error ( error -- * )
file get rollback-source-file
2008-06-25 04:25:08 -04:00
\ source-file-error new
f >>line#
file get path>> >>file
swap >>error rethrow ;
2008-06-25 04:25:08 -04:00
: with-source-file ( name quot -- )
#! Should be called from inside with-compilation-unit.
[
2008-06-25 04:25:08 -04:00
[
source-file
[ file set ]
[ definitions>> old-definitions set ] bi
] dip
[ wrap-source-file-error ] recover
] with-scope ; inline