| 
									
										
										
										
											2009-02-06 05:38:31 -05:00
										 |  |  | ! Copyright (C) 2009 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: alien.structs alien.c-types math math.functions sequences | 
					
						
							|  |  |  | arrays kernel functors vocabs.parser namespaces accessors | 
					
						
							|  |  |  | quotations ;
 | 
					
						
							|  |  |  | IN: alien.complex.functor | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | FUNCTOR: define-complex-type ( N T -- )
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | T-real DEFINES ${T}-real | 
					
						
							|  |  |  | T-imaginary DEFINES ${T}-imaginary | 
					
						
							|  |  |  | set-T-real DEFINES set-${T}-real | 
					
						
							|  |  |  | set-T-imaginary DEFINES set-${T}-imaginary | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-02-06 20:05:56 -05:00
										 |  |  | <T> DEFINES <${T}> | 
					
						
							|  |  |  | *T DEFINES *${T} | 
					
						
							| 
									
										
										
										
											2009-02-06 05:38:31 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | WHERE | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-02-06 20:05:56 -05:00
										 |  |  | : <T> ( z -- alien )
 | 
					
						
							| 
									
										
										
										
											2009-02-06 05:38:31 -05:00
										 |  |  |     >rect T <c-object> [ set-T-imaginary ] [ set-T-real ] [ ] tri ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-02-06 20:05:56 -05:00
										 |  |  | : *T ( alien -- z )
 | 
					
						
							| 
									
										
										
										
											2009-02-06 05:38:31 -05:00
										 |  |  |     [ T-real ] [ T-imaginary ] bi rect> ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | T in get
 | 
					
						
							|  |  |  | { { N "real" } { N "imaginary" } } | 
					
						
							|  |  |  | define-struct | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | T c-type | 
					
						
							| 
									
										
										
										
											2009-02-06 20:05:56 -05:00
										 |  |  | <T> 1quotation >>boxer-quot | 
					
						
							|  |  |  | *T 1quotation >>unboxer-quot | 
					
						
							| 
									
										
										
										
											2009-02-06 05:38:31 -05:00
										 |  |  | drop
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-02-06 20:05:56 -05:00
										 |  |  | ;FUNCTOR |