/core/source-files/source-files.factor
http://github.com/abeaumont/factor · Factor · 78 lines · 60 code · 16 blank · 2 comment · 4 complexity · 1055ffa8446a6ed887bbe01892fcb92a MD5 · raw file
- ! Copyright (C) 2007, 2009 Slava Pestov.
- ! See http://factorcode.org/license.txt for BSD license.
- 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 ;
- 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 ;
- : record-checksum ( lines source-file -- )
- [ crc32 checksum-lines ] dip checksum<< ;
- : record-definitions ( file -- )
- new-definitions get >>definitions drop ;
- : <source-file> ( path -- source-file )
- \ source-file new
- swap >>path
- <definitions> >>definitions ;
- ERROR: invalid-source-file-path path ;
- : source-file ( path -- source-file )
- dup string? [ invalid-source-file-path ] unless
- source-files get [ <source-file> ] cache ;
- : reset-checksums ( -- )
- source-files get [
- swap dup exists? [
- utf8 file-lines swap record-checksum
- ] [ 2drop ] if
- ] assoc-each ;
- M: pathname where string>> 1 2array ;
- : forget-source ( path -- )
- source-files get delete-at*
- [ definitions>> [ keys forget-all ] each ] [ drop ] if ;
- M: pathname forget*
- string>> forget-source ;
- : rollback-source-file ( file -- )
- [
- new-definitions get [ assoc-union ] 2map
- ] change-definitions drop ;
- SYMBOL: file
- : wrap-source-file-error ( error -- * )
- file get rollback-source-file
- \ source-file-error new
- f >>line#
- file get path>> >>file
- swap >>error rethrow ;
- : with-source-file ( name quot -- )
- #! Should be called from inside with-compilation-unit.
- [
- [
- source-file
- [ file set ]
- [ definitions>> old-definitions set ] bi
- ] dip
- [ wrap-source-file-error ] recover
- ] with-scope ; inline