Adding lmap and traverse to extra/lists
							parent
							
								
									3ec7d8c20d
								
							
						
					
					
						commit
						bb050c9f4c
					
				| 
						 | 
					@ -41,6 +41,10 @@ IN: lists.tests
 | 
				
			||||||
  { 1 2 { 3 4 { 5 } } } seq>cons cons>seq  
 | 
					  { 1 2 { 3 4 { 5 } } } seq>cons cons>seq  
 | 
				
			||||||
] unit-test
 | 
					] unit-test
 | 
				
			||||||
    
 | 
					    
 | 
				
			||||||
 | 
					{ T{ cons f 2 T{ cons f 3 T{ cons f 4 T{ cons f 5 +nil+ } } } } } [
 | 
				
			||||||
 | 
					    { 1 2 3 4 } seq>cons [ 1+ ] lmap
 | 
				
			||||||
 | 
					] unit-test
 | 
				
			||||||
 | 
					    
 | 
				
			||||||
! { { 3 4 { 5 6 { 7 } } } } [
 | 
					! { { 3 4 { 5 6 { 7 } } } } [
 | 
				
			||||||
!   { 1 2 { 3 4 { 5 } } } seq>cons [ 2 + ] traverse cons>seq
 | 
					!   { 1 2 { 3 4 { 5 } } } seq>cons [ 2 + ] traverse cons>seq
 | 
				
			||||||
! ] unit-test
 | 
					! ] unit-test
 | 
				
			||||||
| 
						 | 
					@ -59,9 +59,6 @@ M: object nil? drop f ;
 | 
				
			||||||
: lreduce ( list identity quot -- result )
 | 
					: lreduce ( list identity quot -- result )
 | 
				
			||||||
    swapd leach ; inline
 | 
					    swapd leach ; inline
 | 
				
			||||||
    
 | 
					    
 | 
				
			||||||
! : lmap ( cons quot -- newcons )    
 | 
					 | 
				
			||||||
    
 | 
					 | 
				
			||||||
    
 | 
					 | 
				
			||||||
: (lmap>array) ( acc cons quot -- newcons )
 | 
					: (lmap>array) ( acc cons quot -- newcons )
 | 
				
			||||||
    over nil? [ 2drop ]
 | 
					    over nil? [ 2drop ]
 | 
				
			||||||
    [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap>array) ] if ; inline
 | 
					    [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap>array) ] if ; inline
 | 
				
			||||||
| 
						 | 
					@ -72,6 +69,9 @@ M: object nil? drop f ;
 | 
				
			||||||
: lmap-as ( cons quot exemplar -- seq )
 | 
					: lmap-as ( cons quot exemplar -- seq )
 | 
				
			||||||
    [ lmap>array ] dip like ;
 | 
					    [ lmap>array ] dip like ;
 | 
				
			||||||
    
 | 
					    
 | 
				
			||||||
 | 
					: lmap ( list quot -- newlist )    
 | 
				
			||||||
 | 
					    lmap>array <reversed> nil [ swap cons ] reduce ;
 | 
				
			||||||
 | 
					    
 | 
				
			||||||
: same? ( obj1 obj2 -- ? ) 
 | 
					: same? ( obj1 obj2 -- ? ) 
 | 
				
			||||||
    [ class ] bi@ = ;
 | 
					    [ class ] bi@ = ;
 | 
				
			||||||
    
 | 
					    
 | 
				
			||||||
| 
						 | 
					@ -82,6 +82,6 @@ M: object nil? drop f ;
 | 
				
			||||||
    [ dup cons? [ cons>seq ] when ] lmap>array ;
 | 
					    [ dup cons? [ cons>seq ] when ] lmap>array ;
 | 
				
			||||||
    
 | 
					    
 | 
				
			||||||
: traverse ( list quot -- newlist )
 | 
					: traverse ( list quot -- newlist )
 | 
				
			||||||
    [ over list? [ traverse ] [ call ] if ] curry  ;
 | 
					    [ over list? [ traverse ] [ call ] if ] curry lmap ;
 | 
				
			||||||
    
 | 
					    
 | 
				
			||||||
INSTANCE: cons list
 | 
					INSTANCE: cons list
 | 
				
			||||||
		Loading…
	
		Reference in New Issue