79 lines
		
	
	
		
			2.0 KiB
		
	
	
	
		
			Factor
		
	
	
			
		
		
	
	
			79 lines
		
	
	
		
			2.0 KiB
		
	
	
	
		
			Factor
		
	
	
| ! Copyright (C) 2007, 2009 Slava Pestov.
 | |
| ! See http://factorcode.org/license.txt for BSD license.
 | |
| USING: arrays definitions generic assocs kernel math namespaces
 | |
| sequences strings vectors words quotations io io.files
 | |
| io.pathnames combinators sorting splitting math.parser effects
 | |
| continuations checksums checksums.crc32 vocabs hashtables
 | |
| compiler.units io.encodings.utf8 accessors source-files.errors ;
 | |
| IN: source-files
 | |
| 
 | |
| SYMBOL: source-files
 | |
| 
 | |
| TUPLE: source-file
 | |
| path
 | |
| top-level-form
 | |
| checksum
 | |
| definitions ;
 | |
| 
 | |
| : 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
 |