Various arity fixes

 - Require folded syntax to have 2 or more operators. Previously they
   would just act as the identity function.
 - Fix several places where functions were called with incorrect number
   of arguments.

lib/data/format.lisp

@@ -187,7 +187,10 @@
     (when (> last-positional (n args))
       (error! (string/format "(format %q): not given enough positional arguments (expected %d, got %d)"
                              str last-positional (n args))))
+    (with (parts (dolist [(frag fragments)]
+                   (compile-format-fragment frag interpret-spec)))
     `(let* [(,named-map { ,@named-alist })]
        (format-output! ,out
-                       ,(cons `.. (dolist [(frag fragments)]
-                                    (compile-format-fragment frag interpret-spec)))))))
+                       ,(if (= (n parts) 1)
+                          (car parts)
+                          (cons `.. parts)))))))

lib/math/bignum.lisp

@@ -139,7 +139,7 @@
     [(and (/= (type a) num-tag) (= (type b) num-tag)) (power (new a) b)]
     [(< b (new 0)) (new 0)]
     [(= b (new 0)) (new 1)]
-    [(= b (new 1) a)]
+    [(= b (new 1)) a]
     [else
       (let* [(val a)
              (r b)]

tests/compiler/codegen/meta-declarations.lisp

@@ -63,12 +63,12 @@
     (it "which are left associative"
       (affirm-native
         (native-expr { :contents '(1 " + " 2) :count 2 :fold "left" })
-        "function(...) local t = ... for i = 2, _select('#', ...) do t = t + _select(i, ...) end return t end"))
+        "function(x, ...) local t = x + ... for i = 2, _select('#', ...) do t = t + _select(i, ...) end return t end"))
 
     (it "which are right associative"
       (affirm-native
         (native-expr { :contents '(1 " .. " 2) :count 2 :fold "right" })
-        "function(...) local n = _select('#', ...) local t = _select(n, ...) for i = n - 1, 1, -1 do t = _select(i, ...) .. t end return t end"))
+        "function(x, ...) local n = _select('#', ...) local t = _select(n, ...) for i = n - 1, 1, -1 do t = _select(i, ...) .. t end return x .. t end"))
 
     (it "which are not associative"
       (affirm-native

urn/backend/lua/emit.lisp

@@ -48,6 +48,14 @@
   { :const true
     :quote true :quote-const true })
 
+(defun compile-native-fold (out meta a b)
+  :hidden
+  (for-each entry (native/native-syntax meta)
+    (case entry
+      [1 (w/append! out a)]
+      [2 (w/append! out b)]
+      [string? (w/append! out entry)])))
+
 (defun compile-native (out var meta)
   (cond
     [(native/native-bind-to meta)
@@ -58,7 +66,7 @@
      ;; Generate a custom function wrapper
      (w/append! out "function(")
      (if (native/native-syntax-fold meta)
-       (w/append! out "...")
+       (w/append! out "x, ...")
        (for i 1 (native/native-syntax-arity meta) 1
          (unless (= i 1) (w/append! out ", "))
          (w/append! out (.. "v" (string->number i)))))
@@ -76,22 +84,17 @@
             (w/append! out entry)))]
        ["left"
         ;; Fold values from the left.
-        (w/append! out "local t = ... for i = 2, _select('#', ...) do t = ")
-        (for-each entry (native/native-syntax meta)
-          (case entry
-            [1 (w/append! out "t")]
-            [2 (w/append! out "_select(i, ...)")]
-            [string? (w/append! out entry)]))
+        (w/append! out "local t = ")
+        (compile-native-fold out meta "x" "...")
+        (w/append! out " for i = 2, _select('#', ...) do t = ")
+        (compile-native-fold out meta "t" "_select(i, ...)")
         (w/append! out " end return t")]
        ["right"
         ;; Fold values from the right.
         (w/append! out "local n = _select('#', ...) local t = _select(n, ...) for i = n - 1, 1, -1 do t = ")
-        (for-each entry (native/native-syntax meta)
-          (case entry
-            [1 (w/append! out "_select(i, ...)")]
-            [2 (w/append! out "t")]
-            [string? (w/append! out entry)]))
-        (w/append! out " end return t")])
+        (compile-native-fold out meta "_select(i, ...)" "t")
+        (w/append! out " end return ")
+        (compile-native-fold out meta "x" "t")])
 
      (w/append! out " end")]
 

urn/backend/markdown.lisp

@@ -169,7 +169,7 @@
         (sort! (cadr letter) (lambda (a b) (< (scope/var-name (.> a :var)) (scope/var-name (.> b :var))))))
 
       (writer/line! out "---")
-      (writer/line! out (.. "title: Symbol index"))
+      (writer/line! out "title: Symbol index")
       (writer/line! out "---")
       (writer/line! out "# Symbol index")
       (writer/line! out "" true)

urn/parser.lisp

@@ -111,9 +111,7 @@
                                      (= char "'")) ; thousands separator
                             (consume!)
                             (set! char (string/char-at str (succ offset))))
-                          ; now this is a hack
-                          (let* [(str (apply .. (string/split (string/reverse (string/sub str start offset))
-                                                              "'")))]
+                          (with (str (string/gsub (string/reverse (string/sub str start offset)) "'" ""))
                             ; This implementation was stolen and adapted from
                             ; the Rosetta code entry for decoding Roman numerals
                             ; in Scheme.
@@ -137,8 +135,7 @@
                            (consume!)
                            (set! char (string/char-at str (succ offset))))
 
-                         (let* [(thousands-separated (apply .. (string/split (string/sub str start offset)
-                                                                             "'")))]
+                         (with (thousands-separated (string/gsub (string/sub str start offset) "'" ""))
                            ;; And convert the digit to a string
                            (string->number thousands-separated base)))))]
     ;; Scan the input stream, consume one character, then read til the end of that token.