apl: ⎕ system functions + drive corpus to 100+ (+13 tests, 328/328)

lib/apl/conformance.sh

@@ -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"

lib/apl/runtime.sx

@@ -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

lib/apl/scoreboard.json

@@ -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
 }

lib/apl/scoreboard.md

@@ -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
 

lib/apl/test.sh

@@ -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

lib/apl/tests/system.sx

@@ -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))