| 
									
										
										
										
											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 ;
 |