2008-01-01 14:54:14 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2004, 2008 Slava Pestov.
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: kernel namespaces arrays sequences io inference.backend
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-01 14:54:14 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								inference.state generator debugger math.parser prettyprint words
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-09 04:52:08 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								compiler.units continuations vocabs assocs alien.compiler dlists
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-01 14:54:14 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								optimizer definitions math compiler.errors threads graphs
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-24 03:19:38 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								generic inference ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: compiler
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-01 14:54:14 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: ripple-up ( word -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-12 04:25:16 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    compiled-usage [ drop queue-compile ] assoc-each ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-19 20:55:40 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: save-effect ( word effect -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-01 14:54:14 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    over "compiled-uses" word-prop [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        2dup swap "compiled-effect" word-prop =
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ over ripple-up ] unless
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] when
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-19 20:55:40 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    "compiled-effect" set-word-prop ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-01 14:54:14 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: finish-compile ( word effect dependencies -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-09 04:52:08 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    >r dupd save-effect r>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    over compiled-unxref
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-04 20:38:31 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    over crossref? [ compiled-xref ] [ 2drop ] if ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-01 14:54:14 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: compile-succeeded ( word -- effect dependencies )
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-24 21:41:46 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-13 00:27:05 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        [ word-dataflow optimize ] keep dup generate
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-01 14:54:14 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ] computing-dependencies ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: compile-failed ( word error -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    f pick compiled get set-at
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    swap compiler-error ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: (compile) ( word -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-16 01:54:54 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    f over compiler-error
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-01 14:54:14 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ dup compile-succeeded finish-compile ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ dupd compile-failed f save-effect ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    recover ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-24 21:41:46 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: compile-loop ( assoc -- )
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-30 16:09:21 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    dup assoc-empty? [ drop ] [
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-26 22:47:52 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        dup delete-any drop (compile)
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-30 16:09:21 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        yield
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        compile-loop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] if ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-17 16:29:54 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-24 03:19:38 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: decompile ( word -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    f 2array 1array t modify-code-heap ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: optimized-recompile-hook ( words -- alist )
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-17 16:29:54 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-24 21:41:46 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        H{ } clone compile-queue set
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        H{ } clone compiled set
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-25 04:38:37 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        [ queue-compile ] each
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-24 21:41:46 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        compile-queue get compile-loop
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-17 19:38:29 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        compiled get >alist
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-24 03:19:38 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ] with-scope ;
							 | 
						
					
						
							
								
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2007-12-27 17:26:39 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: recompile-all ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-24 03:19:38 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    forget-errors all-words compile ;
							 |