erlang: lists foldr/3 + partition/2 + takewhile/dropwhile/splitwith (823/823)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m5s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m5s
Higher-order traversal family in lib/erlang/lists-ext.sx, registered
pure via the er-register-builtin-bifs! wrapper. foldr right-folds;
partition returns {Yes,No} order-preserved; splitwith = {takewhile,
dropwhile}. lists_ext suite 38 -> 52.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -249,6 +249,76 @@
|
||||
(er-bool
|
||||
(not (er-ext-lt? (er-ext-tup-elem b n) (er-ext-tup-elem a n))))))))))
|
||||
|
||||
;; ── higher-order traversal (foldr / partition / *while) ───────────
|
||||
(define
|
||||
er-ext-foldr
|
||||
(fn (f acc lst)
|
||||
(cond
|
||||
(er-nil? lst) acc
|
||||
(er-cons? lst)
|
||||
(er-apply-fun f (list (get lst :head) (er-ext-foldr f acc (get lst :tail))))
|
||||
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
|
||||
|
||||
(define
|
||||
er-bif-lists-foldr
|
||||
(fn (vs) (er-ext-foldr (nth vs 0) (nth vs 1) (nth vs 2))))
|
||||
|
||||
(define
|
||||
er-ext-partition
|
||||
(fn (pred lst yes no)
|
||||
(cond
|
||||
(er-nil? lst)
|
||||
(er-mk-tuple
|
||||
(list
|
||||
(er-list-reverse-iter yes (er-mk-nil))
|
||||
(er-list-reverse-iter no (er-mk-nil))))
|
||||
(er-cons? lst)
|
||||
(if (er-truthy? (er-apply-fun pred (list (get lst :head))))
|
||||
(er-ext-partition pred (get lst :tail) (er-mk-cons (get lst :head) yes) no)
|
||||
(er-ext-partition pred (get lst :tail) yes (er-mk-cons (get lst :head) no)))
|
||||
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
|
||||
|
||||
(define
|
||||
er-bif-lists-partition
|
||||
(fn (vs) (er-ext-partition (nth vs 0) (nth vs 1) (er-mk-nil) (er-mk-nil))))
|
||||
|
||||
(define
|
||||
er-ext-takewhile
|
||||
(fn (pred lst)
|
||||
(cond
|
||||
(er-nil? lst) (er-mk-nil)
|
||||
(er-cons? lst)
|
||||
(if (er-truthy? (er-apply-fun pred (list (get lst :head))))
|
||||
(er-mk-cons (get lst :head) (er-ext-takewhile pred (get lst :tail)))
|
||||
(er-mk-nil))
|
||||
:else (er-mk-nil))))
|
||||
|
||||
(define
|
||||
er-bif-lists-takewhile
|
||||
(fn (vs) (er-ext-takewhile (nth vs 0) (nth vs 1))))
|
||||
|
||||
(define
|
||||
er-ext-dropwhile
|
||||
(fn (pred lst)
|
||||
(cond
|
||||
(er-nil? lst) (er-mk-nil)
|
||||
(er-cons? lst)
|
||||
(if (er-truthy? (er-apply-fun pred (list (get lst :head))))
|
||||
(er-ext-dropwhile pred (get lst :tail))
|
||||
lst)
|
||||
:else lst)))
|
||||
|
||||
(define
|
||||
er-bif-lists-dropwhile
|
||||
(fn (vs) (er-ext-dropwhile (nth vs 0) (nth vs 1))))
|
||||
|
||||
(define
|
||||
er-bif-lists-splitwith
|
||||
(fn (vs)
|
||||
(let ((pred (nth vs 0)) (lst (nth vs 1)))
|
||||
(er-mk-tuple
|
||||
(list (er-ext-takewhile pred lst) (er-ext-dropwhile pred lst))))))
|
||||
|
||||
;; ── register ──────────────────────────────────────────────────────
|
||||
;; Hook into er-register-builtin-bifs! rather than registering once:
|
||||
;; the registry can be reset + rebuilt mid-run (tests/runtime.sx does
|
||||
@@ -265,7 +335,12 @@
|
||||
(er-register-pure-bif! "lists" "keyreplace" 4 er-bif-lists-keyreplace)
|
||||
(er-register-pure-bif! "lists" "keystore" 4 er-bif-lists-keystore)
|
||||
(er-register-pure-bif! "lists" "keytake" 3 er-bif-lists-keytake)
|
||||
(er-register-pure-bif! "lists" "keysort" 2 er-bif-lists-keysort)))
|
||||
(er-register-pure-bif! "lists" "keysort" 2 er-bif-lists-keysort)
|
||||
(er-register-pure-bif! "lists" "foldr" 3 er-bif-lists-foldr)
|
||||
(er-register-pure-bif! "lists" "partition" 2 er-bif-lists-partition)
|
||||
(er-register-pure-bif! "lists" "takewhile" 2 er-bif-lists-takewhile)
|
||||
(er-register-pure-bif! "lists" "dropwhile" 2 er-bif-lists-dropwhile)
|
||||
(er-register-pure-bif! "lists" "splitwith" 2 er-bif-lists-splitwith)))
|
||||
|
||||
(define er-ext-prev-register-builtins er-register-builtin-bifs!)
|
||||
(define er-register-builtin-bifs!
|
||||
|
||||
Reference in New Issue
Block a user