apl: ⎕ system functions + drive corpus to 100+ (+13 tests, 328/328)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 51s

This commit is contained in:
2026-05-07 06:56:20 +00:00
parent 0f13052900
commit 3e77dd4ded
7 changed files with 105 additions and 7 deletions

View File

@@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then
exit 1
fi
SUITES=(structural operators dfn tradfn valence programs)
SUITES=(structural operators dfn tradfn valence programs system)
OUT_JSON="lib/apl/scoreboard.json"
OUT_MD="lib/apl/scoreboard.md"

View File

@@ -925,6 +925,52 @@
(apl-quicksort (apl-compress (apl-gt arr pivot) arr))))
(apl-catenate less (apl-catenate eq greater))))))))
(define apl-quad-io (fn () (apl-scalar apl-io)))
(define apl-quad-ml (fn () (apl-scalar 1)))
(define apl-quad-fr (fn () (apl-scalar 1248)))
(define apl-quad-ts (fn () (make-array (list 7) (list 1970 1 1 0 0 0 0))))
(define apl-quad-fmt-scalar (fn (v) (str v)))
(define
apl-quad-fmt-vector
(fn
(ravel)
(if
(= (len ravel) 0)
""
(reduce
(fn (acc x) (str acc " " x))
(str (first ravel))
(rest ravel)))))
(define
apl-quad-fmt
(fn
(arr)
(let
((shape (get arr :shape)) (ravel (get arr :ravel)))
(cond
((= (len shape) 0) (apl-quad-fmt-scalar (first ravel)))
((= (len shape) 1) (apl-quad-fmt-vector ravel))
((= (len shape) 2)
(let
((rows (first shape)) (cols (last shape)))
(reduce
(fn
(acc r)
(let
((row-ravel (map (fn (j) (nth ravel (+ (* r cols) j))) (range 0 cols))))
(str acc (apl-quad-fmt-vector row-ravel) "\n")))
""
(range 0 rows))))
(else (apl-quad-fmt-vector ravel))))))
(define apl-quad-print (fn (arr) arr))
(define
apl-reduce
(fn

View File

@@ -5,9 +5,10 @@
"dfn": {"pass": 24, "fail": 0},
"tradfn": {"pass": 20, "fail": 0},
"valence": {"pass": 14, "fail": 0},
"programs": {"pass": 46, "fail": 0}
"programs": {"pass": 46, "fail": 0},
"system": {"pass": 13, "fail": 0}
},
"total_pass": 315,
"total_pass": 328,
"total_fail": 0,
"total": 315
"total": 328
}

View File

@@ -10,7 +10,8 @@ _Generated by `lib/apl/conformance.sh`_
| tradfn | 20 | 0 | 20 |
| valence | 14 | 0 | 14 |
| programs | 46 | 0 | 46 |
| **Total** | **315** | **0** | **315** |
| system | 13 | 0 | 13 |
| **Total** | **328** | **0** | **328** |
## Notes

View File

@@ -32,6 +32,7 @@ cat > "$TMPFILE" << 'EPOCHS'
(load "lib/apl/tests/tradfn.sx")
(load "lib/apl/tests/valence.sx")
(load "lib/apl/tests/programs.sx")
(load "lib/apl/tests/system.sx")
(epoch 4)
(eval "(list apl-test-pass apl-test-fail)")
EPOCHS

48
lib/apl/tests/system.sx Normal file
View File

@@ -0,0 +1,48 @@
; Tests for APL ⎕ system functions.
(define mkrv (fn (arr) (get arr :ravel)))
(define mksh (fn (arr) (get arr :shape)))
(apl-test "⎕IO returns 1" (mkrv (apl-quad-io)) (list 1))
(apl-test "⎕ML returns 1" (mkrv (apl-quad-ml)) (list 1))
(apl-test "⎕FR returns 1248" (mkrv (apl-quad-fr)) (list 1248))
(apl-test "⎕TS shape is 7" (mksh (apl-quad-ts)) (list 7))
(apl-test "⎕TS year is 1970 default" (first (mkrv (apl-quad-ts))) 1970)
(apl-test "⎕FMT scalar 42" (apl-quad-fmt (apl-scalar 42)) "42")
(apl-test "⎕FMT scalar negative" (apl-quad-fmt (apl-scalar -7)) "-7")
(apl-test
"⎕FMT empty vector"
(apl-quad-fmt (make-array (list 0) (list)))
"")
(apl-test
"⎕FMT singleton vector"
(apl-quad-fmt (make-array (list 1) (list 42)))
"42")
(apl-test
"⎕FMT vector"
(apl-quad-fmt (make-array (list 5) (list 1 2 3 4 5)))
"1 2 3 4 5")
(apl-test
"⎕FMT matrix 2x3"
(apl-quad-fmt (make-array (list 2 3) (list 1 2 3 4 5 6)))
"1 2 3\n4 5 6\n")
(apl-test
"⎕← (print) returns its arg"
(mkrv (apl-quad-print (apl-scalar 99)))
(list 99))
(apl-test
"⎕← preserves shape"
(mksh (apl-quad-print (make-array (list 3) (list 1 2 3))))
(list 3))

View File

@@ -100,8 +100,8 @@ Core mapping:
- [x] `primes.apl``(2=+⌿0=A∘.|A)/A←N` sieve
- [x] `n-queens.apl` — backtracking via reduce
- [x] `quicksort.apl` — the classic Roger Hui one-liner
- [ ] System functions: `⎕FMT`, `⎕FR` (float repr), `⎕TS` (timestamp), `⎕IO`, `⎕ML` (migration level — fixed at 1), `⎕←` (print)
- [ ] Drive corpus to 100+ green
- [x] System functions: `⎕FMT`, `⎕FR` (float repr), `⎕TS` (timestamp), `⎕IO`, `⎕ML` (migration level — fixed at 1), `⎕←` (print)
- [x] Drive corpus to 100+ green
- [ ] Idiom corpus — `lib/apl/tests/idioms.sx` covering classic Roger Hui / Phil Last idioms
## SX primitive baseline
@@ -118,6 +118,7 @@ data; format for string templating.
_Newest first._
- 2026-05-07: Phase 6 system fns + 100+ corpus — apl-quad-{io,ml,fr,ts,fmt,print}; ⎕FMT formats scalar/vector/matrix; ⎕TS returns 7-vector (epoch default); 328 tests >> 100 target; **drive-to-100 ticked**; +13 tests
- 2026-05-07: Phase 6 quicksort — recursive less/eq/greater partition via apl-compress, deterministic-pivot variant; tests cover empty/single/sorted/reverse/duplicates/negatives; **all 5 classic programs done**; +9 tests; 315/315
- 2026-05-07: Phase 6 n-queens — permutation enumerate + diagonal-conflict filter; counts q(1..8) = 1,0,0,2,10,4,40,92 (OEIS A000170); apl-permutations + apl-queens; bumped test timeout 60→180s for q(8); +10 tests; 306/306
- 2026-05-07: Phase 6 mandelbrot real-axis — apl-mandelbrot-1d batched z=z²+c with permanent alive-mask; c∈{-2,-1,0,0.25} bounded, c=1→3, c=0.5→5, c=2→2; +9 tests; 296/296