<commit_before>! Copyright (C) 2008 <NAME>, <NAME>, <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.short-circuit kernel
lexer locals make math namespaces parser sequences words ;
IN: lists

! List Protocol
MIXIN: list
GENERIC: car ( cons -- car )
GENERIC: cdr ( cons -- cdr )
GENERIC: nil? ( object -- ?   )

TUPLE: cons-state { car read-only } { cdr read-only } ;

C: cons cons-state

M: cons-state car car>> ;

M: cons-state cdr cdr>> ;

SINGLETON: +nil+
M: +nil+ nil? drop t ;
M: object nil? drop f ;

: atom? ( obj -- ? ) list? not ; inline

: nil ( -- symbol ) +nil+ ; inline

: uncons ( cons -- car cdr ) [ car ] [ cdr ] bi ; inline

: swons ( cdr car -- cons ) swap cons ; inline

: unswons ( cons -- cdr car ) uncons swap ; inline

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

: 1list? ( list -- ? ) { [ nil? not ] [ cdr nil? ] } 1&& ; inline

: 2list ( a b -- cons ) 1list cons ; inline

: 3list ( a b c -- cons ) 2list cons ; inline

: cadr ( list -- elt ) cdr car ; inline

: 2car ( list -- car cadr ) uncons car ; inline

: 3car ( list -- car cadr caddr ) uncons uncons car ; inline

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

<PRIVATE

: (leach) ( list quot -- cdr quot )
    [ [ car ] dip call ] [ [ cdr ] dip ] 2bi ; inline

PRIVATE>

: leach ( ... list quot: ( ... elt -- ... ) -- ... )
    over nil? [ 2drop ] [ (leach) leach ] if ; inline recursive<commit_msg>lists: Add 2leach, lreduce, and 2lreduce<commit_after>! Copyright (C) 2008 <NAME>, <NAME>, <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.short-circuit kernel
lexer locals make math namespaces parser sequences words ;
IN: lists

! List Protocol
MIXIN: list
GENERIC: car ( cons -- car )
GENERIC: cdr ( cons -- cdr )
GENERIC: nil? ( object -- ?   )

TUPLE: cons-state { car read-only } { cdr read-only } ;

C: cons cons-state

M: cons-state car car>> ;

M: cons-state cdr cdr>> ;

SINGLETON: +nil+
M: +nil+ nil? drop t ;
M: object nil? drop f ;

: atom? ( obj -- ? ) list? not ; inline

: nil ( -- symbol ) +nil+ ; inline

: uncons ( cons -- car cdr ) [ car ] [ cdr ] bi ; inline

: swons ( cdr car -- cons ) swap cons ; inline

: unswons ( cons -- cdr car ) uncons swap ; inline

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

: 1list? ( list -- ? ) { [ nil? not ] [ cdr nil? ] } 1&& ; inline

: 2list ( a b -- cons ) 1list cons ; inline

: 3list ( a b c -- cons ) 2list cons ; inline

: cadr ( list -- elt ) cdr car ; inline

: 2car ( list -- car cadr ) uncons car ; inline

: 3car ( list -- car cadr caddr ) uncons uncons car ; inline

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

<PRIVATE

: (leach) ( list quot -- cdr quot )
    [ [ car ] dip call ] [ [ cdr ] dip ] 2bi ; inline

: (2leach) ( list1 list2 quot -- cdr1 cdr2 quot )
    [ [ [ car ] bi@ ] dip call ] [ [ [ cdr ] bi@ ] dip ] 3bi ; inline

PRIVATE>

: leach ( ... list quot: ( ... elt -- ... ) -- ... )
    over nil? [ 2drop ] [ (leach) leach ] if ; inline recursive

: 2leach ( ... list1 list2 quot: ( ... elt1 elt2 -- ... ) -- ... )
    2over [ nil? ] either? [ 3drop ] [ (2leach) 2leach ] if ; inline recursive

: lreduce ( ... list identity quot: ( ... prev elt -- ... next ) -- ... result )
    swapd leach ; inline

: 2lreduce ( ... list1 list2 identity quot: ( ... prev elt1 elt2 -- ... next ) -- ... result )
    -rotd 2leach ; inline
{'fraction_non_alphanumeric': 0.16384345794392524, 'fraction_numerical': 0.015478971962616822, 'mean_word_length': 2.354554358472086, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 19, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1843871', 'n_tokens_mistral': 1282, 'n_tokens_neox': 1236, 'n_words': 435}