erlang: lists flatmap/2 + filtermap/2 + mapfoldl/3 + search/2 (862/862)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s
Higher-order list ops in lib/erlang/lists-ext.sx. filtermap honours
true/false/{true,V}; mapfoldl returns {Mapped, Acc}; search returns
{value,E}|false. lists_ext suite 83 -> 91.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -484,6 +484,80 @@
|
||||
er-bif-lists-droplast
|
||||
(fn (vs) (er-ext-droplast (er-bif-arg1 vs "lists:droplast"))))
|
||||
|
||||
;; ── more higher-order (flatmap / filtermap / mapfoldl / search) ───
|
||||
(define
|
||||
er-ext-flatmap
|
||||
(fn (f lst)
|
||||
(cond
|
||||
(er-nil? lst) (er-mk-nil)
|
||||
(er-cons? lst)
|
||||
(er-list-append
|
||||
(er-apply-fun f (list (get lst :head)))
|
||||
(er-ext-flatmap f (get lst :tail)))
|
||||
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
|
||||
|
||||
(define
|
||||
er-bif-lists-flatmap
|
||||
(fn (vs) (er-ext-flatmap (nth vs 0) (nth vs 1))))
|
||||
|
||||
(define
|
||||
er-ext-atom-true?
|
||||
(fn (v) (and (er-atom? v) (= (get v :name) "true"))))
|
||||
|
||||
(define
|
||||
er-ext-filtermap
|
||||
(fn (f lst)
|
||||
(cond
|
||||
(er-nil? lst) (er-mk-nil)
|
||||
(er-cons? lst)
|
||||
(let ((r (er-apply-fun f (list (get lst :head)))))
|
||||
(cond
|
||||
(er-ext-atom-true? r)
|
||||
(er-mk-cons (get lst :head) (er-ext-filtermap f (get lst :tail)))
|
||||
(and
|
||||
(er-tuple? r)
|
||||
(= (len (get r :elements)) 2)
|
||||
(er-ext-atom-true? (nth (get r :elements) 0)))
|
||||
(er-mk-cons (nth (get r :elements) 1) (er-ext-filtermap f (get lst :tail)))
|
||||
:else (er-ext-filtermap f (get lst :tail))))
|
||||
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
|
||||
|
||||
(define
|
||||
er-bif-lists-filtermap
|
||||
(fn (vs) (er-ext-filtermap (nth vs 0) (nth vs 1))))
|
||||
|
||||
(define
|
||||
er-ext-mapfoldl
|
||||
(fn (f acc lst mapped)
|
||||
(cond
|
||||
(er-nil? lst)
|
||||
(er-mk-tuple (list (er-list-reverse-iter mapped (er-mk-nil)) acc))
|
||||
(er-cons? lst)
|
||||
(let ((r (er-apply-fun f (list (get lst :head) acc))))
|
||||
(let ((es (get r :elements)))
|
||||
(er-ext-mapfoldl f (nth es 1) (get lst :tail)
|
||||
(er-mk-cons (nth es 0) mapped))))
|
||||
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
|
||||
|
||||
(define
|
||||
er-bif-lists-mapfoldl
|
||||
(fn (vs) (er-ext-mapfoldl (nth vs 0) (nth vs 1) (nth vs 2) (er-mk-nil))))
|
||||
|
||||
(define
|
||||
er-ext-search
|
||||
(fn (pred lst)
|
||||
(cond
|
||||
(er-nil? lst) (er-mk-atom "false")
|
||||
(er-cons? lst)
|
||||
(if (er-truthy? (er-apply-fun pred (list (get lst :head))))
|
||||
(er-mk-tuple (list (er-mk-atom "value") (get lst :head)))
|
||||
(er-ext-search pred (get lst :tail)))
|
||||
:else (er-mk-atom "false"))))
|
||||
|
||||
(define
|
||||
er-bif-lists-search
|
||||
(fn (vs) (er-ext-search (nth vs 0) (nth vs 1))))
|
||||
|
||||
;; ── register ──────────────────────────────────────────────────────
|
||||
;; Hook into er-register-builtin-bifs! rather than registering once:
|
||||
;; the registry can be reset + rebuilt mid-run (tests/runtime.sx does
|
||||
@@ -516,7 +590,11 @@
|
||||
(er-register-pure-bif! "lists" "sublist" 3 er-bif-lists-sublist)
|
||||
(er-register-pure-bif! "lists" "nthtail" 2 er-bif-lists-nthtail)
|
||||
(er-register-pure-bif! "lists" "split" 2 er-bif-lists-split)
|
||||
(er-register-pure-bif! "lists" "droplast" 1 er-bif-lists-droplast)))
|
||||
(er-register-pure-bif! "lists" "droplast" 1 er-bif-lists-droplast)
|
||||
(er-register-pure-bif! "lists" "flatmap" 2 er-bif-lists-flatmap)
|
||||
(er-register-pure-bif! "lists" "filtermap" 2 er-bif-lists-filtermap)
|
||||
(er-register-pure-bif! "lists" "mapfoldl" 3 er-bif-lists-mapfoldl)
|
||||
(er-register-pure-bif! "lists" "search" 2 er-bif-lists-search)))
|
||||
|
||||
(define er-ext-prev-register-builtins er-register-builtin-bifs!)
|
||||
(define er-register-builtin-bifs!
|
||||
|
||||
Reference in New Issue
Block a user