| 
									
										
										
										
											2014-01-31 11:00:26 -05:00
										 |  |  | USING: accessors arrays combinators effects effects.parser fry generalizations | 
					
						
							| 
									
										
										
										
											2014-01-31 09:59:04 -05:00
										 |  |  | kernel lexer math namespaces parser python python.ffi python.objects sequences | 
					
						
							| 
									
										
										
										
											2014-01-28 13:45:31 -05:00
										 |  |  | sequences.generalizations vocabs.parser words ;
 | 
					
						
							| 
									
										
										
										
											2014-01-28 13:19:57 -05:00
										 |  |  | IN: python.syntax | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-31 06:18:12 -05:00
										 |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-29 12:19:07 -05:00
										 |  |  | SYMBOL: current-context | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : with-each-definition ( quot -- )
 | 
					
						
							|  |  |  |     scan-token dup ";" = [ 2drop ] [ | 
					
						
							|  |  |  |         scan-effect rot [ call( tok eff -- ) ] keep with-each-definition | 
					
						
							| 
									
										
										
										
											2014-01-28 13:19:57 -05:00
										 |  |  |     ] if ; inline recursive
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-29 12:19:07 -05:00
										 |  |  | : scan-definitions ( quot -- )
 | 
					
						
							|  |  |  |     scan-token current-context set "=>" expect with-each-definition ; inline
 | 
					
						
							| 
									
										
										
										
											2014-01-28 18:31:43 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-31 11:00:26 -05:00
										 |  |  | : gather-args-quot ( in-effect -- quot )
 | 
					
						
							|  |  |  |     dup ?last "**" = [ | 
					
						
							|  |  |  |         but-last length '[ [ _ narray array>py-tuple ] dip ] | 
					
						
							|  |  |  |     ] [ | 
					
						
							|  |  |  |         length '[ _ narray array>py-tuple f ] | 
					
						
							|  |  |  |     ] if ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : unpack-value-quot ( out-effect -- quot )
 | 
					
						
							|  |  |  |     length { | 
					
						
							|  |  |  |         { 0 [ [ drop ] ] } | 
					
						
							|  |  |  |         { 1 [ [ ] ] } | 
					
						
							|  |  |  |         [ '[ py-tuple>array _ firstn ] ] | 
					
						
							|  |  |  |     } case ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : make-function-quot ( alien effect -- quot )
 | 
					
						
							|  |  |  |     [ in>> gather-args-quot ] [ out>> unpack-value-quot ] bi
 | 
					
						
							|  |  |  |     swapd '[ @ _ -rot call-object-full @ ] ;
 | 
					
						
							| 
									
										
										
										
											2014-01-28 18:31:43 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-29 12:19:07 -05:00
										 |  |  | : function-callable ( name alien effect -- )
 | 
					
						
							| 
									
										
										
										
											2014-01-31 11:00:26 -05:00
										 |  |  |     [ create-in ] 2dip [ make-function-quot ] keep define-inline ; inline
 | 
					
						
							| 
									
										
										
										
											2014-01-28 18:31:43 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-29 12:19:07 -05:00
										 |  |  | : function-object ( name alien -- )
 | 
					
						
							|  |  |  |     [ "$" prepend create-in ] [ '[ _ ] ] bi*
 | 
					
						
							|  |  |  |     { } { "obj" } <effect> define-inline ; inline
 | 
					
						
							| 
									
										
										
										
											2014-01-28 18:31:43 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-29 12:19:07 -05:00
										 |  |  | : add-function ( name effect -- )
 | 
					
						
							| 
									
										
										
										
											2014-03-12 10:16:05 -04:00
										 |  |  |     [ dup current-context get py-import swap getattr 2dup ] dip
 | 
					
						
							| 
									
										
										
										
											2014-01-29 12:19:07 -05:00
										 |  |  |     function-callable function-object ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-02-03 05:28:43 -05:00
										 |  |  | : make-method-quot ( name effect -- quot )
 | 
					
						
							|  |  |  |     [ in>> 1 tail gather-args-quot ] [ out>> unpack-value-quot ] bi swapd
 | 
					
						
							|  |  |  |     '[ @ rot _ getattr -rot call-object-full @ ] ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : method-callable ( name effect -- )
 | 
					
						
							|  |  |  |     [ dup create-in swap ] dip [ make-method-quot ] keep define-inline ;
 | 
					
						
							| 
									
										
										
										
											2014-01-29 12:19:07 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : method-object ( name -- )
 | 
					
						
							|  |  |  |     [ "$" prepend create-in ] [ '[ _ getattr ] ] bi
 | 
					
						
							|  |  |  |     { "obj" } { "obj'" } <effect> define-inline ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : add-method ( name effect -- )
 | 
					
						
							| 
									
										
										
										
											2014-02-03 05:28:43 -05:00
										 |  |  |     dupd method-callable method-object ;
 | 
					
						
							| 
									
										
										
										
											2014-01-28 18:31:43 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-31 06:18:12 -05:00
										 |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | SYNTAX: PY-FROM: [ add-function ] scan-definitions ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-01-29 12:19:07 -05:00
										 |  |  | SYNTAX: PY-METHODS: [ add-method ] scan-definitions ; inline
 |