     over nil? [ 2drop ] [ [ uncons ] dip tuck call leach ] if ; inline
     
 : lreduce ( list identity quot -- result )
-    swapd leach ; inline
+    pick nil? [ drop nip ]
+    [ [ uncons ] 2dip swapd [ call ] keep lreduce ] if ; inline
     
 : (lmap) ( acc cons quot -- seq )    
     over nil? [ 2drop ]
     [ [ uncons ] dip [ call ] keep swapd [ suffix ] 2dip (lmap) ] if ; inline
     
 : lmap ( cons quot -- seq )
-    [ { } clone ] 2dip (lmap) ; inline
+    { } -rot (lmap) ; inline
     
 : lmap-as ( cons quot exemplar -- seq )
     [ lmap ] dip like ;


: nil ( -- cons )
  T{ cons f f f } ;

M: cons nil? ( cons -- bool )
    nil eq? ;

: 1list ( obj -- cons )
    nil cons ;
    

    
: 3car ( cons -- car caar caaar )    
    [ car ] [ cdr car ] [ cdr cdr car ] tri ;

: lnth ( n list -- elt )
    swap [ cdr ] times car ;
