This is the mail archive of the
kawa@sources.redhat.com
mailing list for the Kawa project.
Re: string-append/shared
Ok, try this patch. I left the old string-append around so that XQuery
could use it. It basically seemed like the correct implementation.
Also, please look at the change in Elisp.java. It uses the Scheme
string-append implementation with less conversions to java.lang.String.
Regards,
Chris Dean
Index: ChangeLog
===================================================================
RCS file: /cvs/kawa/kawa/ChangeLog,v
retrieving revision 1.377
diff -u -w -r1.377 ChangeLog
--- ChangeLog 23 Sep 2003 15:53:03 -0000 1.377
+++ ChangeLog 28 Sep 2003 17:11:33 -0000
@@ -6,6 +6,11 @@
* configure.in (AC_LINK_FILES): Add gnu/xquery/testsuite/outline.xml.
+2003-09-13 Chris Dean <Chris.Dean@sokitomi.com>
+
+ * kawa/standard/Scheme.java (LispInterpreter): definition for
+ string-append/shared, redefine string-append
+
2003-09-08 Per Bothner <per@bothner.com>
* kawa/lang/Translator.java (rewrite): Resolve hygiene using
Index: gnu/jemacs/lang/ELisp.java
===================================================================
RCS file: /cvs/kawa/kawa/gnu/jemacs/lang/ELisp.java,v
retrieving revision 1.29
diff -u -w -r1.29 ELisp.java
--- gnu/jemacs/lang/ELisp.java 28 Oct 2002 21:47:55 -0000 1.29
+++ gnu/jemacs/lang/ELisp.java 28 Sep 2003 17:11:33 -0000
@@ -155,7 +155,7 @@
defun("save-current-buffer", new gnu.jemacs.lang.SaveExcursion(true));
defun("let", new kawa.standard.fluid_let(false, nilExpr));
defun("let*", new kawa.standard.fluid_let(true, nilExpr));
- defun("concat", new kawa.standard.string_append());
+ define_field ("concat", "kawa.lib.strings", "string$Mnappend");
Procedure not = new kawa.standard.not(this);
defun("not", not);
defun("null", not);
Index: gnu/lists/ChangeLog
===================================================================
RCS file: /cvs/kawa/kawa/gnu/lists/ChangeLog,v
retrieving revision 1.61
diff -u -w -r1.61 ChangeLog
--- gnu/lists/ChangeLog 24 Sep 2003 17:55:13 -0000 1.61
+++ gnu/lists/ChangeLog 28 Sep 2003 17:11:33 -0000
@@ -14,6 +14,12 @@
* TreeList.java (newMatching): New method, based on nextMatchingChild.
(nextMatchingChild): Remove.
+2003-09-13 Chris Dean <Chris.Dean@sokitomi.com>
+
+ * FString.java (addAll): new method to add an FString directly.
+ * FString.java (addAllStrings): new method to add an array of
+ FStrings.
+
2003-09-09 Per Bothner <per@bothner.com>
* AbstractSequence.java (nextIndex): Use getIndexDifference.
Index: gnu/lists/FString.java
===================================================================
RCS file: /cvs/kawa/kawa/gnu/lists/FString.java,v
retrieving revision 1.8
diff -u -w -r1.8 FString.java
--- gnu/lists/FString.java 10 Jan 2003 04:49:38 -0000 1.8
+++ gnu/lists/FString.java 28 Sep 2003 17:11:33 -0000
@@ -202,6 +202,42 @@
return new FString(copy);
}
+ public boolean addAll(FString s)
+ {
+ int newSize = size + s.size;
+ if (data.length < newSize)
+ setBufferLength(newSize);
+ System.arraycopy(s.data, 0, data, size, s.size);
+ size = newSize;
+ return s.size > 0;
+ }
+
+ public boolean addAllStrings(Object[] args)
+ {
+ return addAllStrings(args, 0);
+ }
+
+ public boolean addAllStrings(Object[] args, int startIndex)
+ {
+ int total = size;
+ for (int i = startIndex; i < args.length; ++i)
+ {
+ total += ((FString) args[i]).size;
+ }
+ setBufferLength(total);
+
+ boolean changed = false;
+ for (int i = startIndex; i < args.length; ++i)
+ {
+ if (addAll((FString) args[i]))
+ {
+ changed = true;
+ }
+ }
+
+ return changed;
+ }
+
public String toString ()
{
return new String (data, 0, size);
Index: kawa/lib/strings.scm
===================================================================
RCS file: /cvs/kawa/kawa/kawa/lib/strings.scm,v
retrieving revision 1.14
diff -u -w -r1.14 strings.scm
--- kawa/lib/strings.scm 4 Aug 2002 21:17:04 -0000 1.14
+++ kawa/lib/strings.scm 28 Sep 2003 17:11:33 -0000
@@ -109,3 +109,17 @@
(let ((copy :: <string> (string-copy str)))
(invoke-static <gnu.lists.Strings> 'makeCapitalize copy)
copy))
+
+(define (string-append #!rest (args :: <Object[]>)) :: <string>
+ (let ((str :: <string> (make <string>)))
+ (invoke str 'addAllStrings args)
+ str))
+
+(define (string-append/shared #!rest (args :: <Object[]>)) :: <string>
+ (if (= 0 ((primitive-array-length <Object>) args))
+ (make <string>)
+ (let ((arg1 :: <string> ((primitive-array-get <Object>) args 0)))
+ (invoke arg1 'addAllStrings args 1)
+ arg1)))
+
+
Index: kawa/standard/Scheme.java
===================================================================
RCS file: /cvs/kawa/kawa/kawa/standard/Scheme.java,v
retrieving revision 1.140
diff -u -w -r1.140 Scheme.java
--- kawa/standard/Scheme.java 4 Sep 2003 18:41:30 -0000 1.140
+++ kawa/standard/Scheme.java 28 Sep 2003 17:11:34 -0000
@@ -304,7 +304,8 @@
define_field ("string-ci>=?", "kawa.lib.strings");
define_proc ("substring", "kawa.lib.strings");
- define_proc ("string-append", "kawa.standard.string_append");
+ define_proc ("string-append", "kawa.lib.strings");
+ define_proc ("string-append/shared", "kawa.lib.strings");
define_field("string->list", "kawa.lib.strings");
define_field("list->string", "kawa.lib.strings");
define_proc ("string-copy", "kawa.lib.strings");
Index: kawa/standard/string_append.java
===================================================================
RCS file: /cvs/kawa/kawa/kawa/standard/string_append.java,v
retrieving revision 1.8
diff -u -w -r1.8 string_append.java
--- kawa/standard/string_append.java 2 Jul 2002 22:15:12 -0000 1.8
+++ kawa/standard/string_append.java 28 Sep 2003 17:11:34 -0000
@@ -3,13 +3,13 @@
import gnu.mapping.*;
/**
- * Implement the Scheme standard function "string-append".
+ * Implement the function "concat" used in XQuery.
* @author R. Alexander Milowski
*/
public class string_append extends ProcedureN
{
- public static FString stringAppend$V (Object[] args)
+ public static String stringAppend$V (Object[] args)
{
int count = args.length;
java.lang.StringBuffer result = new java.lang.StringBuffer();
@@ -18,7 +18,7 @@
{
result.append(args[t]);
}
- return new FString (result);
+ return result.toString();
}
public Object applyN (Object[] args)
Index: testsuite/ChangeLog
===================================================================
RCS file: /cvs/kawa/kawa/testsuite/ChangeLog,v
retrieving revision 1.125
diff -u -w -r1.125 ChangeLog
--- testsuite/ChangeLog 11 Sep 2003 18:57:49 -0000 1.125
+++ testsuite/ChangeLog 28 Sep 2003 17:11:34 -0000
@@ -1,7 +1,11 @@
+2003-09-13 Chris Dean <Chris.Dean@sokitomi.com>
+
+ * misc-test.scm: added string-append/shared tests
+
2003-09-11 Per Bothner <per@bothner.com>
* testing.scm (test): Catch exception.
- * misc-test.scm: New generic procedure tests. One is expected to fsil.
+ * misc-test.scm: New generic procedure tests. One is expected to fail.
2003-09-08 Per Bothner <per@bothner.com>
Index: testsuite/misc-test.scm
===================================================================
RCS file: /cvs/kawa/kawa/testsuite/misc-test.scm,v
retrieving revision 1.39
diff -u -w -r1.39 misc-test.scm
--- testsuite/misc-test.scm 11 Sep 2003 18:57:49 -0000 1.39
+++ testsuite/misc-test.scm 28 Sep 2003 17:11:34 -0000
@@ -1,4 +1,4 @@
-(test-init "Miscellaneous" 121)
+(test-init "Miscellaneous" 126)
;;; DSSSL spec example 11
(test '(3 4 5 6) (lambda x x) 3 4 5 6)
@@ -547,3 +547,11 @@
(define (not-a) ((lambda (x) (not x)) 'a))
(test #f not-a)
+
+;;; Test SRFI-13 string-append/shared
+(let ((str "abc"))
+ (test "" string-append/shared)
+ (test "" string-append/shared "")
+ (test "abc" string-append/shared str)
+ (test "abc123xy" string-append/shared str "123" "xy")
+ (test #t equal? "abc123xy" str))