New function: str

The str function is like mkstring but allows a fill pattern
to be specified.

* eval.c (eval_init): str intrinsic registered.

* lib.[ch[ (str): New function.

* tests/015/str.tl: New file.

* txr.1: Documented.

* stdlib/doc-syms.tl: Updated.

6 files changed, 136 insertions, 40 deletions

diff --git a/eval.c b/eval.c
index 2986935d..4053f8eb 100644
--- a/eval.c
+++ b/eval.c
@@ -7195,6 +7195,7 @@ void eval_init(void)
   reg_fun(intern(lit("keywordp"), user_package), func_n1(keywordp));
   reg_fun(intern(lit("bindable"), user_package), func_n1(bindable));
   reg_fun(intern(lit("mkstring"), user_package), func_n2o(mkstring, 1));
+  reg_fun(intern(lit("str"), user_package), func_n2o(str, 1));
   reg_fun(intern(lit("copy-str"), user_package), func_n1(copy_str));
   reg_fun(intern(lit("upcase-str"), user_package), func_n1(upcase_str));
   reg_fun(intern(lit("downcase-str"), user_package), func_n1(downcase_str));
diff --git a/lib.c b/lib.c
index 23fd5008..cc0f923e 100644
--- a/lib.c
+++ b/lib.c
@@ -4885,6 +4885,39 @@ val init_str(val str, const wchar_t *data, val self)
   return str;
 }
 
+val str(val len, val pattern)
+{
+  if (chrp(pattern) || null_or_missing_p(pattern)) {
+    return mkstring(len, pattern);
+  } else {
+    val self = lit("str");
+    const wchar_t *pat = c_str(pattern, self);
+    ucnum pl = c_unum(length(pattern), self);
+
+    if (pl <= 1) {
+      val ch = if3(pl == 0, chr(' '), chr(pat[0]));
+      return mkstring(len, ch);
+    } else {
+      ucnum l = c_unum(len, self);
+      val str = mkustring(len);
+      ucnum offs = 0;
+
+      str->st.str[l] = 0;
+
+      for (;;) {
+        wmemcpy(str->st.str + offs, pat, min(l, pl));
+        if (pl < l) {
+          l -= pl;
+          offs += pl;
+          continue;
+        }
+        break;
+      }
+      return str;
+    }
+  }
+}
+
 static val copy_lazy_str(val lstr);
 
 val copy_str(val str)
diff --git a/lib.h b/lib.h
index 59b20645..89f17f52 100644
--- a/lib.h
+++ b/lib.h
@@ -900,6 +900,7 @@ val string_8bit_size(const unsigned char *str, size_t sz);
 val mkstring(val len, val ch);
 val mkustring(val len); /* must initialize immediately with init_str! */
 val init_str(val str, const wchar_t *, val self);
+val str(val len, val pattern);
 val copy_str(val str);
 val upcase_str(val str);
 val downcase_str(val str);
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index 47f0a89f..7b9ab9fa 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -72,8 +72,8 @@
       ("<!" "N-02B10DF9")
       ("<-" "N-02B10DF9")
       ("<=" "D-001E")
-      ("=" "D-0078")
-      (">" "D-0060")
+      ("=" "D-0079")
+      (">" "D-0061")
       (">=" "D-0053")
       ("abort" "N-02F934F6")
       ("abs" "D-0017")
@@ -107,7 +107,7 @@
       ("all" "D-0054")
       ("all*" "N-00F6E2A2")
       ("allocate-struct" "N-03168BF2")
-      ("and" "D-0068")
+      ("and" "D-0069")
       ("andf" "N-01E7D2AD")
       ("ap" "N-011CFC0C")
       ("apf" "N-012A7E6A")
@@ -125,10 +125,10 @@
       ("array" "N-0117BE95")
       ("arraysize" "N-002129D6")
       ("as" "N-028B26DD")
-      ("ash" "D-0063")
+      ("ash" "D-0064")
       ("asin" "D-003C")
       ("asinh" "D-0004")
-      ("assert" "D-005F")
+      ("assert" "D-0060")
       ("assoc" "N-00E9306D")
       ("assq" "N-00123702")
       ("assql" "N-00123702")
@@ -153,13 +153,13 @@
       ("bchar" "N-0008D7DC")
       ("bignum-len" "N-020294AB")
       ("bignump" "N-03E9D6E1")
-      ("bind" "D-006D")
+      ("bind" "D-006E")
       ("bindable" "N-0222F2E3")
       ("bit" "D-004C")
       ("bitset" "D-0037")
       ("blkcnt-t" "N-01153D9E")
       ("blksize-t" "N-01153D9E")
-      ("block" "D-006F")
+      ("block" "D-0070")
       ("block*" "N-02F60DCE")
       ("bool" "D-002C")
       ("boundp" "N-01FBF828")
@@ -172,7 +172,7 @@
       ("bstr" "N-0225F1EF")
       ("bstr-d" "N-0225F1EF")
       ("bstr-s" "N-0225F1EF")
-      ("buf" "D-005E")
+      ("buf" "D-005F")
       ("buf-alloc-size" "N-013A3727")
       ("buf-carray" "N-0022F54E")
       ("buf-compress" "N-02DB9DFB")
@@ -288,8 +288,8 @@
       ("cdar" "N-001FA3CB")
       ("cdddddr" "N-001FA3CB")
       ("cddr" "N-001FA3CB")
-      ("cdr" "D-0077")
-      ("ceil" "D-007C")
+      ("cdr" "D-0078")
+      ("ceil" "D-007D")
       ("ceil-rem" "N-02DE978F")
       ("ceil1" "N-02C8FF28")
       ("chain" "N-00C53CF7")
@@ -403,7 +403,7 @@
       ("copy-tree-iter" "N-025C3140")
       ("copy-vec" "N-010E7635")
       ("cos" "D-0021")
-      ("cosh" "D-0080")
+      ("cosh" "D-0081")
       ("count-if" "N-00BBC726")
       ("count-until-match" "N-00EFD668")
       ("countq" "N-01DF131F")
@@ -497,7 +497,7 @@
       ("dlsym-checked" "N-029063A0")
       ("dlvsym" "N-01B1E865")
       ("dlvsym-checked" "N-029063A0")
-      ("do" "D-0071")
+      ("do" "D-0072")
       ("doc" "N-0097F54C")
       ("dohash" "N-039105E8")
       ("doloop" "N-01FF4DDB")
@@ -635,11 +635,11 @@
       ("eprototype" "N-036B1BDB")
       ("eq" "N-02550B35")
       ("eql" "N-02550B35")
-      ("equal" "D-007A")
+      ("equal" "D-007B")
       ("equot" "N-02ACCDDF")
       ("erange" "N-036B1BDB")
       ("erofs" "N-036B1BDB")
-      ("errno" "D-0076")
+      ("errno" "D-0077")
       ("error" "N-015466AD")
       ("espipe" "N-036B1BDB")
       ("esrch" "N-036B1BDB")
@@ -664,7 +664,7 @@
       ("expand-left" "N-00E168FE")
       ("expand-right" "N-023B6B64")
       ("expand-with-free-refs" "N-0334827B")
-      ("expt" "D-0075")
+      ("expt" "D-0076")
       ("exptmod" "D-0036")
       ("extproc" "N-0072FF5E")
       ("f" "N-003BDFA9")
@@ -725,7 +725,7 @@
       ("file-put" "N-0041C2E5")
       ("file-put-buf" "N-02AE3A31")
       ("file-put-json" "D-002A")
-      ("file-put-jsons" "D-007D")
+      ("file-put-jsons" "D-007E")
       ("file-put-lines" "N-0041C2E5")
       ("file-put-string" "N-0041C2E5")
       ("fileno" "N-008ACF75")
@@ -738,7 +738,7 @@
       ("filter-equal" "N-03136087")
       ("filter-string-tree" "N-00C9EEB0")
       ("finalize" "N-01230613")
-      ("finally" "D-0079")
+      ("finally" "D-007A")
       ("find" "N-00C9DFF6")
       ("find-frame" "N-02B97226")
       ("find-frames" "N-02B97226")
@@ -854,8 +854,8 @@
       ("gequal" "N-00A3E42D")
       ("get" "N-03D9F55D")
       ("get-buf-from-stream" "N-02954B48")
-      ("get-byte" "D-0062")
-      ("get-char" "D-0065")
+      ("get-byte" "D-0063")
+      ("get-char" "D-0066")
       ("get-error" "D-0033")
       ("get-error-str" "D-0010")
       ("get-fd" "N-011D42AB")
@@ -985,7 +985,7 @@
       ("imaxbel" "N-02391683")
       ("improper-plist-to-alist" "N-006E31B5")
       ("in" "N-016BE41C")
-      ("in-package" "D-0072")
+      ("in-package" "D-0073")
       ("in-range" "N-02C56FB6")
       ("in-range*" "N-02C56FB6")
       ("in6addr-any" "N-026A2C3B")
@@ -1049,7 +1049,7 @@
       ("iter-item" "D-0005")
       ("iter-more" "D-003D")
       ("iter-reset" "D-0020")
-      ("iter-step" "D-0070")
+      ("iter-step" "D-0071")
       ("iterable" "N-01156AE3")
       ("itimer-prof" "N-02B7882A")
       ("itimer-real" "N-02B7882A")
@@ -1129,7 +1129,7 @@
       ("listp" "N-03F70343")
       ("lnew" "N-0230059D")
       ("lnew*" "N-021E6FDC")
-      ("load" "D-0081")
+      ("load" "D-0082")
       ("load-for" "N-0020A085")
       ("load-time" "D-0047")
       ("loff-t" "N-01153D9E")
@@ -1153,14 +1153,14 @@
       ("log-user" "N-0116F48F")
       ("log-warning" "N-035D75EC")
       ("log10" "D-0051")
-      ("log2" "D-0073")
+      ("log2" "D-0074")
       ("logand" "D-000E")
       ("logcount" "D-003A")
       ("logior" "D-004B")
       ("lognot" "D-0012")
       ("lognot1" "N-019541E2")
       ("logtest" "N-00B1548A")
-      ("logtrunc" "D-0074")
+      ("logtrunc" "D-0075")
       ("logxor" "N-02D5AF97")
       ("long" "N-0235F4E4")
       ("long-suffix" "N-00A3183A")
@@ -1276,7 +1276,7 @@
       ("mkfifo" "N-0091FD43")
       ("mknod" "N-00F93A39")
       ("mkstemp" "N-026E0471")
-      ("mkstring" "N-033DD796")
+      ("mkstring" "N-030DECA8")
       ("mlet" "N-008216E0")
       ("mmakunbound" "N-02964FC0")
       ("mmap" "N-03C6CE44")
@@ -1309,7 +1309,7 @@
       ("new" "N-0230059D")
       ("new*" "N-021E6FDC")
       ("nexpand-left" "N-00E168FE")
-      ("next" "D-006C")
+      ("next" "D-006D")
       ("next-file" "N-00839D2F")
       ("nf" "N-0267AE6D")
       ("nil" "N-015134D8")
@@ -1320,10 +1320,10 @@
       ("nldly" "N-03BD477F")
       ("nlink-t" "N-01153D9E")
       ("noflsh" "N-0072FF5E")
-      ("none" "D-006B")
+      ("none" "D-006C")
       ("nor" "N-03662D87")
       ("norf" "N-00C18907")
-      ("not" "D-0069")
+      ("not" "D-006A")
       ("notf" "N-0026CE18")
       ("nr" "N-03A7AE6D")
       ("nreconc" "N-012FF2DC")
@@ -1458,7 +1458,7 @@
       ("placelet" "N-0393C970")
       ("placelet*" "N-0393C970")
       ("plist-to-alist" "N-006E31B5")
-      ("plusp" "D-0067")
+      ("plusp" "D-0068")
       ("poll" "N-0386D39D")
       ("poly" "N-026201AD")
       ("pop" "N-017F39D2")
@@ -1508,7 +1508,7 @@
       ("push-after-load" "N-01F489FE")
       ("pushhash" "N-022660B2")
       ("pushnew" "N-02C37AB0")
-      ("put-buf" "D-007F")
+      ("put-buf" "D-0080")
       ("put-byte" "D-002F")
       ("put-carray" "N-00737951")
       ("put-char" "D-0003")
@@ -1518,11 +1518,11 @@
       ("put-line" "N-012163C3")
       ("put-lines" "N-0367B282")
       ("put-obj" "N-025DB229")
-      ("put-string" "D-007B")
+      ("put-string" "D-007C")
       ("put-strings" "N-0367B282")
       ("pwd" "N-0047F5F6")
       ("qquote" "N-01665185")
-      ("qref" "D-006E")
+      ("qref" "D-006F")
       ("quantile" "N-0318C018")
       ("quip" "N-03C6D422")
       ("quote" "N-0163F998")
@@ -1600,7 +1600,7 @@
       ("remqual*" "N-00B85CD2")
       ("rename-path" "N-016EF40C")
       ("rep" "D-004E")
-      ("repeat" "D-006A")
+      ("repeat" "D-006B")
       ("replace" "N-035991E1")
       ("replace-buf" "N-01C59E4E")
       ("replace-env" "N-03C59E3B")
@@ -1609,7 +1609,7 @@
       ("replace-struct" "N-01A8343B")
       ("replace-tree-iter" "N-01225FF3")
       ("replace-vec" "N-01F59E62")
-      ("require" "D-007E")
+      ("require" "D-007F")
       ("reset-struct" "N-002A609F")
       ("rest" "N-02288559")
       ("ret" "N-033F39EF")
@@ -1779,7 +1779,7 @@
       ("sign-extend" "D-0031")
       ("signum" "D-000F")
       ("sin" "D-000B")
-      ("sinh" "D-0066")
+      ("sinh" "D-0067")
       ("sixth" "N-01B0FA33")
       ("size-t" "N-01B6F219")
       ("size-vec" "N-01000634")
@@ -1859,7 +1859,7 @@
       ("static-slot-p" "N-032FD510")
       ("static-slot-set" "N-0017D1B5")
       ("stdlib" "N-008E4BC2")
-      ("str" "N-01736060")
+      ("str" "D-005E")
       ("str-buf" "N-012BF6AD")
       ("str-d" "N-01736060")
       ("str-in6addr" "N-01FF658D")
@@ -1947,7 +1947,7 @@
       ("take-until" "N-01E42C4C")
       ("take-while" "N-01E42C4C")
       ("tan" "D-003B")
-      ("tanh" "D-0061")
+      ("tanh" "D-0062")
       ("tb" "N-02AB6E53")
       ("tc" "N-029B6E53")
       ("tcdrain" "N-01AC4760")
@@ -1987,7 +1987,7 @@
       ("time-fields-utc" "N-00789418")
       ("time-local" "N-001284ED")
       ("time-nsec" "N-03B6DB3D")
-      ("time-parse" "D-0064")
+      ("time-parse" "D-0065")
       ("time-parse-local" "N-00207C99")
       ("time-parse-utc" "N-00207C99")
       ("time-string" "N-007B1819")
diff --git a/tests/015/str.tl b/tests/015/str.tl
new file mode 100644
index 00000000..c0d8dc58
--- /dev/null
+++ b/tests/015/str.tl
@@ -0,0 +1,28 @@
+(load "../common")
+
+(mtest
+  (str "x") :error
+  (str 0) ""
+  (str 0 5) :error
+  (str 0 "abcd") ""
+  (str 0 "") ""
+  (str 0 #\x) ""
+  (str -1) :error
+  (str -1 #\x) :error
+  (str -1 "") :error
+  (str -1 "abc") :error)
+
+(mtest
+  (str 10) "          "
+  (str 10 "") "          "
+  (str 10 #\a) "aaaaaaaaaa"
+  (str 10 "a") "aaaaaaaaaa"
+  (str 10 "ab") "ababababab"
+  (str 10 "abc") "abcabcabca"
+  (str 10 "abcd") "abcdabcdab"
+  (str 10 "abcde") "abcdeabcde"
+  (str 10 "abcdef") "abcdefabcd"
+  (str 10 "abcdefghij") "abcdefghij"
+  (str 10 "abcdefghijk") "abcdefghij"
+  (str 10 "abcdefghijklmnopqrst") "abcdefghij"
+  (str 10 "abcdefghijklmnopqrstuvwxyz") "abcdefghij")
diff --git a/txr.1 b/txr.1
index a50a30ad..8166d0aa 100644
--- a/txr.1
+++ b/txr.1
@@ -24892,9 +24892,10 @@ The following equivalences hold:
                               (less x (to r)))
 .brev
 .SS* Characters and Strings
-.coNP Function @ mkstring
+.coNP Functions @ mkstring and @ str
 .synb
 .mets (mkstring < length <> [ char ])
+.mets (str < length >> [ char | << string ])
 .syne
 .desc
 The
@@ -24902,7 +24903,10 @@ The
 function constructs a string object of a length specified
 by the
 .meta length
-parameter.  Every position in the string is initialized
+parameter. The
+.meta length
+parameter must be non-negative.
+Every position in the string is initialized
 with
 .metn char ,
 which must be a character value.
@@ -24911,6 +24915,35 @@ If the optional argument
 .meta char
 is not specified, it defaults to the space character.
 
+The
+.code str
+function resembles
+.codn mkstring ,
+and behaves the same way when the second argument
+is omitted, and when it is a character value.
+The second argument of
+.code str
+may be a
+.metn string ,
+in which case the newly created string is filled by
+taking successive characters from
+.metn string .
+If
+.meta string
+is longer than
+.metn length ,
+its excess characters are ignored. If
+.meta string
+is shorter, then characters are taken from the beginning again;
+.meta string
+is effectively taken as a fill pattern to be repeated as many times as
+necessary to provide the required number of characters.
+If
+.meta string
+is empty,
+.code str
+fills the new string with spaces.
+
 .coNP Function @ copy-str
 .synb
 .mets (copy-str << string )