added make-string-writer and use it in mlib with-output-to-string

this also fixes fresh-line inside with-output-to-string

CHANGES

@@ -7,7 +7,7 @@ Changes in JMurmel-1.5.0 relative to JMurmel-1.4.8
      error to jerror
  * changed defmacro: is now allowed inside labels forms
 
- * added fresh-line
+ * added fresh-line, make-string-writer
 
  * mlib: added format, formatter, error
 

lambda/src/main/java/io/github/jmurmel/LambdaJ.java

@@ -1208,7 +1208,7 @@ static ConsCell makeFeatureList(SymbolTable s) {
     }
 
     /** this class will write objects as S-expressions to the given {@link WriteConsumer} w/o any eol translation */
-    private static final class SExpressionWriter implements ObjectWriter {
+    private static class SExpressionWriter implements ObjectWriter {
         private static class ColumnCountingWriteConsumer implements WriteConsumer {
             private final @NotNull WriteConsumer wrapped;
             int col;
@@ -1241,6 +1241,22 @@ private static class ColumnCountingWriteConsumer implements WriteConsumer {
         }
     }
 
+    private static class StringSexpWriter extends SExpressionWriter implements CharSequence {
+        private StringBuilder sb;
+        private StringSexpWriter(@NotNull WriteConsumer out) { super(out); }
+
+        static StringSexpWriter make() {
+            final StringBuilder sb = new StringBuilder();
+            final StringSexpWriter ret = new StringSexpWriter(sb::append);
+            ret.sb = sb;
+            return ret;
+        }
+
+        @Override public int length() { return sb.length(); }
+        @Override public char charAt(int index) { return sb.charAt(index); }
+        @Override public CharSequence subSequence(int start, int end) { return sb.subSequence(start, end); }
+    }
+
 
 
     /// ## Scanner, symboltable and S-expression reader
@@ -2514,6 +2530,8 @@ enum WellknownSymbol {
         sLnwrite("lnwrite", Features.HAVE_IO, 0, 3)                    { @Override Object apply(LambdaJ intp, ConsCell args) { return lnwrite(intp.getLispPrinter(args, 2, intp.getLispPrinter()), args, cdr(args) == null || cadr(args) != null); } },
         sFreshLine("fresh-line", Features.HAVE_IO, 0, 1)               { @Override Object apply(LambdaJ intp, ConsCell args) { return intp.boolResult(freshLine(intp.getLispPrinter(args, 0, intp.getLispPrinter()))); } },
 
+        sMakeStringWriter("make-string-writer", Features.HAVE_IO, 0)   { @Override Object apply(LambdaJ intp, ConsCell args) { return LambdaJ.StringSexpWriter.make(); } },
+
         sJFormat("jformat", Features.HAVE_UTIL, 2, -1)                 { @Override Object apply(LambdaJ intp, ConsCell args) { return Subr.jformat(intp.getLispPrinter(args, 0, null), intp.have(Features.HAVE_IO), args); } },
         sJFormatLocale("jformat-locale", Features.HAVE_UTIL,3,-1)      { @Override Object apply(LambdaJ intp, ConsCell args) { return jformatLocale(intp.getLispPrinter(args, 0, null), intp.have(Features.HAVE_IO), args); } },
 
@@ -6683,6 +6701,7 @@ ObjectWriter getLispPrinter(ConsCell args, int nth, ObjectWriter defaultIfNull)
         final Object consumer = car(ccDest);
         if (consumer == null) return defaultIfNull;
         if (consumer == sT) return lispPrinter;
+        if (consumer instanceof ObjectWriter) return (ObjectWriter)consumer;
         if (consumer instanceof Appendable) return new SExpressionWriter(csq -> { try { ((Appendable)consumer).append(csq); } catch (IOException e) { wrap0(e); } });
         throw new SimpleTypeError("cannot coerce %s into a printer", printSEx(consumer));
     }
@@ -8309,6 +8328,7 @@ private ObjectWriter getLispPrinter(Object[] args, int nth, ObjectWriter default
             final Object consumer = args[nth];
             if (consumer == null) return defaultIfNull;
             if (consumer == sT) return lispPrinter;
+            if (consumer instanceof ObjectWriter) return (ObjectWriter)consumer;
             if (consumer instanceof Appendable) return new SExpressionWriter(csq -> { try { ((Appendable)consumer).append(csq); } catch (IOException e) { wrap0(e); } });
             throw new SimpleTypeError("cannot coerce %s into a printer", printSEx(consumer));
         }
@@ -8809,6 +8829,9 @@ private CompilerIteratorGenerator scanHashCompiler(Object hash) {
         public final Object freshLine         (Object... args)  { clrValues(); varargsMinMax("fresh-line",           args, 0, 1); return bool(LambdaJ.Subr.freshLine(getLispPrinter(args, 0, lispPrinter))); }
         public final Object freshLine         ()                { clrValues();                                                    return bool(LambdaJ.Subr.freshLine(lispPrinter)); }
 
+        public final Object makeStringWriter  (Object... args)  { clrValues(); noArgs("make-string-writer",          args);       return LambdaJ.StringSexpWriter.make(); }
+        public final Object makeStringWriter  ()                { clrValues();                                                    return LambdaJ.StringSexpWriter.make(); }
+
         public final Object _lnwrite          (Object... args)  { clrValues(); varargsMinMax("lnwrite",              args, 0, 3); return LambdaJ.Subr.lnwrite(getLispPrinter(args, 2, lispPrinter), arraySlice(args), noSecondArgOrNotNull(args)); }
 
         public final Object jformat           (Object... args)  { clrValues(); varargs2("jformat",                   args);       return LambdaJ.Subr.jformat(getLispPrinter(args, 0, null), true, arraySlice(args)); }
@@ -9647,6 +9670,7 @@ protected static void main(MurmelJavaProgram program) {
             case "write": return (CompilerPrimitive)this::_write;
             case "writeln": return (CompilerPrimitive)this::_writeln;
             case "fresh-line": return (CompilerPrimitive)this::freshLine;
+            case "make-string-writer": return (CompilerPrimitive)this::makeStringWriter;
             case "lnwrite": return (CompilerPrimitive)this::_lnwrite;
 
             case "jformat": return (CompilerPrimitive)this::jformat;
@@ -9872,7 +9896,7 @@ private static void notAPrimitive(String func, Object symbol, String javaName) {
         + "=@numbereq" + "\n" + "<=@le" + "\n" + "<@lt" + "\n" + ">=@ge" + "\n" + ">@gt" + "\n" + "/=@ne" + "\n"
         + "1+@inc" + "\n" + "1-@dec" + "\n"
         + "read-from-string@readFromStr" + "\n" + "read-textfile-lines@readTextfileLines" + "\n" + "read-textfile@readTextfile" + "\n"
-        + "fresh-line@freshLine" + "\n"
+        + "fresh-line@freshLine" + "\n" + "make-string-writer@makeStringWriter" + "\n"
         + "write-textfile-lines@writeTextfileLines" + "\n" + "write-textfile@writeTextfile" + "\n" + "write-to-string@writeToString" + "\n" + "jformat@jformat" + "\n" + "jformat-locale@jformatLocale" + "\n" + "char-code@charInt" + "\n" + "code-char@intChar" + "\n"
         + "string=@stringeq" + "\n" + "string->list@stringToList" + "\n" + "list->string@listToString" + "\n"
         + ADJUSTABLE_ARRAY_P+"@adjustableArrayP" + "\n" + "vector-add@vectorAdd" + "\n" + "vector-remove@vectorRemove" + "\n"
@@ -11881,6 +11905,9 @@ private boolean opencode(WrappingWriter sb, LambdaJSymbol op, ConsCell args, Con
                 if (args == null) { sb.append("freshLine()"); return true; }
                 break;
             }
+            case sMakeStringWriter: {
+                sb.append("makeStringWriter()"); return true;
+            }
             case sInc: {
                 if (consp(car(args)) && caar(args) == intern("1+")) {
                     emitCallPrimitive(sb, "incinc", (ConsCell)cdar(args), env, topEnv, rsfx);

murmel-langref.html

@@ -1281,6 +1281,20 @@
 Print an EOL character (-sequence) unless already at the beginning of line.
 
 
+### (make-string-writer) -> writer
+
+Since: 1.5
+
+Create a Lisp writer that writes to an internal buffer.
+The writer object can also be used as a string.
+
+    (define s (make-string-writer)) ; ==> s
+    (typep s 'string)               ; ==> t
+    (write 'abc nil s)              ; ==> abc
+    (slength s)                     ; ==> 3
+    (string->list s)                ; ==> (#\a #\b #\c)
+
+
 ### (write-to-string obj [print-escape-p]) -> result-string
 
 Since: 1.4

murmel-langref.lisp

@@ -1275,6 +1275,20 @@ pi ; ==> 3.141592653589793
 ; Print an EOL character (-sequence) unless already at the beginning of line.
 
 
+; = (make-string-writer) -> writer
+;
+; Since: 1.5
+;
+; Create a Lisp writer that writes to an internal buffer.
+; The writer object can also be used as a string.
+
+(define s (make-string-writer)) ; ==> s
+(typep s 'string)               ; ==> t
+(write 'abc nil s)              ; ==> abc
+(slength s)                     ; ==> 3
+(string->list s)                ; ==> (#\a #\b #\c)
+
+
 ; = (write-to-string obj [print-escape-p]) -> result-string
 ;
 ; Since: 1.4

murmel-langref.md

@@ -1272,6 +1272,20 @@ Since: 1.5
 Print an EOL character (-sequence) unless already at the beginning of line.
 
 
+### (make-string-writer) -> writer
+
+Since: 1.5
+
+Create a Lisp writer that writes to an internal buffer.
+The writer object can also be used as a string.
+
+    (define s (make-string-writer)) ; ==> s
+    (typep s 'string)               ; ==> t
+    (write 'abc nil s)              ; ==> abc
+    (slength s)                     ; ==> 3
+    (string->list s)                ; ==> (#\a #\b #\c)
+
+
 ### (write-to-string obj [print-escape-p]) -> result-string
 
 Since: 1.4

murmel.completions

@@ -191,6 +191,7 @@ read
 write
 writeln
 fresh-line
+make-string-writer
 lnwrite
 jformat
 jformat-locale

samples.murmel-mlib/mlib-test.lisp

@@ -2020,7 +2020,6 @@ all the result list to a single list. FUNCTION must return a list."
 
 
 ;; ~%
-#| todo ~& doesn't work yet with "(format nil..."
 (test "aaa
 bbb"
       "aaa~&bbb")
@@ -2037,7 +2036,6 @@ bbb"
 
 bbb"
       "aaa~v&bbb" 2)
-|#
 
 
 ;; B

samples.murmel-mlib/mlib.lisp

@@ -2852,7 +2852,7 @@
 ;;; CL's optional `string-form` and `element-type` are not supported,
 ;;; therefore the return value of `with-output-to-string` always is the string.
 (defmacro with-output-to-string (s . body)
-  `(let ((,@s (make-array 0 'character t)))
+  `(let ((,@s (make-string-writer)))
      ,@body
      ,@s))