From daeaa6121cc09b0429481b15d74152e350a8b4b1 Mon Sep 17 00:00:00 2001 From: Robert Mayer Date: Mon, 11 Nov 2024 06:18:46 +0100 Subject: [PATCH] added make-string-writer and use it in mlib with-output-to-string this also fixes fresh-line inside with-output-to-string --- CHANGES | 2 +- .../main/java/io/github/jmurmel/LambdaJ.java | 31 +++++++++++++++++-- murmel-langref.html | 14 +++++++++ murmel-langref.lisp | 14 +++++++++ murmel-langref.md | 14 +++++++++ murmel.completions | 1 + samples.murmel-mlib/mlib-test.lisp | 2 -- samples.murmel-mlib/mlib.lisp | 2 +- 8 files changed, 74 insertions(+), 6 deletions(-) diff --git a/CHANGES b/CHANGES index 7d0236d4..89bc91f3 100644 --- a/CHANGES +++ b/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 diff --git a/lambda/src/main/java/io/github/jmurmel/LambdaJ.java b/lambda/src/main/java/io/github/jmurmel/LambdaJ.java index d44dfa33..7d632547 100644 --- a/lambda/src/main/java/io/github/jmurmel/LambdaJ.java +++ b/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); diff --git a/murmel-langref.html b/murmel-langref.html index 0be4bf81..0ab13ab9 100644 --- a/murmel-langref.html +++ b/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 diff --git a/murmel-langref.lisp b/murmel-langref.lisp index ceb19344..9f7397dc 100644 --- a/murmel-langref.lisp +++ b/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 diff --git a/murmel-langref.md b/murmel-langref.md index e6ba64c7..4531c62c 100644 --- a/murmel-langref.md +++ b/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 diff --git a/murmel.completions b/murmel.completions index def234db..88825a6a 100644 --- a/murmel.completions +++ b/murmel.completions @@ -191,6 +191,7 @@ read write writeln fresh-line +make-string-writer lnwrite jformat jformat-locale diff --git a/samples.murmel-mlib/mlib-test.lisp b/samples.murmel-mlib/mlib-test.lisp index b5845af7..08737a2e 100644 --- a/samples.murmel-mlib/mlib-test.lisp +++ b/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 diff --git a/samples.murmel-mlib/mlib.lisp b/samples.murmel-mlib/mlib.lisp index 58f78b6e..2f38ef7e 100644 --- a/samples.murmel-mlib/mlib.lisp +++ 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))