erlang: lists:sort/1,2 + lists:usort/1 with full term order (lists_ext suite, 788/788)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m6s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m6s
New lib/erlang/lists-ext.sx (loaded after runtime.sx): stable merge sort over an SX-list bridge. sort/1 and usort/1 use full Erlang term order via a self-contained er-ext-lt? (deep tuple/list compare that the shared er-lt? lacks); sort/2 takes a fun(A,B)->bool comparator. Registration wraps er-register-builtin-bifs! so the BIFs survive the mid-run registry resets done by tests/runtime.sx. Roadmap is saturated within this loop's scope; this is forever-loop stdlib hardening. New file forced by the broken sx-tree write tools in this worktree (see Blockers) — authored via Write + sx_validate. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
162
lib/erlang/lists-ext.sx
Normal file
162
lib/erlang/lists-ext.sx
Normal file
@@ -0,0 +1,162 @@
|
||||
;; lib/erlang/lists-ext.sx — extra `lists` module BIFs.
|
||||
;;
|
||||
;; Loaded AFTER runtime.sx so the BIF registry + transpile helpers
|
||||
;; (er-mk-cons, er-lt?, er-equal?, er-bool, er-truthy?, er-apply-fun,
|
||||
;; er-bif-arg1, er-mk-error-marker, er-mk-atom, er-cons?, er-nil?) and
|
||||
;; runtime's er-register-pure-bif! are all in scope. Registrations run
|
||||
;; at load time and persist in the global er-bif-registry cell.
|
||||
;;
|
||||
;; Edit-tool note: the sx-tree write tools raise yojson "Expected
|
||||
;; string, got null" in this worktree, so new lists BIFs land here (a
|
||||
;; fresh file) rather than as in-place edits to the ~1900-line
|
||||
;; transpile.sx. Same separate-file pattern the VM dispatcher already
|
||||
;; uses (lib/erlang/vm/dispatcher.sx).
|
||||
|
||||
;; ── cons <-> SX-list bridges ──────────────────────────────────────
|
||||
(define
|
||||
er-cons->sxlist
|
||||
(fn (lst)
|
||||
(cond
|
||||
(er-nil? lst) (list)
|
||||
(er-cons? lst) (cons (get lst :head) (er-cons->sxlist (get lst :tail)))
|
||||
:else (raise (er-mk-error-marker (er-mk-atom "badarg"))))))
|
||||
|
||||
(define
|
||||
er-sxlist->cons
|
||||
(fn (xs)
|
||||
(if (= (len xs) 0)
|
||||
(er-mk-nil)
|
||||
(er-mk-cons (first xs) (er-sxlist->cons (rest xs))))))
|
||||
|
||||
;; ── merge sort over SX lists (stable) ─────────────────────────────
|
||||
(define
|
||||
er-ext-take
|
||||
(fn (xs n)
|
||||
(if (or (= n 0) (= (len xs) 0))
|
||||
(list)
|
||||
(cons (first xs) (er-ext-take (rest xs) (- n 1))))))
|
||||
|
||||
(define
|
||||
er-ext-drop
|
||||
(fn (xs n)
|
||||
(if (or (= n 0) (= (len xs) 0))
|
||||
xs
|
||||
(er-ext-drop (rest xs) (- n 1)))))
|
||||
|
||||
;; le? returns a truthy value (Erlang bool atom or SX bool) iff a
|
||||
;; should sort at-or-before b. Taking from the left half first on a
|
||||
;; true result keeps the sort stable.
|
||||
(define
|
||||
er-ext-merge
|
||||
(fn (a b le?)
|
||||
(cond
|
||||
(= (len a) 0) b
|
||||
(= (len b) 0) a
|
||||
(er-truthy? (le? (first a) (first b)))
|
||||
(cons (first a) (er-ext-merge (rest a) b le?))
|
||||
:else (cons (first b) (er-ext-merge a (rest b) le?)))))
|
||||
|
||||
(define
|
||||
er-ext-msort
|
||||
(fn (xs le?)
|
||||
(if (<= (len xs) 1)
|
||||
xs
|
||||
(let ((mid (quotient (len xs) 2)))
|
||||
(er-ext-merge
|
||||
(er-ext-msort (er-ext-take xs mid) le?)
|
||||
(er-ext-msort (er-ext-drop xs mid) le?)
|
||||
le?)))))
|
||||
|
||||
;; Full Erlang term order. The shared er-lt? (transpile.sx) only
|
||||
;; deep-compares numbers/atoms/strings and otherwise falls back to a
|
||||
;; coarse type rank — so any two tuples (or two lists) compare as
|
||||
;; order-equal there. er-ext-lt? adds the missing structural cases:
|
||||
;; tuples by arity then elementwise, lists elementwise with a shorter
|
||||
;; proper prefix sorting first. Cross-type cases delegate to er-lt?.
|
||||
(define
|
||||
er-ext-lt-seq
|
||||
(fn (ea eb i)
|
||||
(cond
|
||||
(>= i (len ea)) false
|
||||
(er-ext-lt? (nth ea i) (nth eb i)) true
|
||||
(er-ext-lt? (nth eb i) (nth ea i)) false
|
||||
:else (er-ext-lt-seq ea eb (+ i 1)))))
|
||||
|
||||
(define
|
||||
er-ext-lt?
|
||||
(fn (a b)
|
||||
(cond
|
||||
(and (er-tuple? a) (er-tuple? b))
|
||||
(let ((ea (get a :elements)) (eb (get b :elements)))
|
||||
(cond
|
||||
(< (len ea) (len eb)) true
|
||||
(> (len ea) (len eb)) false
|
||||
:else (er-ext-lt-seq ea eb 0)))
|
||||
(and (er-cons? a) (er-cons? b))
|
||||
(cond
|
||||
(er-ext-lt? (get a :head) (get b :head)) true
|
||||
(er-ext-lt? (get b :head) (get a :head)) false
|
||||
:else (er-ext-lt? (get a :tail) (get b :tail)))
|
||||
(and (er-nil? a) (er-cons? b)) true
|
||||
(and (er-cons? a) (er-nil? b)) false
|
||||
(and (er-nil? a) (er-nil? b)) false
|
||||
:else (er-lt? a b))))
|
||||
|
||||
;; Default Erlang term order: a =< b == not (b < a).
|
||||
(define
|
||||
er-ext-term-le
|
||||
(fn (a b) (er-bool (not (er-ext-lt? b a)))))
|
||||
|
||||
;; ── lists:sort/1, lists:sort/2 ────────────────────────────────────
|
||||
(define
|
||||
er-bif-lists-sort
|
||||
(fn (vs)
|
||||
(cond
|
||||
(= (len vs) 1)
|
||||
(er-sxlist->cons
|
||||
(er-ext-msort (er-cons->sxlist (nth vs 0)) er-ext-term-le))
|
||||
(= (len vs) 2)
|
||||
(let ((f (nth vs 0)) (lst (nth vs 1)))
|
||||
(er-sxlist->cons
|
||||
(er-ext-msort
|
||||
(er-cons->sxlist lst)
|
||||
(fn (a b) (er-apply-fun f (list a b))))))
|
||||
:else (error "Erlang: lists:sort: wrong arity"))))
|
||||
|
||||
;; ── lists:usort/1 (sort then drop adjacent term-equal dups) ───────
|
||||
(define
|
||||
er-ext-dedup
|
||||
(fn (xs)
|
||||
(cond
|
||||
(= (len xs) 0) (list)
|
||||
(= (len xs) 1) xs
|
||||
(er-equal? (first xs) (nth xs 1)) (er-ext-dedup (rest xs))
|
||||
:else (cons (first xs) (er-ext-dedup (rest xs))))))
|
||||
|
||||
(define
|
||||
er-bif-lists-usort
|
||||
(fn (vs)
|
||||
(let ((lst (er-bif-arg1 vs "lists:usort")))
|
||||
(er-sxlist->cons
|
||||
(er-ext-dedup
|
||||
(er-ext-msort (er-cons->sxlist lst) er-ext-term-le))))))
|
||||
|
||||
;; ── register ──────────────────────────────────────────────────────
|
||||
;; Hook into er-register-builtin-bifs! rather than registering once:
|
||||
;; the registry can be reset + rebuilt mid-run (tests/runtime.sx does
|
||||
;; this), and a plain one-shot registration would be wiped. Wrapping
|
||||
;; the rebuild fn means these BIFs are re-added on every reset.
|
||||
(define er-ext-lists-register!
|
||||
(fn ()
|
||||
(er-register-pure-bif! "lists" "sort" 1 er-bif-lists-sort)
|
||||
(er-register-pure-bif! "lists" "sort" 2 er-bif-lists-sort)
|
||||
(er-register-pure-bif! "lists" "usort" 1 er-bif-lists-usort)))
|
||||
|
||||
(define er-ext-prev-register-builtins er-register-builtin-bifs!)
|
||||
(define er-register-builtin-bifs!
|
||||
(fn ()
|
||||
(er-ext-prev-register-builtins)
|
||||
(er-ext-lists-register!)))
|
||||
|
||||
;; register into the currently-live registry too
|
||||
(er-ext-lists-register!)
|
||||
Reference in New Issue
Block a user