| 
									
										
										
										
											2009-03-22 19:00:26 -04:00
										 |  |  | ! Copyright (C) 2008, 2009 Slava Pestov. | 
					
						
							| 
									
										
										
										
											2008-06-25 04:25:08 -04:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2009-03-22 19:00:26 -04:00
										 |  |  | USING: parser kernel words generic namespaces effects.parser ;
 | 
					
						
							| 
									
										
										
										
											2008-06-25 04:25:08 -04:00
										 |  |  | IN: generic.parser | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | ERROR: not-in-a-method-error ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : CREATE-GENERIC ( -- word ) CREATE dup reset-word ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-03-22 19:00:26 -04:00
										 |  |  | : (GENERIC:) ( quot -- )
 | 
					
						
							|  |  |  |     [ CREATE-GENERIC ] dip call complete-effect define-generic ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-06-25 04:25:08 -04:00
										 |  |  | : create-method-in ( class generic -- method )
 | 
					
						
							| 
									
										
										
										
											2008-11-06 14:13:37 -05:00
										 |  |  |     create-method dup set-word dup save-location ;
 | 
					
						
							| 
									
										
										
										
											2008-06-25 04:25:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-11-01 23:10:28 -05:00
										 |  |  | : define-inline-method ( class generic quot -- )
 | 
					
						
							|  |  |  |     [ create-method-in ] dip [ define ] [ drop make-inline ] 2bi ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-06-25 04:25:08 -04:00
										 |  |  | : CREATE-METHOD ( -- method )
 | 
					
						
							|  |  |  |     scan-word bootstrap-word scan-word create-method-in ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-22 20:57:25 -05:00
										 |  |  | SYMBOL: current-method | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : with-method-definition ( method quot -- )
 | 
					
						
							| 
									
										
										
										
											2008-11-24 17:28:35 -05:00
										 |  |  |     over current-method set call current-method off ; inline
 | 
					
						
							| 
									
										
										
										
											2008-06-25 04:25:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-03-16 07:17:18 -04:00
										 |  |  | : (M:) ( -- method def )
 | 
					
						
							| 
									
										
										
										
											2008-06-25 04:25:08 -04:00
										 |  |  |     CREATE-METHOD [ parse-definition ] with-method-definition ;
 | 
					
						
							|  |  |  | 
 |