summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--eval.c2
-rw-r--r--filter.c4
-rw-r--r--lib.c32
-rw-r--r--lib.h2
-rw-r--r--parser.y8
-rw-r--r--regex.c2
-rw-r--r--txr.121
-rw-r--r--y.tab.c.shipped8
8 files changed, 49 insertions, 30 deletions
diff --git a/eval.c b/eval.c
index 3dbbbf03..74ab1703 100644
--- a/eval.c
+++ b/eval.c
@@ -7143,7 +7143,7 @@ void eval_init(void)
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));
- reg_fun(intern(lit("string-extend"), user_package), func_n2(string_extend));
+ reg_fun(intern(lit("string-extend"), user_package), func_n3o(string_extend, 2));
reg_fun(intern(lit("stringp"), user_package), func_n1(stringp));
reg_fun(intern(lit("lazy-stringp"), user_package), func_n1(lazy_stringp));
reg_fun(intern(lit("length-str"), user_package), func_n1(length_str));
diff --git a/filter.c b/filter.c
index fa846483..4e77ebe3 100644
--- a/filter.c
+++ b/filter.c
@@ -292,10 +292,10 @@ static val trie_filter_string(val filter, val str)
}
if (match) {
- string_extend(out, subst);
+ string_extend(out, subst, nil);
i = plus(match, one);
} else {
- string_extend(out, chr_str(str, i));
+ string_extend(out, chr_str(str, i), nil);
i = plus(i, one);
}
}
diff --git a/lib.c b/lib.c
index 68a12ae6..ee74ff89 100644
--- a/lib.c
+++ b/lib.c
@@ -2061,7 +2061,7 @@ val str_seq(val seq)
while (seq_get(&iter, &elem)) {
if (chrp(elem) || stringp(elem))
- string_extend(str, elem);
+ string_extend(str, elem, nil);
else
unsup_obj(self, elem);
}
@@ -3002,7 +3002,7 @@ static val rem_impl(val (*eqfun)(val, val), val name,
val key = keyfun ? funcall1(keyfun, elem) : elem;
if (!eqfun(key, obj))
- string_extend(out, elem);
+ string_extend(out, elem, tnil(i == len - 1));
}
return out;
@@ -3071,7 +3071,7 @@ val remove_if(val pred, val seq_in, val keyfun_in)
val key = keyfun ? funcall1(keyfun, elem) : elem;
if (!funcall1(pred, key))
- string_extend(out, elem);
+ string_extend(out, elem, tnil(i == len - 1));
}
return out;
@@ -3190,7 +3190,7 @@ val separate(val pred, val seq_in, val keyfun_in)
val elem = chr_str(str, num_fast(i));
val key = keyfun ? funcall1(keyfun, elem) : elem;
- string_extend(funcall1(pred, key) ? yea : nay, elem);
+ string_extend(funcall1(pred, key) ? yea : nay, elem, tnil(i == len - 1));
}
return cons(yea, cons(nay, nil));
@@ -4791,12 +4791,13 @@ val downcase_str(val str)
return out;
}
-val string_extend(val str, val tail)
+val string_extend(val str, val tail, val finish_in)
{
val self = lit("string-extend");
type_check(self, str, STR);
{
+ val finish = default_null_arg(finish_in);
cnum len = c_fixnum(length_str(str), self);
cnum oalloc = c_fixnum(str->st.alloc, self), alloc = oalloc;
cnum delta, needed;
@@ -4815,17 +4816,16 @@ val string_extend(val str, val tail)
needed = len + delta + 1;
- if (needed > alloc) {
- if (alloc >= (NUM_MAX - NUM_MAX / 5))
+ if (needed > alloc || finish) {
+ if (finish)
+ alloc = needed;
+ else if (alloc >= (NUM_MAX - NUM_MAX / 5))
alloc = NUM_MAX;
else
alloc = max(alloc + alloc / 4, needed);
if (alloc != oalloc) {
- str->st.str = coerce(wchar_t *,
- chk_grow_vec(coerce(mem_t *, str->st.str),
- oalloc, alloc,
- sizeof *str->st.str));
+ str->st.str = chk_wrealloc(str->st.str, alloc);
set(mkloc(str->st.alloc, str), num_fast(alloc));
}
}
@@ -5286,7 +5286,7 @@ val replace_str(val str_in, val items, val from, val to)
cnum t = c_num(to, self);
cnum l = c_num(len, self);
- string_extend(str_in, len_diff);
+ string_extend(str_in, len_diff, one);
wmemmove(str_in->st.str + t + c_num(len_diff, self),
str_in->st.str + t, (l - t) + 1);
to = plus(from, len_it);
@@ -9328,8 +9328,8 @@ val lazy_str_force(val lstr)
val next = pop(&lstr->ls.list);
if (!next)
break;
- string_extend(pfx, next);
- string_extend(pfx, term);
+ string_extend(pfx, next, nil);
+ string_extend(pfx, term, nil);
if (lim)
lim = minus(lim, one);
}
@@ -9402,8 +9402,8 @@ val lazy_str_force_upto(val lstr, val index)
val next = pop(&lstr->ls.list);
if (!next)
break;
- string_extend(pfx, next);
- string_extend(pfx, term);
+ string_extend(pfx, next, nil);
+ string_extend(pfx, term, nil);
if (lim)
lim = minus(lim, one);
len = plus(len, length_str(next));
diff --git a/lib.h b/lib.h
index be62cf21..4c6993e6 100644
--- a/lib.h
+++ b/lib.h
@@ -884,7 +884,7 @@ val init_str(val str, const wchar_t *, val self);
val copy_str(val str);
val upcase_str(val str);
val downcase_str(val str);
-val string_extend(val str, val tail);
+val string_extend(val str, val tail, val finish);
val stringp(val str);
val lazy_stringp(val str);
val length_str(val str);
diff --git a/parser.y b/parser.y
index efc2bd3c..9bac3254 100644
--- a/parser.y
+++ b/parser.y
@@ -1434,15 +1434,15 @@ quasi_item : litchars { $$ = $1; }
litchars : LITCHAR { $$ = mkstring(one, chr($1)); }
| LITCHAR restlitchar { val ch = mkstring(one, chr($1));
- $$ = string_extend(ch, $2); }
+ $$ = string_extend(ch, $2, t); }
| TEXT { $$ = string_own($1); }
- | TEXT restlitchar { $$ = string_extend(string_own($1), $2); }
+ | TEXT restlitchar { $$ = string_extend(string_own($1), $2, t); }
;
restlitchar : LITCHAR { $$ = mkstring(one, chr($1)); }
- | restlitchar LITCHAR { $$ = string_extend($1, chr($2)); }
+ | restlitchar LITCHAR { $$ = string_extend($1, chr($2), nil); }
| TEXT { $$ = string_own($1); }
- | restlitchar TEXT { $$ = string_extend($1, string_own($2)); }
+ | restlitchar TEXT { $$ = string_extend($1, string_own($2), nil); }
;
wordslit : '"' { $$ = nil; }
diff --git a/regex.c b/regex.c
index b987169d..7cf22f45 100644
--- a/regex.c
+++ b/regex.c
@@ -3179,7 +3179,7 @@ static val scan_until_common(val self, val regex, val stream_in,
if (!out)
out = mkstring(one, ch);
else
- string_extend(out, ch);
+ string_extend(out, ch, nil);
} else {
count++;
}
diff --git a/txr.1 b/txr.1
index 6654abc0..971391f3 100644
--- a/txr.1
+++ b/txr.1
@@ -24296,7 +24296,7 @@ lowercase counterparts.
.coNP Function @ string-extend
.synb
-.mets (string-extend < string << tail )
+.mets (string-extend < string < tail <> [ final ])
.syne
.desc
The
@@ -24320,6 +24320,25 @@ The string appears to be the original one because of an internal terminating
null character remains in place, but the characters beyond the terminating zero
are indeterminate.
+The optional Boolean argument
+.metn final ,
+defaulting to
+.codn nil ,
+is a hint which indicates whether this
+.code string-extend
+call is expected to be the last time that the function
+is invoked on the given
+.metn string .
+If
+.meta final
+is true, then the
+.meta string
+object's underlying memory allocation is trimmed to fit the actual
+string data. If the argument is false, the object may be given a larger
+allocation intended to improves the performance of subsequent
+.code string-extend
+calls.
+
.coNP Function @ stringp
.synb
.mets (stringp << obj )
diff --git a/y.tab.c.shipped b/y.tab.c.shipped
index 34fc7b4b..c0721d96 100644
--- a/y.tab.c.shipped
+++ b/y.tab.c.shipped
@@ -6656,7 +6656,7 @@ yyreduce:
/* Line 1806 of yacc.c */
#line 1436 "parser.y"
{ val ch = mkstring(one, chr((yyvsp[(1) - (2)].chr)));
- (yyval.val) = string_extend(ch, (yyvsp[(2) - (2)].val)); }
+ (yyval.val) = string_extend(ch, (yyvsp[(2) - (2)].val), t); }
break;
case 430:
@@ -6670,7 +6670,7 @@ yyreduce:
/* Line 1806 of yacc.c */
#line 1439 "parser.y"
- { (yyval.val) = string_extend(string_own((yyvsp[(1) - (2)].lexeme)), (yyvsp[(2) - (2)].val)); }
+ { (yyval.val) = string_extend(string_own((yyvsp[(1) - (2)].lexeme)), (yyvsp[(2) - (2)].val), t); }
break;
case 432:
@@ -6684,7 +6684,7 @@ yyreduce:
/* Line 1806 of yacc.c */
#line 1443 "parser.y"
- { (yyval.val) = string_extend((yyvsp[(1) - (2)].val), chr((yyvsp[(2) - (2)].chr))); }
+ { (yyval.val) = string_extend((yyvsp[(1) - (2)].val), chr((yyvsp[(2) - (2)].chr)), nil); }
break;
case 434:
@@ -6698,7 +6698,7 @@ yyreduce:
/* Line 1806 of yacc.c */
#line 1445 "parser.y"
- { (yyval.val) = string_extend((yyvsp[(1) - (2)].val), string_own((yyvsp[(2) - (2)].lexeme))); }
+ { (yyval.val) = string_extend((yyvsp[(1) - (2)].val), string_own((yyvsp[(2) - (2)].lexeme)), nil); }
break;
case 436: