From 0baf04b594595138f5351d7349cc4735a7130897 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Fri, 1 Sep 2023 15:52:16 -0700 Subject: [PATCH] models.combinators: move weird reduce* word here --- extra/models/combinators/combinators.factor | 9 +++++++++ extra/sequences/extras/extras.factor | 7 ------- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/extra/models/combinators/combinators.factor b/extra/models/combinators/combinators.factor index 11e94ed3c6..3ff4d98fee 100644 --- a/extra/models/combinators/combinators.factor +++ b/extra/models/combinators/combinators.factor @@ -30,6 +30,15 @@ M: filter-model (model-changed) [ value>> ] dip 2dup quot>> call( a -- ? ) [ set-model ] [ 2drop ] if ; : filter-model ( model quot -- filter-model ) [ 1array \ filter-model ] dip >>quot ; + + TUPLE: fold-model < multi-model quot base values ; M: fold-model (model-changed) 2dup base>> = [ [ [ value>> ] [ [ values>> ] [ quot>> ] bi ] bi* swapd reduce* ] keep set-model ] diff --git a/extra/sequences/extras/extras.factor b/extra/sequences/extras/extras.factor index e2e6250c79..e6f24f6042 100644 --- a/extra/sequences/extras/extras.factor +++ b/extra/sequences/extras/extras.factor @@ -4,13 +4,6 @@ math.order ranges sequences sequences.private sets shuffle sorting splitting vectors ; IN: sequences.extras -! Quot must have static stack effect, unlike "reduce" -:: reduce* ( seq identity quot: ( prev elt -- next ) -- result ) - seq [ identity ] [ - unclip identity swap quot call( prev elt -- next ) - quot reduce* - ] if-empty ; inline recursive - : find-all ( ... seq quot: ( ... elt -- ... ? ) -- ... elts ) [ ] dip '[ nip @ ] assoc-filter ; inline -- 2.34.1