2010-03-29 20:40:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008, 2010 Slava Pestov.
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-14 20:03:07 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: kernel accessors ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: boxes
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-15 01:03:21 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								TUPLE: box value occupied ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-04-13 16:06:09 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: <box> ( -- box ) box new ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-14 20:03:07 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								ERROR: box-full box ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: >box ( value box -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-15 01:03:21 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup occupied>>
							 | 
						
					
						
							
								
									
										
										
										
											2010-05-05 16:52:54 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ box-full ] [ t >>occupied value<< ] if ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-14 20:03:07 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								ERROR: box-empty box ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2010-03-29 20:40:17 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: check-box ( box -- box )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    dup occupied>> [ box-empty ] unless ; inline
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: box> ( box -- value )
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-01 20:05:32 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    check-box [ f ] change-value f >>occupied drop ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-19 15:38:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: ?box ( box -- value/f ? )
							 | 
						
					
						
							
								
									
										
										
										
											2010-04-01 20:05:32 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    dup occupied>> [ box> t ] [ drop f f ] if ; inline
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-29 20:10:30 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: if-box? ( box quot -- )
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-29 14:21:40 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ ?box ] dip [ drop ] if ; inline
							 |