new accessors
							parent
							
								
									7d1e346cec
								
							
						
					
					
						commit
						41fc9eac0f
					
				| 
						 | 
					@ -1,7 +1,8 @@
 | 
				
			||||||
! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
 | 
					! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
 | 
					USING: kernel hashtables namespaces continuations quotations
 | 
				
			||||||
 | 
					accessors ;
 | 
				
			||||||
IN: coroutines
 | 
					IN: coroutines
 | 
				
			||||||
USING: kernel hashtables namespaces continuations quotations ;
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
SYMBOL: current-coro
 | 
					SYMBOL: current-coro
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -13,12 +14,12 @@ TUPLE: coroutine resumecc exitcc ;
 | 
				
			||||||
  [ swapd , , \ bind , 
 | 
					  [ swapd , , \ bind , 
 | 
				
			||||||
    "Coroutine has terminated illegally." , \ throw ,
 | 
					    "Coroutine has terminated illegally." , \ throw ,
 | 
				
			||||||
  ] [ ] make
 | 
					  ] [ ] make
 | 
				
			||||||
  over set-coroutine-resumecc ;
 | 
					  >>resumecc ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: coresume ( v co -- result )
 | 
					: coresume ( v co -- result )
 | 
				
			||||||
  [ 
 | 
					  [ 
 | 
				
			||||||
    over set-coroutine-exitcc
 | 
					    >>exitcc
 | 
				
			||||||
    coroutine-resumecc call
 | 
					    resumecc>> call
 | 
				
			||||||
    #! At this point, the coroutine quotation must have terminated
 | 
					    #! At this point, the coroutine quotation must have terminated
 | 
				
			||||||
    #! normally (without calling coyield or coterminate). This shouldn't happen.
 | 
					    #! normally (without calling coyield or coterminate). This shouldn't happen.
 | 
				
			||||||
    f over
 | 
					    f over
 | 
				
			||||||
| 
						 | 
					@ -31,8 +32,8 @@ TUPLE: coroutine resumecc exitcc ;
 | 
				
			||||||
  current-coro get
 | 
					  current-coro get
 | 
				
			||||||
  [  
 | 
					  [  
 | 
				
			||||||
    [ continue-with ] curry
 | 
					    [ continue-with ] curry
 | 
				
			||||||
    over set-coroutine-resumecc  
 | 
					    >>resumecc
 | 
				
			||||||
    coroutine-exitcc continue-with
 | 
					    exitcc>> continue-with
 | 
				
			||||||
  ] callcc1 2nip ;
 | 
					  ] callcc1 2nip ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: coyield* ( v -- ) coyield drop ; inline
 | 
					: coyield* ( v -- ) coyield drop ; inline
 | 
				
			||||||
| 
						 | 
					@ -40,5 +41,5 @@ TUPLE: coroutine resumecc exitcc ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: coterminate ( v -- )
 | 
					: coterminate ( v -- )
 | 
				
			||||||
  current-coro get
 | 
					  current-coro get
 | 
				
			||||||
  [ ] over set-coroutine-resumecc
 | 
					  [ ] >>resumecc
 | 
				
			||||||
  coroutine-exitcc continue-with ;
 | 
					  exitcc>> continue-with ;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue