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

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:
2026-06-30 13:19:00 +00:00
parent b10e55f04f
commit 355a482dfe
6 changed files with 253 additions and 4 deletions

View File

@@ -39,6 +39,7 @@ SUITES=(
"ffi|er-ffi-test-pass|er-ffi-test-count"
"vm|er-vm-test-pass|er-vm-test-count"
"send_after|er-sa-test-pass|er-sa-test-count"
"lists_ext|er-lx-test-pass|er-lx-test-count"
)
cat > "$TMPFILE" << 'EPOCHS'
@@ -50,6 +51,7 @@ cat > "$TMPFILE" << 'EPOCHS'
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/erlang/lists-ext.sx")
(load "lib/erlang/tests/tokenize.sx")
(load "lib/erlang/tests/parse.sx")
(load "lib/erlang/tests/eval.sx")
@@ -63,6 +65,7 @@ cat > "$TMPFILE" << 'EPOCHS'
(load "lib/erlang/tests/ffi.sx")
(load "lib/erlang/tests/vm.sx")
(load "lib/erlang/tests/send_after.sx")
(load "lib/erlang/tests/lists_ext.sx")
(epoch 100)
(eval "(list er-test-pass er-test-count)")
(epoch 101)
@@ -87,6 +90,8 @@ cat > "$TMPFILE" << 'EPOCHS'
(eval "(list er-vm-test-pass er-vm-test-count)")
(epoch 111)
(eval "(list er-sa-test-pass er-sa-test-count)")
(epoch 112)
(eval "(list er-lx-test-pass er-lx-test-count)")
EPOCHS
timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1

162
lib/erlang/lists-ext.sx Normal file
View 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!)

View File

@@ -1,7 +1,7 @@
{
"language": "erlang",
"total_pass": 771,
"total": 771,
"total_pass": 788,
"total": 788,
"suites": [
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
{"name":"parse","pass":52,"total":52,"status":"ok"},
@@ -14,6 +14,7 @@
{"name":"fib","pass":8,"total":8,"status":"ok"},
{"name":"ffi","pass":37,"total":37,"status":"ok"},
{"name":"vm","pass":78,"total":78,"status":"ok"},
{"name":"send_after","pass":10,"total":10,"status":"ok"}
{"name":"send_after","pass":10,"total":10,"status":"ok"},
{"name":"lists_ext","pass":17,"total":17,"status":"ok"}
]
}

View File

@@ -1,6 +1,6 @@
# Erlang-on-SX Scoreboard
**Total: 771 / 771 tests passing**
**Total: 788 / 788 tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
@@ -16,6 +16,7 @@
| ✅ | ffi | 37 | 37 |
| ✅ | vm | 78 | 78 |
| ✅ | send_after | 10 | 10 |
| ✅ | lists_ext | 17 | 17 |
Generated by `lib/erlang/conformance.sh`.

View File

@@ -0,0 +1,76 @@
;; lists-ext tests — lists:sort/1, lists:sort/2, lists:usort/1.
;; Each case evaluates an Erlang expression that reduces to the bool
;; atom `true` (via =:= on the sorted result) and checks its name.
(define er-lx-test-count 0)
(define er-lx-test-pass 0)
(define er-lx-test-fails (list))
(define
er-lx-test
(fn
(name actual expected)
(set! er-lx-test-count (+ er-lx-test-count 1))
(if
(= actual expected)
(set! er-lx-test-pass (+ er-lx-test-pass 1))
(append! er-lx-test-fails {:name name :expected expected :actual actual}))))
;; eval an Erlang source string and return the result atom's name
(define er-lx-nm (fn (src) (get (erlang-eval-ast src) :name)))
;; ── lists:sort/1 ──────────────────────────────────────────────────
(er-lx-test "sort/1 ascending"
(er-lx-nm "lists:sort([3,1,2]) =:= [1,2,3]") "true")
(er-lx-test "sort/1 already sorted"
(er-lx-nm "lists:sort([1,2,3]) =:= [1,2,3]") "true")
(er-lx-test "sort/1 empty"
(er-lx-nm "lists:sort([]) =:= []") "true")
(er-lx-test "sort/1 singleton"
(er-lx-nm "lists:sort([7]) =:= [7]") "true")
(er-lx-test "sort/1 keeps duplicates"
(er-lx-nm "lists:sort([3,1,2,1]) =:= [1,1,2,3]") "true")
(er-lx-test "sort/1 length preserved"
(erlang-eval-ast "length(lists:sort([5,4,3,2,1]))") 5)
(er-lx-test "sort/1 term order: number < atom"
(er-lx-nm "lists:sort([b,a,1]) =:= [1,a,b]") "true")
(er-lx-test "sort/1 tuples elementwise"
(er-lx-nm "lists:sort([{2,a},{1,b},{1,a}]) =:= [{1,a},{1,b},{2,a}]") "true")
;; ── lists:sort/2 ──────────────────────────────────────────────────
(er-lx-test "sort/2 ascending =<"
(er-lx-nm "lists:sort(fun(A,B) -> A =< B end, [3,1,2]) =:= [1,2,3]") "true")
(er-lx-test "sort/2 descending >="
(er-lx-nm "lists:sort(fun(A,B) -> A >= B end, [1,3,2]) =:= [3,2,1]") "true")
(er-lx-test "sort/2 stable on equal keys"
(er-lx-nm
"lists:sort(fun({A,_},{B,_}) -> A =< B end, [{1,x},{1,y},{0,z}]) =:= [{0,z},{1,x},{1,y}]")
"true")
(er-lx-test "sort/2 empty"
(er-lx-nm "lists:sort(fun(A,B) -> A =< B end, []) =:= []") "true")
;; ── lists:usort/1 ─────────────────────────────────────────────────
(er-lx-test "usort/1 removes duplicates"
(er-lx-nm "lists:usort([3,1,2,1,3]) =:= [1,2,3]") "true")
(er-lx-test "usort/1 empty"
(er-lx-nm "lists:usort([]) =:= []") "true")
(er-lx-test "usort/1 all equal collapses to one"
(er-lx-nm "lists:usort([5,5,5]) =:= [5]") "true")
(er-lx-test "usort/1 already unique"
(er-lx-nm "lists:usort([1,2,3]) =:= [1,2,3]") "true")
(er-lx-test "usort/1 length after dedup"
(erlang-eval-ast "length(lists:usort([4,4,2,2,1,1,4]))") 3)