ret = new ArrayList<>();
((ConsCell) maybeList).forEach(ret::add); // todo forEach behandelt dotted und proper lists gleich -> im interpreter gibt (apply < '(1 2 3 4 . 5)) einen fehler, im compiler nicht
//for (Object rest = maybeList; rest != null; rest = cdr(rest)) ret.add(car(rest));
return ret.toArray();
}
static Object[] listToArray(ConsCell lst, int len) {
if (lst == null) {
if (len == 0) return EMPTY_ARRAY;
errorReaderErrorFmt("", VECTOR + " of length %d cannot be initialized from ()", len); // todo posinfo
assert false; //notreached
}
if (len < 0) len = listLength(lst);
final Object[] ret = new Object[len];
int i = 0;
for (Object o: lst) {
if (i == len) errorReaderErrorFmt("", VECTOR + " is longer than the specified length: #%d%s", len, printSEx(lst)); // todo posinfo
ret[i++] = o;
}
final Object last = ret[i-1];
if (last != null) Arrays.fill(ret, i, len, last);
return ret;
}
enum CompareMode { NUMBER, EQL, EQUAL }
/** compare two objects. {@code mode} determines which types are compared by their value and which are compared by their identity.
*
* Implementation note: this relies on the hope that {@link System#identityHashCode(Object)} will return different values for different objects that are not numbers.
* This is strongly suggested but not guaranteed by the Java spec:
* "As much as is reasonably practical, the hashCode method defined by class {@code Object}
* does return distinct integers for distinct objects." */
static int compare(Object o1, Object o2, CompareMode mode) {
if (o1 == o2) return 0;
if (o1 == null) return -1;
if (o2 == null) return 1;
if (integerp(o1) && integerp(o2)) {
if (o1 instanceof BigInteger && o2 instanceof BigInteger) return ((BigInteger)o1).compareTo((BigInteger)o2);
if (o1 instanceof BigInteger) return ((BigInteger)o1).compareTo(BigInteger.valueOf(((Number)o2).longValue()));
if (o2 instanceof BigInteger) return BigInteger.valueOf(((Number)o1).longValue()).compareTo((BigInteger)o2);
return Long.compare(((Number)o1).longValue(), ((Number)o2).longValue());
}
if (floatp(o1) && floatp(o2)) {
if (o1.getClass() != o2.getClass()) return System.identityHashCode(o1) - System.identityHashCode(o2);
if (o1 instanceof BigDecimal && o2 instanceof BigDecimal) return ((BigDecimal)o1).compareTo((BigDecimal)o2);
return Double.compare(((Number)o1).doubleValue(), ((Number)o2).doubleValue());
}
if (mode == CompareMode.NUMBER) return compareHash(o1, o2);
if (o1 instanceof Character && o2 instanceof Character) { return ((Character)o1).compareTo((Character)o2); }
if (mode == CompareMode.EQL) return compareHash(o1, o2);
if (o1 instanceof CharSequence) {
if (o2 instanceof CharSequence) return JavaUtil.compare((CharSequence)o1, (CharSequence)o2);
if (o2 instanceof char[]) return JavaUtil.compare((CharSequence)o1, (char[])o2);
}
if (o1 instanceof char[]) {
if (o2 instanceof CharSequence) return -JavaUtil.compare((CharSequence)o2, (char[])o1);
if (o2 instanceof char[]) return JavaUtil.compare((char[])o1, (char[])o2);
}
if (bitvectorp(o1) && bitvectorp(o2)) { return Bitvector.of(o1).compareTo(Bitvector.of(o2)); }
if (consp(o1) && consp(o2)) { //noinspection ConstantConditions
return ((ConsCell)o1).compareToEqual((ConsCell)o2); }
return compareHash(o1, o2);
}
private static int compareHash(@NotNull Object o1, @NotNull Object o2) { return Integer.compare(System.identityHashCode(o1), System.identityHashCode(o2)); }
static int sxhashSigned(Object o) {
if (o == null) return 97;
if (integerp(o)) return Long.hashCode(((Number)o).longValue()); // byte..BigInteger have different hash codes for negative numbers
if (o instanceof StringBuilder) return o.toString().hashCode();
if (o instanceof StringBuffer) return o.toString().hashCode();
if (o instanceof char[]) return String.valueOf((char[])o).hashCode();
if (o instanceof boolean[]) return Bitvector.of(o).hashCode();
if (symbolp(o) || characterp(o) || numberp(o) || consp(o) || stringp(o) || bitvectorp(o)) return o.hashCode();
return o.getClass().getName().hashCode(); // see https://stackoverflow.com/questions/21126507/why-does-sxhash-return-a-constant-for-all-structs
}
static Object macroexpandImpl(@NotNull LambdaJ intp, @NotNull ConsCell form, MacroEnv macroEnv) {
final Object maybeSymbol = car(form);
if (maybeSymbol == null || !symbolp(maybeSymbol)) {
intp.values = intp.cons(form, intp.cons(null, null));
return form;
}
final LambdaJSymbol macroSymbol = (LambdaJSymbol)maybeSymbol;
final Closure macroClosure;
final MacroEntry e;
if (macroEnv != null && (e = macroEnv.get(macroSymbol)) != null) macroClosure = e.macroFun;
else macroClosure = macroSymbol.macro;
if (macroClosure == null) {
intp.values = intp.cons(form, intp.cons(null, null));
return form;
}
final ConsCell arguments = (ConsCell) cdr(form);
final Object expansion = intp.evalMacro(macroSymbol, macroClosure, arguments);
intp.values = intp.cons(expansion, intp.cons(sT, null));
return expansion;
}
/** transform {@code obj} into an S-expression, atoms are escaped */
static CharSequence printSEx(Object obj) {
return printSEx(obj, true);
}
static CharSequence printSEx(Object obj, boolean printEscape) {
if (obj == null) return NIL;
final StringBuilder sb = new StringBuilder();
_printSEx(sb::append, obj, obj, printEscape);
return sb;
}
static void printSEx(@NotNull WriteConsumer w, Object obj) {
_printSEx(w, obj, obj, true);
}
static void printSEx(@NotNull WriteConsumer w, Object obj, boolean printEscape) {
_printSEx(w, obj, obj, printEscape);
}
static void _printSEx(@NotNull WriteConsumer sb, Object list, Object obj, boolean escapeAtoms) {
boolean headOfList = true;
while (true) {
if (obj instanceof ArraySlice) { sb.print(((ArraySlice)obj).printSEx(headOfList, escapeAtoms)); return; }
else if (consp(obj)) {
if (headOfList) sb.print("(");
final Object first = car(obj);
if (first == list) { sb.print(headOfList ? "#" : "#"); }
else { _printSEx(sb, first, first, escapeAtoms); }
final Object rest = cdr(obj);
if (rest != null) {
if (consp(rest)) {
sb.print(" ");
if (list == rest) { sb.print("#)"); return; }
else { obj = rest; headOfList = false; } // continue loop
}
else { sb.print(" . "); printAtom(sb, rest, escapeAtoms); sb.print(")"); return; }
}
else { sb.print(")"); return; }
}
else { printAtom(sb, obj, escapeAtoms); return; }
}
}
private static void printAtom(@NotNull WriteConsumer sb, Object atom, boolean escapeAtoms) {
if (atom instanceof Writeable) { ((Writeable)atom).printSEx(sb, escapeAtoms); }
else if (escapeAtoms && characterp(atom)) { sb.print(printChar((int)(Character)atom)); }
else if (vectorp(atom)) { printVector(sb, atom, escapeAtoms); }
else if (hashtablep(atom)) { printHash(sb, (Map, ?>)atom, escapeAtoms); }
else if (atom == null) { sb.print(NIL); }
else if (atom instanceof CharSequence) { sb.print((CharSequence)atom); }
else if (randomstatep((atom))) { sb.print("#"); }
else { sb.print(atom.toString()); }
}
static String printChar(int c) {
return "#\\"
+ (c < CTRL.length ? CTRL[c]
: c < 127 ? String.valueOf((char)c)
: String.valueOf(c));
}
/** prepend " and \ by a \ */
static CharSequence escapeString(CharSequence s) {
if (s == null) return null;
if (s.length() == 0) return "";
final StringBuilder ret = new StringBuilder();
final int len = s.length();
for (int i = 0; i < len; i++) {
final char c = s.charAt(i);
switch (c) {
case '\"': ret.append("\\\""); break;
case '\\': ret.append("\\\\"); break;
default: ret.append(c);
}
}
return ret;
}
@SuppressWarnings("rawtypes")
private static void printVector(@NotNull WriteConsumer sb, Object vector, boolean escapeAtoms) {
if (vector instanceof boolean[]) {
sb.print("#*");
for (boolean b: (boolean[])vector) {
sb.print(b ? "1" : "0");
}
return;
}
if (vector instanceof char[]) {
if (escapeAtoms) sb.print("\"" + escapeString(new String((char[])vector)) + '"');
else sb.print(new String((char[])vector));
return;
}
if (vector instanceof CharSequence) {
if (escapeAtoms) sb.print("\"" + escapeString((CharSequence)vector) + '"');
else sb.print(((CharSequence)vector));
return;
}
sb.print("#(");
if (vector instanceof Object[]) {
boolean first = true;
for (Object o: (Object[])vector) {
if (first) first = false;
else sb.print(" ");
_printSEx(sb, o, o, escapeAtoms);
}
}
else if (vector instanceof List) {
boolean first = true;
for (Object o: (List)vector) {
if (first) first = false;
else sb.print(" ");
_printSEx(sb, o, o, escapeAtoms);
}
}
else throw errorNotImplemented("printing vectors of class %s is not implemented", vector.getClass().getSimpleName());
sb.print(")");
}
private static void printHash(@NotNull WriteConsumer out, Map,?> map, boolean escapeAtoms) {
assert !(map instanceof EqlMap) && !(map instanceof EqualMap) : "should be printed using Writable.printSEx()";
if (map instanceof EqlTreeMap) out.print("#H(compare-eql");
else if (map instanceof EqualTreeMap) out.print("#H(compare-equal");
else if (map instanceof IdentityHashMap) out.print("#H(eq");
else out.print("#H(t");
for (Map.Entry,?> entry: map.entrySet()) {
out.print(" "); printSEx(out, entry.getKey(), escapeAtoms);
out.print(" "); printSEx(out, entry.getValue(), escapeAtoms);
}
out.print(")");
}
/// ## Error "handlers"
static void errorReaderError (String errorLoc, String msg) { wrap0(new ReaderError(msg), errorLoc); }
static void errorReaderErrorFmt (String errorLoc, String msg, Object... args) { wrap0(new ReaderError(msg, args), errorLoc); }
static RuntimeException errorNotImplemented (String msg, Object... args) { throw new LambdaJError(true, msg, args); }
static RuntimeException errorInternal (String msg, Object... args) { throw new LambdaJError(true, "internal error - " + msg, args); }
static RuntimeException errorInternal (Throwable t, String msg, Object... args) { throw new LambdaJError(t, true, "internal error - " + msg, args); }
static RuntimeException errorMalformed (String func, String msg) { throw new ProgramError("%s: malformed %s: %s", func, func, msg); }
static RuntimeException errorMalformedFmt (String func, String msg, Object... params) { return errorMalformed(func, String.format(msg, params)); }
static RuntimeException errorMalformed (String func, String expected, Object actual) { throw new ProgramError("%s: malformed %s: expected %s but got %s", func, func, expected, printSEx(actual)); }
static void errorReserved (String op, Object sym) { errorMalformedFmt(op, "can't use reserved word %s as a symbol", sym == null ? NIL : sym); }
static RuntimeException errorUnbound (String func, Object form) { throw new UnboundVariable("%s: '%s' is not bound", func, printSEx(form)); }
@SuppressWarnings("SameParameterValue")
static void errorUnassigned (String func, Object form) { throw new UnboundVariable("%s: '%s' is bound but has no assigned value", func, printSEx(form)); }
static RuntimeException errorNotAFunction (String msg, CharSequence name) { throw new UndefinedFunction(msg, name); }
/** throws a {@link SimpleTypeError} with a message of "'func': expected a 'expected' argument but got 'actual'" */
static RuntimeException errorArgTypeError(String expected, String func, Object actual) { throw new SimpleTypeError("%s: expected a %s argument but got %s", func, expected, printSEx(actual)); }
static RuntimeException errorNotANumber (String func, Object actual) { throw errorArgTypeError("number", func, actual); }
static RuntimeException errorNotAnInteger (String func, Object actual) { throw errorArgTypeError("integral number", func, actual); }
static void errorNotAFixnum (String msg) { throw new ArithmeticException(msg); }
static RuntimeException errorNotABit (String func, Object actual) { throw errorArgTypeError("bit", func, actual); }
static RuntimeException errorNotAVector (String func, Object actual) { throw errorArgTypeError(VECTOR, func, actual); }
static RuntimeException errorNotASimpleVector(String func, Object actual) { throw errorArgTypeError("simple " + VECTOR, func, actual); }
static void errorNotAString (String func, Object actual) { throw errorArgTypeError("string", func, actual); }
static RuntimeException errorNotABitVector (String func, Object actual) { throw errorArgTypeError("bitvector", func, actual); }
static void errorNotACons (String func, Object actual) { throw errorArgTypeError(CONS, func, actual); }
static void errorNotAList (String func, Object actual) { throw errorArgTypeError(LIST, func, actual); }
@SuppressWarnings("SameParameterValue")
static void errorNotASequence (String func, Object actual) { throw errorArgTypeError("list or " + VECTOR, func, actual); }
static RuntimeException errorOverflow (String func, String targetType, Object n) { throw new ArithmeticException(String.format("%s: value cannot be represented as a %s: %s", func, targetType, n)); }
static RuntimeException errorIndexTooLarge (long idx, long actualLength) { throw new InvalidIndexError("index %d is too large for a sequence of length %d", idx, actualLength); }
static void errorVarargsCount (String func, int min, int actual) { throw new ProgramError("%s: expected %s or more but %s", func, expectedArgPhrase(min), actualArgPhrase(actual)); }
static void errorArgCount(String func, int expectedMin, int expectedMax, int actual, Object form) {
final String argPhrase = expectedMin == expectedMax
? expectedArgPhrase(expectedMin)
: expectedMin + " to " + expectedMax + " arguments";
if (actual < expectedMin) { throw new ProgramError("%s: expected %s but %s", func, argPhrase, actualArgPhrase(actual)); }
if (actual > expectedMax) { throw new ProgramError("%s: expected %s but got extra arg(s) %s", func, argPhrase, printSEx(nthcdr(expectedMax, form))); }
assert false: "errorArgCount was called, but there is no error";
}
private static String expectedArgPhrase(int expected) { return expected == 0 ? "no arguments" : expected == 1 ? "one argument" : expected == 2 ? "two arguments" : expected + " arguments"; }
private static String actualArgPhrase(int actual) { return actual == 0 ? "no argument was given" : actual == 1 ? "only one argument was given" : "got only " + actual; }
/// ## Error checking functions, used by interpreter and primitives
/** a must be the empty list */
static void noArgs(String func, ConsCell a) {
if (a != null) errorArgCount(func, 0, 0, 1, a);
}
/** ecactly one argument */
static void oneArg(String func, ConsCell a) {
if (a == null) errorArgCount(func, 1, 1, 0, null);
if (cdr(a) != null) errorArgCount(func, 1, 1, 2, a);
}
/** ecactly two arguments */
static void twoArgs(String func, ConsCell a) {
if (a == null) errorArgCount(func, 2, 2, 0, null);
Object _a = cdr(a);
if (_a == null) errorArgCount(func, 2, 2, 1, a);
_a = cdr(_a);
if (_a != null) errorArgCount(func, 2, 2, 3, a);
}
/** ecactly three arguments */
static void threeArgs(String func, ConsCell a) {
if (a == null) errorArgCount(func, 3, 3, 0, null);
Object _a = cdr(a);
if (_a == null) errorArgCount(func, 3, 3, 1, a);
_a = cdr(_a);
if (_a == null) errorArgCount(func, 3, 3, 2, a);
_a = cdr(_a);
if (_a != null) errorArgCount(func, 3, 3, 4, a);
}
/* varargs, 0 or 1 arg * /
static void varargs0_1(String func, ConsCell a) {
if (cdr(a) != null) errorArgCount(func, 0, 1, listLength(a), a);
}*/
/** varargs, at least one arg */
static void varargs1(String func, ConsCell a) {
if (a == null) errorVarargsCount(func, 1, 0);
}
static void varargs1_2(String func, ConsCell a) {
if (a == null || cddr(a) != null) errorArgCount(func, 1, 2, listLength(a), a);
}
/** varargs, at least {@code min} args */
static void varargsMin(String func, ConsCell a, int min) {
final Object x = nthcdr(min-1, a);
if (x == null) errorVarargsCount(func, min, listLength(a));
}
/** varargs, between {@code min} and {@code max} args */
static void varargsMinMax(String func, ConsCell a, int min, int max) {
if (min == 0 && a == null) return;
final Object x = nthcdr(min-1, a);
final int n = min == 0 ? 0 : min-1;
if (x == null || nthcdr(max-n, x) != null) errorArgCount(func, min, max, listLength(a), a);
}
///
/// ## Summary
/// That's (almost) all, folks.
///
/// At this point we have reached the end of the Murmel interpreter core, i.e. we have everything needed
/// to read S-Expressions and eval() them in an environment.
///
/// The rest of this file contains Murmel primitives and driver functions such as interpretExpression/s and main
/// for interactive use.
///
/// And a compiler Murmel to Java source, classes or jars.
///
/// ## Murmel runtime
///
static final class Chk {
private Chk() {}
/// Additional error checking functions used by primitives only.
/** at least one arg, the first arg must be a non-nil string */
static void stringArg(String func, String arg, ConsCell a) {
if (!stringp(car(a)))
throw new SimpleTypeError("%s: expected %s to be a string but got %s", func, arg, printSEx(car(a)));
}
@SuppressWarnings("SameParameterValue")
static Number requireNumberOrNull(String func, Object a) {
if (a == null) return null;
return requireNumber(func, a);
}
/** error if n is not of type number */
static Number requireNumber(String func, Object n) {
if (n instanceof Long) return (Long)n;
if (n instanceof Double) return (Double) n;
if (n instanceof Number) return (Number)n;
throw errorNotANumber(func, n);
}
@SuppressWarnings("SameParameterValue")
static void requirePositiveNumber(String func, Object n) {
if (n instanceof Long && (Long)n > 0L
|| n instanceof Double && (Double)n > 0.0
|| n instanceof Byte && (Byte)n > 0
|| n instanceof Short && (Short)n > 0
|| n instanceof Integer && (Integer)n > 0
|| n instanceof Float && (Float)n > 0
|| n instanceof BigInteger && ((BigInteger)n).compareTo(BigInteger.ZERO) > 0) return;
throw errorArgTypeError("positive float or integer", func, n);
}
static Number requireIntegralNumber(String func, Object n, long minIncl, long maxIncl) {
if (n == null) errorNotAnInteger(func, null);
if (n instanceof Long) { return requireIntegralNumber(func, (Long) n, n, minIncl, maxIncl); }
if (n instanceof Double) { return requireIntegralNumber(func, (Double) n, n, minIncl, maxIncl); }
if (n instanceof Byte) { return requireIntegralNumber(func, (Byte) n, n, minIncl, maxIncl); }
if (n instanceof Short) { return requireIntegralNumber(func, (Short) n, n, minIncl, maxIncl); }
if (n instanceof Integer) { return requireIntegralNumber(func, (Integer) n, n, minIncl, maxIncl); }
if (n instanceof Float) { return requireIntegralNumber(func, (double) (Float) n, n, minIncl, maxIncl); }
if (n instanceof Number) { return requireIntegralNumber(func, toDouble(func, n), n, minIncl, maxIncl); }
throw errorNotAnInteger(func, n);
}
private static Number requireIntegralNumber(String func, double d, Object originalValue, long minIncl, long maxIncl) {
// see https://stackoverflow.com/questions/9898512/how-to-test-if-a-double-is-an-integer
if (Math.rint(d) == d && !Double.isInfinite(d) && d >= minIncl && d <= maxIncl) return d;
throw errorNotAnInteger(func, originalValue);
}
private static Number requireIntegralNumber(String func, long l, Object originalValue, long minIncl, long maxIncl) {
if (l >= minIncl && l <= maxIncl) return l;
throw errorNotAnInteger(func, originalValue);
}
@SuppressWarnings("SameParameterValue")
static Random requireRandom(String func, Object r) {
if (r instanceof Random) return (Random)r;
throw errorArgTypeError("random", func, r);
}
/** Return {@code c} as a Character, error if {@code c} is not a Character. */
static Character requireChar(String func, Object c) {
if (c instanceof Character) return (Character)c;
throw errorArgTypeError("character", func, c);
}
static boolean requireBit(String func, Object value) {
return requireIntegralNumber(func, value, 0, 1).intValue() != 0;
}
@SuppressWarnings("SameParameterValue")
static Object[] requireSimpleVector(String func, Object c) {
if (svectorp(c)) return (Object[])c;
throw errorNotASimpleVector(func, c);
}
/** return {@code c} as a String, error if {@code c} is not a string, character or symbol */
@SuppressWarnings("SameParameterValue")
static String requireStringDesignator(String func, Object c) {
if (c == null) return NIL;
if (c instanceof Character || c instanceof LambdaJSymbol) return c.toString();
return requireString(func, c);
}
static CharSequence requireCharsequence(String func, Object c) {
if (c instanceof char[]) return String.valueOf((char[])c);
if (!(c instanceof CharSequence)) errorNotAString(func, c);
return (CharSequence)c;
}
/** Return {@code a} cast to a list, error if {@code a} is not a list or is nil. */
static ConsCell requireCons(String func, Object a) {
if (!consp(a)) errorNotACons(func, a);
return (ConsCell)a;
}
@SuppressWarnings("unchecked")
static Map requireHash(String func, Object a) {
if (hashtablep(a)) return (Map)a;
throw errorArgTypeError("hashtable", func, a);
}
/// Number type conversions
/** return the argument w/o decimal places as a long, exception if conversion is not possible */
static long toFixnum(double d) {
if (Double.isInfinite(d)) errorNotAFixnum("value is Infinite");
if (Double.isNaN(d)) errorNotAFixnum("value is NaN");
if (d < MOST_NEGATIVE_FIXNUM_VAL) errorNotAFixnum("underflow");
if (d > MOST_POSITIVE_FIXNUM_VAL) errorNotAFixnum("overflow");
return (long)d;
}
/** convert {@code a} to a double, error if {@code a} is not a number and/ or cannot be represented as a double (reducing precision is allowed). */
static double toDouble(Object a) { return toDouble("?", a); }
static double toDouble(String func, Object a) {
final Number n = requireNumber(func, a);
final double ret = n.doubleValue();
if (n instanceof BigInteger || n instanceof BigDecimal) {
if (Double.isNaN(ret)) errorOverflow(func, "double", a);
return ret;
}
return ret;
}
/** convert {@code a} to a float, error if {@code a} is not a number and/ or cannot be represented as a float (reducing precision is allowed). */
@SuppressWarnings("SameParameterValue")
static float toFloat(String func, Object a) {
final Number n = requireNumber(func, a);
final float ret = n.floatValue();
if (n instanceof BigInteger || n instanceof BigDecimal) {
if (Float.isNaN(ret)) errorOverflow(func, "float", a);
return ret;
}
final double dbl = n.doubleValue();
if (dbl > Float.MAX_VALUE || dbl < -Float.MAX_VALUE) errorOverflow(func, "float", a);
return ret;
}
/** convert {@code a} to an int, error if {@code a} is not a number. */
static int toInt(String func, Object a) {
return requireIntegralNumber(func, a, Integer.MIN_VALUE, Integer.MAX_VALUE).intValue();
}
static int toNonnegInt(String func, Object a) {
return requireIntegralNumber(func, a, 0, Integer.MAX_VALUE).intValue();
}
}
/// Runtime for Lisp programs, i.e. an environment with primitives and predefined global symbols
static final class Subr {
private Subr() {}
/// logic, predicates
static boolean typep(SymbolTable st, @Null LambdaJ intp, @NotNull Map typeSpecs, @Null Object o, @Null Object typespec) {
if (o != null && o.getClass() == LambdaJError.class) o = ((LambdaJError)o).getCause();
@SuppressWarnings("SuspiciousMethodCalls")
final TypeSpec murmelTypeSpec = typeSpecs.get(typespec);
if (murmelTypeSpec != null) return murmelTypeSpec.pred.test(o);
if (typespec == st.intern("function")) return intp == null ? functionp0(o) : intp.functionp(o);
// todo Class.forName().isAssignableFrom() probieren falls JFFI aufgedreht ist
throw new SimpleError(TYPEP + ": unknown type specifier %s", printSEx(typespec));
}
static boolean adjustableArrayP(Object o) {
//if (!vectorp(o)) throw errorNotAVector("adjustable-array-p", o); // CL throws this error
return o instanceof Bitvector || o instanceof StringBuilder || o instanceof StringBuffer || o instanceof List;
}
static boolean eql(Object o1, Object o2) {
return LambdaJ.compare(o1, o2, CompareMode.EQL) == 0;
}
static boolean equal(Object o1, Object o2) {
return LambdaJ.compare(o1, o2, CompareMode.EQUAL) == 0;
}
/// conses and lists
static Object listStar(LambdaJ intp, ConsCell args) {
if (cdr(args) == null) return car(args);
if (cddr(args) == null) return intp.cons(car(args), cadr(args));
final CountingListBuilder b = intp.new CountingListBuilder();
for (; cdr(args) != null; args = (ConsCell)cdr(args)) {
b.append(car(args));
}
b.appendLast(car(args));
return b.first();
}
/** append args non destructively, all args except the last are shallow copied (list structure is copied, contents is not),
* all args except the last must be a proper list */
static Object append(LambdaJ intp, ConsCell args) {
if (cdr(args) == null) return car(args); // this also covers "if (args == null) return null;"
if (!listp(car(args))) throw new SimpleTypeError(APPEND + ": first argument is not a list: %s", printSEx(car(args)));
while (args != null && car(args) == null) args = (ConsCell)cdr(args); // skip leading nil args if any
if (cdr(args) == null) return car(args);
final ConsCell ret = intp.cons(null, null);
ConsCell appendTo = ret;
ConsCell current = args;
for (; cdr(current) != null; current = (ConsCell)cdr(current)) {
final Object o = car(current);
if (o == null) continue;
if (!consp(o)) throw new SimpleTypeError(APPEND + ": argument is not a list: %s", printSEx(o));
for (ConsCell obj = (ConsCell)o; obj != null; obj = requireList(APPEND, cdr(obj))) {
final ConsCell next = intp.cons(car(obj), null);
appendTo.rplacd(next);
appendTo = next;
}
}
appendTo.rplacd(car(current));
return ret.cdr();
}
/** return the cons whose car is eql to {@code atom}
* @see #assq
*/
static ConsCell assoc(Object atom, Object maybeList) {
if (maybeList == null) return null;
final ConsCell ccList = requireList(ASSOC, maybeList);
for (Object entry: ccList) {
if (entry != null) { // ignore null items
if (eql(atom, car(entry))) return (ConsCell)entry;
}
}
return null;
}
/// numbers
interface DoubleBiPred {
boolean test(double d1, double d2);
}
/** compare subsequent pairs of the given list of numbers with the given predicate */
static boolean compare(ConsCell args, String opName, DoubleBiPred pred) {
double prev = toDouble(opName, car(args));
for (ConsCell rest = (ConsCell)cdr(args); rest != null; rest = (ConsCell)cdr(rest)) {
final double next = toDouble(opName, car(rest));
if (!pred.test(prev, next)) return false;
prev = next;
}
return true;
}
/** operator for zero or more args */
static double addOp(ConsCell _args, String opName, double startVal, DoubleBinaryOperator op) {
if (_args == null) return startVal;
ConsCell args = _args;
double result = toDouble(opName, car(args));
for (;;) {
final Object next = cdr(args);
if (next == null) break;
if (!consp(next) || next == _args) // missing nested loop check
throw new ProgramError("%s: expected a proper list of numbers but got %s", opName, printSEx(_args));
args = (ConsCell) next;
result = op.applyAsDouble(result, toDouble(opName, car(args)));
}
return result;
}
/** operator for one or more args */
static double subOp(ConsCell _args, String opName, double startVal, DoubleBinaryOperator op) {
ConsCell args = _args;
double result = toDouble(opName, car(args));
if (cdr(args) == null) return op.applyAsDouble(startVal, result);
for (;;) {
final Object next = cdr(args);
if (next == null) break;
if (!consp(next) || next == args) // missing nested loop check
throw new ProgramError("%s: expected a proper list of numbers but got %s", opName, printSEx(_args));
args = (ConsCell) next;
result = op.applyAsDouble(result, toDouble(opName, car(args)));
}
return result;
}
static double quot12(String func, ConsCell args) {
final double lhs = toDouble(func, car(args));
return cdr(args) == null ? lhs : lhs / toDouble(func, cadr(args));
}
static Number cl_signum(Object n) {
if (n instanceof Double) { return Math.signum((Double)n); }
if (n instanceof Long) { return (long)Long.signum((Long)n); }
if (n instanceof Byte) { return (long)Integer.signum((int) (Byte)n); }
if (n instanceof Short) { return (long)Integer.signum((int) (Short)n); }
if (n instanceof Integer) { return (long)Integer.signum((Integer)n); }
if (n instanceof BigInteger) { return (long)((BigInteger)n).signum(); }
if (n instanceof BigDecimal) { return (double)((BigDecimal)n).signum(); }
return Math.signum(toDouble("signum", n));
}
/** produce a quotient that has been truncated towards zero; that is, the quotient represents the mathematical integer
* of the same sign as the mathematical quotient,
* and that has the greatest integral magnitude not greater than that of the mathematical quotient. */
static double cl_truncate(double d) {
return d < 0.0 ? Math.ceil(d) : Math.floor(d);
}
/** note that the Java modulo operator {@code %} works differently, see also https://en.wikipedia.org/wiki/Modulo_operation */
static double cl_mod(double x, double y) {
return x - Math.floor(x / y) * y;
}
static Number inc(Object n) {
if (n instanceof Long) {
final long l;
if ((l = (Long)n) == MOST_POSITIVE_FIXNUM_VAL) errorNotAFixnum("1+: overflow, integer result does not fit in a fixnum");
return l + 1;
}
if (n instanceof Double) return ((Double)n) + 1;
return incNumber(n);
}
static Number incinc(Object n) {
if (n instanceof Long) {
final long l;
if ((l = (Long)n) >= MOST_POSITIVE_FIXNUM_VAL-1) errorNotAFixnum("1+: overflow, integer result does not fit in a fixnum");
return l + 2;
}
if (n instanceof Double) return ((Double)n) + 2;
incNumber(n);
return incNumber(n);
}
private static Number incNumber(Object n) {
if (n instanceof Byte) return ((Byte)n).intValue() + 1;
if (n instanceof Short) return ((Short)n).intValue() + 1;
if (n instanceof Integer) return ((Integer)n).longValue() + 1;
if (n instanceof BigInteger) {
final long l;
try {
l = ((BigInteger)n).longValueExact();
}
catch (ArithmeticException e) {
errorNotAFixnum("1+: overflow, BigInteger argument does not fit in a fixnum");
/*notreached*/ throw null;
}
if (l == MOST_POSITIVE_FIXNUM_VAL) errorNotAFixnum("1+: overflow, integer result does not fit in a fixnum");
return l + 1;
}
return toDouble("1+", n) + 1;
}
static Number dec(Object n) {
if (n instanceof Double) return ((Double)n) - 1;
if (n instanceof Long) {
final long l;
if ((l = (Long)n) == MOST_NEGATIVE_FIXNUM_VAL) errorNotAFixnum("1-: underflow, integer result does not fit in a fixnum");
return l - 1;
}
return decNumber(n);
}
static Number decNumber(Object n) {
if (n instanceof Byte) return ((Byte)n).intValue() - 1;
if (n instanceof Short) return ((Short)n).intValue() - 1;
if (n instanceof Integer) return ((Integer)n).longValue() - 1;
if (n instanceof BigInteger) {
final long l;
try {
l = ((BigInteger)n).longValueExact();
}
catch (ArithmeticException e) {
errorNotAFixnum("1-: underflow, BigInteger argument does not fit in a fixnum");
/*notreached*/ throw null;
}
if (l == MOST_NEGATIVE_FIXNUM_VAL) errorNotAFixnum("1-: underflow, integer result does not fit in a fixnum");
return l - 1;
}
return toDouble("1-", n) - 1;
}
static Number random(Object limit, Object _state) {
requirePositiveNumber("random", limit);
final Random state = requireRandom("random", _state);
if (limit instanceof Long) return (long)(state.nextDouble() * (Long)limit);
if (limit instanceof Double) return state.nextDouble() * (Double)limit;
if (limit instanceof Byte) return state.nextInt((Byte)limit);
if (limit instanceof Short) return state.nextInt((Short)limit);
if (limit instanceof Integer) return state.nextInt((Integer)limit);
if (limit instanceof Float) return state.nextFloat() * (Float)limit;
if (limit instanceof BigInteger) {
// see https://stackoverflow.com/questions/2290057/how-to-generate-a-random-biginteger-value-in-java
final BigInteger upperLimit = (BigInteger)limit;
final int nlen = upperLimit.bitLength();
final BigInteger nm1 = upperLimit.subtract(BigInteger.ONE);
BigInteger randomNumber, temp;
do {
temp = new BigInteger(nlen + 100, state);
randomNumber = temp.mod(upperLimit);
} while (temp.subtract(randomNumber).add(nm1).bitLength() >= nlen + 100);
return randomNumber;
}
throw errorInternal("can't happen");
}
static Random makeRandomState(Random currentState, Object state) {
if (state == sT) return new Random();
if (state == null) return copy(currentState);
if (state instanceof Random) return copy((Random)state);
if (state instanceof Number) return new Random(((Number)state).longValue());
throw errorArgTypeError("random or " + T + " or " + NIL + " or number", "make-random-state", state);
}
private static final class BOS extends ByteArrayOutputStream {
BOS() { super(104); } // Java 1.1 through 20's java.util.Random will be serialized to 104 bytes. Other Roandom classes may be larger, BOS will grow as needed.
byte[] getBuf() { return buf; } // provide direct access to buf to avoid copying
}
private static Random copy(Random rnd) {
try {
final BOS bo = new BOS();
final ObjectOutputStream oos = new ObjectOutputStream(bo);
oos.writeObject(rnd);
oos.close();
final ObjectInputStream ois = new ObjectInputStream(new ByteArrayInputStream(bo.getBuf()));
return (Random)(ois.readObject());
}
catch (Exception e) { throw errorInternal(e, "unexpected Exception copying random"); }
}
/// vectors
static final class Bitvector implements Serializable, Writeable, Iterable, Comparable {
class Iter implements Iterator {
private int cursor;
@Override public boolean hasNext() { return cursor < size(); }
@Override public Long next() { if (cursor == size()) throw new NoSuchElementException(); return get(cursor++); }
}
private static final long serialVersionUID = 1L;
private final BitSet bitSet;
private int size;
Bitvector(int capacity, int size) {
bitSet = new BitSet(capacity);
this.size = size;
}
Bitvector(boolean[] contents) {
this(contents.length, 0);
for (boolean b: contents) add(b);
}
static Bitvector of(Object o) {
if (o instanceof Bitvector) return (Bitvector)o;
if (o instanceof boolean[]) return new Bitvector((boolean[])o);
throw new SimpleTypeError("not a bitvector: %s", LambdaJ.printSEx(o));
}
@Override public Iterator iterator() { return new Iter(); }
@Override public boolean equals(Object other) { return other instanceof Bitvector && bitSet.equals(((Bitvector)other).bitSet); }
@Override public int hashCode() { return bitSet.hashCode(); }
@Override public int compareTo(Bitvector b2) {
final int len1 = size();
final int len2 = b2.size();
final int lim = Math.min(len1, len2);
for (int k = 0; k < lim; k++) {
final int c1 = (int)get(k);
final int c2 = (int)b2.get(k);
if (c1 != c2) {
return Integer.compare(c1, c2);
}
}
return Integer.compare(len1, len2);
}
int size() { return size; }
long add(boolean value) { if (value) bitSet.set(size); size++; return size - 1; }
void add(int pos, boolean value) {
for (int i = bitSet.length(); i > pos; --i) bitSet.set(i, bitSet.get(i - 1));
bitSet.set(pos, value);
size = Math.max(size, pos) + 1;
}
long remove(int pos) {
if (pos >= size) errorIndexTooLarge(pos, size);
final long ret = get(pos);
for (int i = pos; i < bitSet.length() - 1; i++) bitSet.set(i, bitSet.get(i + 1));
bitSet.clear(bitSet.length() - 1);
--size;
return ret;
}
long get(int idx) { return bitSet.get(idx) ? 1L : 0L; }
void set(int idx, boolean val) { bitSet.set(idx, val); }
void fill(boolean value) {
if (value) bitSet.set(0, size);
else bitSet.clear();
}
boolean[] toBooleanArray() {
final boolean[] ret = new boolean[size];
if (size == 0) return ret;
final BitSet bitSet = this.bitSet;
final int limit = bitSet.length();
for (int idx = 0; idx < limit; idx++) {
ret[idx] = bitSet.get(idx);
}
return ret;
}
@Override public void printSEx(WriteConsumer sb, boolean escapeAtoms) {
sb.print("#*");
int idx = 0;
for (; idx < bitSet.length(); idx++) sb.print(bitSet.get(idx) ? "1" : "0");
for (; idx < size; idx++) sb.print("0");
}
}
static Object makeArray(LambdaJSymbol sBit, LambdaJSymbol sCharacter, ConsCell a) {
final int size = toNonnegInt(MAKE_ARRAY, car(a));
final Object type = cadr(a);
final Object cap = caddr(a);
final boolean adjustable = cap != null;
final int capacity;
if (adjustable && cap != sT) capacity = requireIntegralNumber(MAKE_ARRAY, cap, size, ARRAY_DIMENSION_LIMIT_VAL).intValue();
else capacity = size;
if (cdr(a) == null || type == sT) {
if (adjustable) { final List ret = new ArrayList<>(capacity); for (int i = 0; i < size; i++) ret.add(null); return ret; }
return new Object[size];
}
if (type == sBit) {
if (adjustable) return new Bitvector(capacity, size);
return new boolean[size];
}
if (type == sCharacter) {
if (adjustable) { final StringBuilder ret = new StringBuilder(capacity); for (int i = 0; i < size; i++) ret.append('\0'); return ret; }
return new char[size];
}
throw new SimpleTypeError(MAKE_ARRAY + ": unsupported or invalid type specification %s", printSEx(type)); // todo sbcl akzeptiert alles als :element-type
}
static Object makeArray(LambdaJSymbol sBit, LambdaJSymbol sCharacter, Object _size, Object type) {
final int size = toNonnegInt(MAKE_ARRAY, _size);
if (type == sT) return new Object[size];
if (type == sBit) return new boolean[size];
if (type == sCharacter) return new char[size];
throw new SimpleTypeError(MAKE_ARRAY + ": unsupported or invalid type specification %s", printSEx(type)); // todo sbcl akzeptiert alles als :element-type
}
static long vectorLength(Object maybeVector) {
if (maybeVector instanceof Object[]) return ((Object[])maybeVector).length;
if (maybeVector instanceof boolean[]) return ((boolean[])maybeVector).length;
if (maybeVector instanceof Bitvector) return ((Bitvector)maybeVector).size();
if (maybeVector instanceof char[]) return ((char[])maybeVector).length;
if (maybeVector instanceof CharSequence) return ((CharSequence)maybeVector).length();
if (maybeVector instanceof List) return ((List>)maybeVector).size();
throw errorNotAVector("vector-length", maybeVector);
}
static Object vectorCopy(Object vector, boolean adjustablep) {
if (adjustablep) {
if (vector instanceof Object[]) return new ArrayList<>(Arrays.asList((Object[])vector));
if (vector instanceof boolean[]) return new Bitvector((boolean[])vector);
if (vector instanceof Bitvector) return new Bitvector(((Bitvector)vector).toBooleanArray());
if (vector instanceof char[]) {
final char[] ca = (char[])vector;
return new StringBuilder(ca.length + 16).append(ca);
}
if (vector instanceof CharSequence) return new StringBuilder((CharSequence)vector);
if (vector instanceof List>) return new ArrayList<>((List>)vector);
}
else {
final int length = (int)vectorLength(vector);
if (vector instanceof Object[]) return Arrays.copyOf((Object[])vector, length);
if (vector instanceof boolean[]) return Arrays.copyOf((boolean[])vector, length);
if (vector instanceof Bitvector) return ((Bitvector)vector).toBooleanArray();
if (vector instanceof char[]) return Arrays.copyOf((char[])vector, length);
if (vector instanceof StringBuilder) {
final StringBuilder sb = (StringBuilder)vector; final char[] ret = new char[length]; sb.getChars(0, length, ret, 0);
return sb;
}
if (vector instanceof StringBuffer) {
final StringBuffer sb = (StringBuffer)vector; final char[] ret = new char[length]; sb.getChars(0, length, ret, 0);
return sb;
}
if (vector instanceof CharSequence) return vector.toString().toCharArray(); // sadly this creates an intermediate String and copies the char[] twice
if (vector instanceof List>) return ((List>)vector).toArray(new Object[0]);
}
throw errorNotAVector("vector-copy", vector);
}
@SuppressWarnings("unchecked")
static Object vectorFill(Object vector, Object value, Object _start, Object _end) {
final int length = (int)vectorLength(vector);
int start = 0, end = length;
if (_start != null) {
start = requireIntegralNumber(VECTOR_FILL, _start, 0, length).intValue();
if (_end != null) {
end = requireIntegralNumber(VECTOR_FILL, _end, start+1, length).intValue();
}
}
if (vector instanceof Object[]) { Arrays.fill((Object[])vector, start, end, value); return vector; }
if (vector instanceof boolean[]) { Arrays.fill((boolean[])vector, start, end, requireBit(VECTOR_FILL, value)); return vector; }
if (vector instanceof Bitvector) { ((Bitvector)vector).fill(requireBit(VECTOR_FILL, value)); return vector; }
if (vector instanceof char[]) { Arrays.fill((char[])vector, start, end, requireChar(VECTOR_FILL, value)); return vector; }
if (vector instanceof StringBuilder) { final StringBuilder sb = (StringBuilder)vector; final char c = requireChar(VECTOR_FILL, value); for (int i = start; i < end; i++) (sb).setCharAt(i, c); return vector; }
if (vector instanceof StringBuffer) { final StringBuffer sb = (StringBuffer)vector; final char c = requireChar(VECTOR_FILL, value); for (int i = start; i < end; i++) (sb).setCharAt(i, c); return vector; }
if (vector instanceof List) { @SuppressWarnings("rawtypes") final List list = (List)vector; for (int i = start; i < end; i++) list.set(i, value); return vector; }
throw errorNotAVector(VECTOR_FILL, vector);
}
@SuppressWarnings("unchecked")
static long vectorAdd(Object maybeVector, Object newValue) {
if (!adjustableArrayP(maybeVector)) throw new InvalidIndexError("vector-add: not an adjustable " + VECTOR + ": %s", printSEx(maybeVector));
if (maybeVector instanceof StringBuilder) { final StringBuilder sb = (StringBuilder)maybeVector; sb.append(requireChar("vector-add", newValue)); return sb.length() - 1; }
if (maybeVector instanceof StringBuffer) { final StringBuffer sb = (StringBuffer)maybeVector; sb.append(requireChar("vector-add", newValue)); return sb.length() - 1; }
if (maybeVector instanceof Bitvector) { final Bitvector bv = (Bitvector)maybeVector; return bv.add(requireBit("vector-add", newValue)); }
if (maybeVector instanceof List) { @SuppressWarnings("rawtypes") final List l = (List)maybeVector; l.add(newValue); return l.size() - 1; }
throw errorInternal("vector-add: unknown object type %s", maybeVector);
}
@SuppressWarnings("unchecked")
static long vectorAdd(Object maybeVector, Object newValue, int pos) {
if (!adjustableArrayP(maybeVector)) throw new InvalidIndexError("vector-add: not an adjustable " + VECTOR + ": %s", printSEx(maybeVector));
else if (maybeVector instanceof StringBuilder) { final StringBuilder sb = (StringBuilder)maybeVector; sb.insert(pos, requireChar("vector-add", newValue)); }
else if (maybeVector instanceof StringBuffer) { final StringBuffer sb = (StringBuffer)maybeVector; sb.insert(pos, requireChar("vector-add", newValue)); }
else if (maybeVector instanceof Bitvector) { final Bitvector bv = (Bitvector)maybeVector; bv.add(pos, requireBit("vector-add", newValue)); }
else if (maybeVector instanceof List) { @SuppressWarnings("rawtypes") final List l = (List)maybeVector; l.add(pos, newValue); }
else throw errorInternal("vector-add: unknown object type %s", maybeVector);
return pos;
}
static Object vectorRemove(Object maybeVector, int pos) {
final Object ret;
if (!adjustableArrayP(maybeVector)) throw new InvalidIndexError("vector-add: not an adjustable " + VECTOR + ": %s", printSEx(maybeVector));
else if (maybeVector instanceof StringBuilder) { final StringBuilder sb = (StringBuilder)maybeVector; ret = sb.charAt(pos); sb.replace(pos, pos+1, ""); }
else if (maybeVector instanceof StringBuffer) { final StringBuffer sb = (StringBuffer)maybeVector; ret = sb.charAt(pos); sb.replace(pos, pos+1, ""); }
else if (maybeVector instanceof Bitvector) { final Bitvector bv = (Bitvector)maybeVector; ret = bv.remove(pos); }
else if (maybeVector instanceof List) { final List> l = (List>)maybeVector; ret = l.remove(pos); }
else throw errorInternal("vector-add: unknown object type %s", maybeVector);
return ret;
}
static Object vectorToList(LambdaJ intp, Object maybeVector) {
if (svectorp(maybeVector)) return simpleVectorToList(intp, maybeVector);
if (stringp(maybeVector)) return stringToList(intp, maybeVector);
if (sbitvectorp(maybeVector)) return bitVectorToList(intp, maybeVector);
if (maybeVector instanceof Bitvector || maybeVector instanceof List) {
final Iterator> it = ((Iterable>)maybeVector).iterator();
if (!it.hasNext()) return null;
final CountingListBuilder ret = intp.new CountingListBuilder();
do { ret.append(it.next()); }
while (it.hasNext());
return ret.first();
}
throw errorNotAVector("vector->list", maybeVector);
}
static Object listToVector(Object lst, boolean adjustablep) {
if (lst == null) return adjustablep ? new ArrayList<>() : new Object[0];
if (adjustablep) {
final ConsCell l = requireList("list->vector", lst);
final ArrayList ret = new ArrayList<>();
for (Object o: l) ret.add(o);
return ret;
}
return listToArray(lst);
}
static long svlength(Object maybeVector) {
if (maybeVector instanceof Object[]) return ((Object[])maybeVector).length;
throw errorNotASimpleVector("svlength", maybeVector);
}
static Object svref(Object maybeVector, int idx) {
if (maybeVector instanceof Object[]) return ((Object[])maybeVector)[idx];
throw errorNotASimpleVector("svref", maybeVector);
}
static Object svset(Object maybeVector, int idx, Object newValue) {
if (maybeVector instanceof Object[]) return ((Object[])maybeVector)[idx] = newValue;
throw errorNotASimpleVector("svset", maybeVector);
}
static Object simpleVectorToList(LambdaJ intp, Object maybeVector) {
final Object[] s = requireSimpleVector("simple-vector->list", maybeVector);
if (s.length == 0) return null;
final CountingListBuilder ret = intp.new CountingListBuilder();
final int len = s.length;
for (int i = 0; i < len; i++) ret.append(s[i]);
return ret.first();
}
static long slength(Object maybeVector) {
if (maybeVector instanceof char[]) return ((char[])maybeVector).length;
if (!(maybeVector instanceof CharSequence)) errorNotAString("slength", maybeVector);
return ((CharSequence)maybeVector).length();
}
static char sref(Object maybeString, int idx) {
if (maybeString instanceof char[]) return ((char[])maybeString)[idx];
return requireCharsequence("sref", maybeString).charAt(idx);
}
static char sset(Object maybeString, int idx, char newValue) {
if (maybeString instanceof char[]) return ((char[])maybeString)[idx] = newValue;
if (maybeString instanceof StringBuilder) { ((StringBuilder)maybeString).setCharAt(idx, newValue); return newValue; }
if (maybeString instanceof StringBuffer) { ((StringBuffer)maybeString).setCharAt(idx, newValue); return newValue; }
if (!(maybeString instanceof String)) errorNotAString("sset", maybeString);
throw new SimpleTypeError("%s: cannot modify readonly string", "sset");
}
static boolean stringEq(Object o1, Object o2) {
return Objects.equals(requireStringDesignator("string=", o1), requireStringDesignator("string=", o2));
}
static Object stringToList(LambdaJ intp, Object maybeString) {
final CountingListBuilder ret = intp.new CountingListBuilder();
if (maybeString instanceof char[]) {
final char[] carry = (char[])maybeString;
final int len = carry.length;
for (int i = 0; i < len; i++) ret.append(carry[i]);
return ret.first();
}
final CharSequence s = requireCharsequence("string->list", maybeString);
final int len = s.length();
for (int i = 0; i < len; i++) ret.append(s.charAt(i));
return ret.first();
}
static String stringToImmutableString(Object o) {
if (o instanceof String) return (String)o;
if (o instanceof char[]) return new String((char[])o);
if (o instanceof CharSequence) return o.toString();
throw new SimpleTypeError("not a string: %s", printSEx(o));
}
static Object stringDesignatorToString(Object o) {
if (o == null) return new char[] { 'n', 'i', 'l' };
if (o instanceof String) return ((String)o).toCharArray();
if (o instanceof char[] || o instanceof CharSequence) return o;
if (o instanceof LambdaJSymbol) return ((LambdaJSymbol)o).name.toCharArray();
if (o instanceof Character) return new char[] { ((char)o) };
throw new SimpleTypeError("not a string designator: %s", printSEx(o));
}
static Object listToString(Object lst, boolean adjustablep) {
if (lst == null) return adjustablep ? new StringBuilder() : new char[0];
final ConsCell l = requireList("list->string", lst);
final StringBuilder ret = new StringBuilder();
for (Object c: l) ret.append(requireChar("list->string", c)); // missing nested loop check
return adjustablep ? ret : ret.toString().toCharArray();
}
static long bvlength(Object maybeVector) {
if (maybeVector instanceof boolean[]) return ((boolean[])maybeVector).length;
if (maybeVector instanceof Bitvector) return ((Bitvector)maybeVector).size();
throw errorNotABitVector("bvlength", maybeVector);
}
static long bvref(Object bv, int idx) {
if (bv instanceof boolean[]) return ((boolean[])bv)[idx] ? 1L : 0L;
if (bv instanceof Bitvector) { final Bitvector _bv = (Bitvector)bv; if (idx >= _bv.size()) errorIndexTooLarge(idx, _bv.size()); return _bv.get(idx); }
throw errorNotABitVector("bvref", bv);
}
static long bvset(Object maybeVector, int idx, long newValue) {
if (maybeVector instanceof boolean[]) {
final boolean b;
if (newValue == 0) b = false;
else if (newValue == 1) b = true;
else throw errorNotABit("bvset", newValue);
((boolean[])maybeVector)[idx] = b;
return newValue;
}
if (maybeVector instanceof Bitvector) { ((Bitvector)maybeVector).set(idx, requireBit("bvset", newValue)); return newValue; }
throw errorNotABitVector("bvset", maybeVector);
}
static boolean bvEq(Object maybeVector1, Object maybeVector2) {
if (sbitvectorp(maybeVector1) && sbitvectorp(maybeVector2)) return Arrays.equals((boolean[])maybeVector1, (boolean[])maybeVector2);
if (!bitvectorp(maybeVector1)) throw errorNotABitVector("bv=", maybeVector1);
if (!bitvectorp(maybeVector2)) throw errorNotABitVector("bv=", maybeVector2);
if (maybeVector1 == maybeVector2) return true;
if (vectorLength(maybeVector1) != vectorLength(maybeVector2)) return false;
for (int i = 0; i < vectorLength(maybeVector1); i++) {
if (seqref(maybeVector1, i) != seqref(maybeVector2, i)) return false;
}
return true;
}
static Object bitVectorToList(LambdaJ intp, Object maybeVector) {
final CountingListBuilder ret;
if (maybeVector instanceof boolean[]) {
final boolean[] s = (boolean[])maybeVector;
final int len = s.length;
if (len == 0) return null;
ret = intp.new CountingListBuilder();
for (int i = 0; i < len; i++) ret.append(s[i] ? 1L : 0L);
}
else if (maybeVector instanceof Bitvector) {
final Bitvector bv = (Bitvector)maybeVector;
if (bv.size() == 0) return null;
ret = intp.new CountingListBuilder();
for (Object bit: bv) ret.append(bit);
}
else throw errorNotABitVector("bit-vector->list", maybeVector);
return ret.first();
}
static Object listToBitVector(Object maybeList, boolean adjustablep) {
final ConsCell lst = requireList("list->bit-vector", maybeList);
if (adjustablep) {
final Bitvector bv = new Bitvector(10, 0);
if (lst != null) for (Object bit: lst) bv.add(requireBit("list->bit-vector", bit));
return bv;
}
if (lst == null) return new boolean[0];
if (lst instanceof ArraySlice) return ((ArraySlice)lst).listToBooleanArray();
boolean[] ret = new boolean[32];
int i = 0;
final Long zero = 0L, one = 1L;
for (Object rest = lst; rest != null; rest = cdr(rest)) {
if (i == ret.length) ret = Arrays.copyOf(ret, ret.length * 2);
final Object o = car(rest);
if (zero.equals(o)) ret[i] = false;
else if (one.equals(o)) ret[i] = true;
else throw new SimpleTypeError("not a valid value for bitvector: %s", printSEx(o));
i++;
}
return Arrays.copyOf(ret, i);
}
/// sequences
static Object seqref(Object maybeSeq, long idx) {
checkSequenceBounds(maybeSeq, idx);
if (maybeSeq instanceof ConsCell) return ((ConsCell)maybeSeq).elt(idx);
if (maybeSeq instanceof Object[]) { final Object[] arry = (Object[])maybeSeq; if (idx >= arry.length) errorIndexTooLarge(idx, arry.length); return arry[(int)idx]; }
if (maybeSeq instanceof char[]) { final char[] arry = (char[])maybeSeq; if (idx >= arry.length) errorIndexTooLarge(idx, arry.length); return arry[(int)idx]; }
if (maybeSeq instanceof boolean[]) { final boolean[] arry = (boolean[])maybeSeq; if (idx >= arry.length) errorIndexTooLarge(idx, arry.length); return arry[(int)idx] ? 1L : 0L; }
if (maybeSeq instanceof Bitvector) { final Bitvector bv = (Bitvector)maybeSeq; if (idx >= bv.size()) errorIndexTooLarge(idx, bv.size()); return bv.get((int)idx); }
if (maybeSeq instanceof List) { @SuppressWarnings("rawtypes")
final List list = (List)maybeSeq; if (idx >= list.size()) errorIndexTooLarge(idx, list.size()); return list.get((int)idx); }
if (maybeSeq instanceof CharSequence) { final CharSequence cs = (CharSequence)maybeSeq; if (idx >= cs.length()) errorIndexTooLarge(idx, cs.length()); return cs.charAt((int)idx); }
throw errorInternal("seqref: unknown object type %s or not implemented", maybeSeq);
}
private static void checkSequenceBounds(Object maybeSeq, long idx) {
if (idx < 0) throw new InvalidIndexError("seqref: index must be >= 0");
if (maybeSeq == null) errorIndexTooLarge(idx, 0);
}
@SuppressWarnings("unchecked")
static Object seqset(Object maybeSeq, long idx, Object newValue) {
checkSequenceBounds(maybeSeq, idx);
if (maybeSeq instanceof ConsCell) return ((ConsCell)maybeSeq).eltset(newValue, idx);
if (maybeSeq instanceof Object[]) { final Object[] arry = (Object[])maybeSeq; if (idx >= arry.length) errorIndexTooLarge(idx, arry.length); return arry[(int)idx] = newValue; }
if (maybeSeq instanceof char[]) { final char[] arry = (char[])maybeSeq; if (idx >= arry.length) errorIndexTooLarge(idx, arry.length); return arry[(int)idx] = requireChar(SEQSET, newValue); }
if (maybeSeq instanceof boolean[]) { final boolean[] arry = (boolean[])maybeSeq; if (idx >= arry.length) errorIndexTooLarge(idx, arry.length);
final int newBit = requireIntegralNumber(SEQSET, newValue, 0, 1).intValue();
if (newBit == 0) { arry[(int)idx] = false; return 0L; }
if (newBit == 1) { arry[(int)idx] = true; return 1L; }
throw errorNotABit(SEQSET, newValue); }
if (maybeSeq instanceof Bitvector) { final Bitvector bv = (Bitvector)maybeSeq; if (idx >= bv.size()) errorIndexTooLarge(idx, bv.size()); bv.set((int)idx, requireBit(SEQSET, newValue));
return newValue; }
if (maybeSeq instanceof StringBuilder) { final StringBuilder sb = (StringBuilder)maybeSeq; if (idx >= sb.length()) errorIndexTooLarge(idx, sb.length());
final Character c = requireChar(SEQSET, newValue); sb.setCharAt((int)idx, c);
return newValue; }
if (maybeSeq instanceof StringBuffer) { final StringBuffer sb = (StringBuffer)maybeSeq; if (idx >= sb.length()) errorIndexTooLarge(idx, sb.length());
final Character c = requireChar(SEQSET, newValue); sb.setCharAt((int)idx, c);
return newValue; }
if (maybeSeq instanceof List) { @SuppressWarnings("rawtypes") final List list = (List)maybeSeq; if (idx >= list.size()) errorIndexTooLarge(idx, list.size()); list.set((int)idx, newValue);
return newValue; }
throw errorInternal(SEQSET+": unknown object type %s or not implemented", maybeSeq);
}
/// Hash tables
static final int DEFAULT_HASH_SIZE = 24; // will give capacity==32
static final Object NO_DEFAULT_VALUE = new Object();
/** a hash function that is compatible with equal(o1, o1) aka compare(o1, o2, CompareMode.EQUAL):
* two objects that are equal will have the same hash, two objects that are not equal may or may not have the same hash.
* Objects with (possibly embedded) loops should be handled as well. */
static int sxhash(Object o) {
return sxhashSigned(o) & 0x7fffffff; // Math.abs() won't guarantee a nonnegative number: Math.abs(-2147483648) == -2147483648
}
static final class EqlKey implements Comparable {
final Object key;
EqlKey(Object key) { this.key = key; }
static Object of(Object key) {
if (key instanceof Float || key instanceof Double || key instanceof BigDecimal) return key;
return new EqlKey(key);
}
@Override public int compareTo(Object o) { if (o instanceof EqlKey) return LambdaJ.compare(this.key, ((EqlKey)o).key, CompareMode.EQL);
else return LambdaJ.compare(this.key, o, CompareMode.EQL); }
@Override public int hashCode() { return sxhashSigned(key); }
@Override public boolean equals(Object o) { if (o instanceof EqlKey) return LambdaJ.compare(this.key, ((EqlKey)o).key, CompareMode.EQL) == 0;
else return LambdaJ.compare(this.key, o, CompareMode.EQL) == 0; }
}
static final class EqualKey implements Comparable {
final Object key;
EqualKey(Object key) { this.key = key; }
static Object of(Object key) {
if (key instanceof Float || key instanceof Double || key instanceof BigDecimal) return key;
return new EqualKey(key);
}
@Override public int compareTo(Object o) { if (o instanceof EqualKey) return LambdaJ.compare(this.key, ((EqualKey)o).key, CompareMode.EQUAL);
else return LambdaJ.compare(this.key, o, CompareMode.EQUAL); }
@Override public int hashCode() { return sxhashSigned(key); }
@Override public boolean equals(Object o) { if (o instanceof EqualKey) return LambdaJ.compare(this.key, ((EqualKey)o).key, CompareMode.EQUAL) == 0;
else return LambdaJ.compare(this.key, o, CompareMode.EQUAL) == 0; }
}
/** Note: getEntrySet(), getKeySet() and maybe more Map methods will NOT work as expected! */
abstract static class MurmelMap extends HashMap implements Writeable {
MurmelMap(int size) { super(JavaUtil.hashMapCapacity(size), JavaUtil.DEFAULT_LOAD_FACTOR); }
abstract String pfx();
abstract Object makeKey(Object key);
abstract Object getKey(Map.Entry,?> entry);
@Override public Object put(Object key, Object value) { return super.put(makeKey(key), value); }
@Override public Object get(Object key) { return super.get(makeKey(key)); }
@Override public boolean containsKey(Object key) { return super.containsKey(makeKey(key)); }
@Override public Object remove(Object key) { return super.remove(makeKey(key)); }
@Override public void printSEx(WriteConsumer out, boolean escapeAtoms) {
out.print(pfx());
for (Map.Entry,?> entry: entrySet()) {
out.print(" "); LambdaJ.printSEx(out, getKey(entry), escapeAtoms);
out.print(" "); LambdaJ.printSEx(out, entry.getValue(), escapeAtoms);
}
out.print(")");
}
}
static class EqlMap extends MurmelMap {
EqlMap(int size) { super(size); }
@Override String pfx() { return "#H(eql"; }
@Override Object makeKey(Object key) { return EqlKey.of(key); }
@Override Object getKey(Map.Entry,?> entry) { if (entry.getKey() instanceof EqlKey) return ((EqlKey)entry.getKey()).key; return entry.getKey(); }
}
static class EqualMap extends MurmelMap {
EqualMap(int size) { super(size); }
@Override String pfx() { return "#H(equal"; }
@Override Object makeKey(Object key) { return EqualKey.of(key); }
@Override Object getKey(Map.Entry,?> entry) { if (entry.getKey() instanceof EqualKey) return ((EqualKey)entry.getKey()).key; return entry.getKey(); }
}
static class EqlTreeMap extends TreeMap {
EqlTreeMap() { super(EqlTreeMap::doCompare); }
private static int doCompare(Object o1, Object o2) {
return LambdaJ.compare(o1, o2, CompareMode.EQL);
}
}
static class EqualTreeMap extends TreeMap {
EqualTreeMap() { super(EqualTreeMap::doCompare); }
private static int doCompare(Object o1, Object o2) {
return LambdaJ.compare(o1, o2, CompareMode.EQUAL);
}
}
static Map hash(SymbolTable symtab, ConsCell testAndPairs) {
if (testAndPairs == null) return new EqlMap(DEFAULT_HASH_SIZE);
final Map ret = makeHashTable(symtab, car(testAndPairs), DEFAULT_HASH_SIZE);
final ConsCell pairs = requireList(HASH, testAndPairs.cdr());
if (pairs == null) return ret;
final Iterator> i = pairs.iterator();
while (i.hasNext()) {
final Object key = i.next();
if (!i.hasNext()) errorMalformedFmt(HASH, "last key/value pair is missing 'value'");
ret.put(key, i.next());
}
return ret;
}
static Map makeHashTable(SymbolTable st, Object test, int size) {
if (test == sT) return JavaUtil.newHashMap(size);
if (test == null || test == st.intern(EQL)) return new EqlMap(size);
if (test == st.intern("compare-eql")) return new EqlTreeMap();
if (test == st.intern(EQUAL)) return new EqualMap(size);
if (test == st.intern("compare-equal")) return new EqualTreeMap();
if (test == st.intern(EQ)) return new IdentityHashMap<>(size);
throw new SimpleTypeError("only " + NIL + ", " + EQ + ", " + EQL + ", compare-eql, " + EQUAL + ", compare-eql and " + T + " are implemented as 'test', got %s", printSEx(test));
}
static Object[] hashref(Object hash, Object key, Object def) {
final Map,Object> map = requireHash("hashref", hash);
if (map.containsKey(key)) {
final Object val = map.get(key);
return new Object[] { val, sT };
}
else if (def == NO_DEFAULT_VALUE) return new Object[] { null, null };
else return new Object[] { def, null };
}
static Object hashset(ConsCell args) {
final Object hashOrGen = car(args);
if (hashOrGen instanceof IteratorGenerator) return ((IteratorGenerator)hashOrGen).set(cadr(args));
if (cddr(args) == null) throw new ProgramError("hashset: when the first argument is a hash-table 3 arguments are required");
return hashset(hashOrGen, cadr(args), caddr(args));
}
static Object hashset(Object hash, Object key, Object value) {
final Map map = requireHash("hashset", hash);
map.put(key, value);
return value;
}
static Object hashTableCount(Object hash) {
return requireHash("hash-table-count", hash).size();
}
static Object clrhash(Object hash) {
requireHash("clrhash", hash).clear();
return hash;
}
static boolean hashRemove(ConsCell args) {
final Object hashOrGen = car(args);
if (hashOrGen instanceof IteratorGenerator) return ((IteratorGenerator)hashOrGen).remove();
if (cdr(args) == null) throw new ProgramError("hash-table-remove: when the first argument is a hash-table 2 arguments are required");
return hashRemove(hashOrGen, cadr(args));
}
static boolean hashRemove(Object hash, Object key) {
final Map,Object> map = requireHash("hash-table-remove", hash);
final boolean ret = map.containsKey(key);
map.remove(key);
return ret;
}
interface IteratorGenerator {
default Object set(Object value) { throw new SimpleError("no such element - hash-table is empty"); }
default boolean remove() { return false; }
}
interface InterpreterIteratorGenerator extends IteratorGenerator, Primitive {}
static Object scanHash(LambdaJ intp, Object hash) {
final Map map = requireHash("scan-hash-table", hash);
final Function, Object> getKey;
if (map instanceof MurmelMap) getKey = ((MurmelMap)map)::getKey;
else getKey = Map.Entry::getKey;
final Iterator> it = map.entrySet().iterator();
if (it.hasNext()) return new InterpreterIteratorGenerator() {
private Map.Entry entry;
@Override public Object applyPrimitive(ConsCell args) {
if (it.hasNext()) { entry = it.next(); final ConsCell tuple = intp.cons(getKey.apply(entry), entry.getValue()); intp.values = intp.cons(tuple, intp.cons(sT, null)); return tuple; }
else { entry = null; intp.values = intp.cons(null, intp.cons(null, null)); return null; }
}
@Override public Object set(Object value) { if (entry != null) { entry.setValue(value); return value; } else throw new SimpleError("no such element"); }
@Override public boolean remove() { it.remove(); entry = null; return true; }
@Override public void printSEx(WriteConsumer out, boolean ignored) { out.print("#"); }
};
else return new InterpreterIteratorGenerator() { @Override public Object applyPrimitive(ConsCell args) { intp.values = intp.cons(null, intp.cons(null, null)); return null; }
@Override public void printSEx(WriteConsumer out, boolean ignored) { out.print("#"); } };
}
/// I/O
/** (read eof-obj?) -> result */
static Object read(ObjectReader lispReader, ConsCell a) {
if (lispReader == null) throw errorUnsupported("read", "%s: lispStdin is " + NIL);
if (a == null) {
final Object eof = new Object();
final Object ret = lispReader.readObj(eof);
if (ret == eof) wrap0(new EOFException("read: EOF"));
return ret;
}
else {
return lispReader.readObj(car(a));
}
}
/** (read-from-string str [eof-obj [start [end]]]) -> result, position */
static Object[] readFromString(SymbolTable st, ConsCell featuresEnvEntry, ConsCell a) {
final String str = requireString("read-from-string", car(a));
final StringReader strReader = new StringReader(str);
a = (ConsCell)cdr(a);
final long[] count = new long[1];
final Object eof;
final long end;
if (a != null) {
eof = car(a);
a = (ConsCell)cdr(a);
if (a != null) {
final long start = requireIntegralNumber("read-from-string", car(a), 0, MOST_POSITIVE_FIXNUM_VAL).longValue();
if (start > str.length()) throw new InvalidIndexError("start must be <= string length");
try { count[0] = strReader.skip(start); } catch (IOException e) { wrap0(e); }
a = (ConsCell)cdr(a);
if (a != null) {
end = requireIntegralNumber("read-from-string", car(a), 0, MOST_POSITIVE_FIXNUM_VAL).longValue();
if (end < start) throw new InvalidIndexError("end must be >= start");
if (end > str.length()) throw new InvalidIndexError("end must be <= string length");
}
else end = -1;
}
else end = -1;
}
else { eof = null; end = -1; }
final ObjectReader reader = makeReader(() -> { if (end != -1 && count[0] == end) return EOF; final int c = strReader.read(); if (c != EOF) count[0]++; return c; }, st, featuresEnvEntry);
final Object ret;
if (eof == null) {
final Object myeof = new Object();
ret = reader.readObj(myeof);
if (ret == myeof) wrap0(new EOFException("read-from-string: EOF"));
}
else ret = reader.readObj(eof);
return new Object[] { ret, count[0] };
}
/** (read-textfile-lines filenamestr [charset]) -> result-string-vector */
static Object readTextfileLines(ConsCell args) {
final Object fileSpec = car(args);
args = requireList("read-textfile-lines", cdr(args));
try {
final Charset cs = getCharset("read-textfile-lines", args);
final List ret;
if (fileSpec == sT) ret = JavaUtil.readStrings(System.in, cs);
else ret = Files.readAllLines(Paths.get(requireString("read-textfile-lines", fileSpec)), cs);
return ret.toArray();
}
catch (Exception e) {
throw wrap(e);
}
}
/** (read-textfile filenamestr [charset [translate-lineend-p]]) -> result-string */
static Object readTextfile(ConsCell args) {
final Object fileSpec = car(args);
args = requireList("read-textfile", cdr(args));
try {
final Charset cs = getCharset("read-textfile", args);
CharSequence s;
if (fileSpec == sT) s = JavaUtil.readString(System.in, cs);
else s = JavaUtil.readString(Paths.get(requireString("read-textfile", fileSpec)), cs);
args = requireList("read-textfile", cdr(args));
final boolean translateLineend = args == null || car(args) != null;
if (translateLineend) s = EolUtil.anyToUnixEol(s);
return s instanceof StringBuilder ? (StringBuilder)s : new StringBuilder(s);
}
catch (Exception e) {
throw wrap(e);
}
}
private static Charset getCharset(String func, ConsCell args) {
return car(args) == null ? StandardCharsets.UTF_8 : Charset.forName(requireString(func, car(args)));
}
/** (write-textfile-lines filenamestr string-sequence [appendp [charset [translate-lineend-p]]]) -> nil */
@SuppressWarnings("unchecked")
static Object writeTextfileLines(ConsCell args) {
final String fileName;
if (car(args) == sT) fileName = null;
else fileName = requireString("write-textfile-lines", car(args));
args = (ConsCell)cdr(args);
final Object seq = car(args);
if (!listp(seq) && !vectorp(seq)) errorNotASequence("write-textfile-lines", seq);
args = (ConsCell)cdr(args);
boolean appendp = false;
String cs = null;
boolean translateLineend = true;
if (args != null) {
if (car(args) != null) appendp = true;
args = (ConsCell)cdr(args);
if (args != null) {
cs = requireString("write-textfile-lines", car(args));
args = (ConsCell)cdr(args);
if (args != null) translateLineend = car(args) != null;
}
}
final Iterator it;
if (svectorp(seq)) it = Arrays.asList((Object[])seq).iterator();
else if (seq instanceof Iterable) it = ((Iterable)seq).iterator(); // covers ConCell and adjustable array which are ArrayLists
else throw errorArgTypeError("sequence of strings", "write-textfile-lines", seq);
Appendable w = null;
RuntimeException le = null;
try {
w = fileName == null ? System.out : bufferedWriter(fileName, appendp, cs);
final String eol = translateLineend ? System.lineSeparator() : "\n";
while (it.hasNext()) {
final String line = requireString("write-textfile-lines", it.next());
w.append(line);
w.append(eol);
}
return null;
}
catch (Throwable e) { le = wrap(e); throw le; }
finally {
if (fileName != null) {
try { if (w != null) ((Closeable)w).close(); }
catch (IOException ioe) {
if (le != null) le.addSuppressed(ioe);
else le = wrap(ioe);
}
}
if (le != null) throw le;
}
}
/** (write-textfile filenamestr string [appendp [charset [translate-lineend-p]]]) -> nil */
static Object writeTextfile(ConsCell args) {
final String fileName;
if (car(args) == sT) fileName = null;
else fileName = requireString("write-textfile", car(args));
args = (ConsCell)cdr(args);
final CharSequence charSeq = requireCharsequence("write-textfile", car(args));
args = (ConsCell)cdr(args);
boolean appendp = false;
String cs = null;
if (args != null) {
if (car(args) != null) appendp = true;
args = (ConsCell)cdr(args);
if (args != null) cs = requireString("write-textfile", car(args));
}
args = requireList("write-textfile", cdr(args));
final boolean translateLineend = args == null || car(args) != null;
Appendable w = null;
RuntimeException le = null;
try {
w = fileName == null ? System.out : bufferedWriter(fileName, appendp, cs);
final String eol = System.lineSeparator();
if (!translateLineend || "\n".equals(eol))
w.append(charSeq);
else for (int i = 0; i < charSeq.length(); i++) {
final char c = charSeq.charAt(i);
if (c == '\n') w.append(eol);
else w.append(c);
}
return null;
}
catch (Throwable e) { le = wrap(e); throw le; }
finally {
if (fileName != null) {
try { if (w != null) ((Closeable)w).close(); }
catch (IOException ioe) {
if (le != null) le.addSuppressed(ioe);
else le = wrap(ioe);
}
}
if (le != null) throw le;
}
}
private static @NotNull BufferedWriter bufferedWriter(@NotNull String fileName, boolean appendp, @Null String cs) throws IOException {
return Files.newBufferedWriter(Paths.get(fileName), cs == null ? StandardCharsets.UTF_8 : Charset.forName(cs),
appendp
? new OpenOption[]{StandardOpenOption.APPEND, StandardOpenOption.CREATE}
: new OpenOption[]{StandardOpenOption.TRUNCATE_EXISTING, StandardOpenOption.CREATE});
}
static Object writeToString(Object arg, boolean printEscape) {
return printSEx(arg, printEscape);
}
static Object write(ObjectWriter lispPrinter, Object arg, boolean printEscape) {
if (lispPrinter == null) throw errorUnsupported("write", "%s: lispStdout is " + NIL);
lispPrinter.printObj(arg, printEscape);
return arg;
}
static Object writeln(ObjectWriter lispPrinter, ConsCell arg, boolean printEscape) {
if (lispPrinter == null) throw errorUnsupported("writeln", "%s: lispStdout is " + NIL);
if (arg != null) {
lispPrinter.printObj(car(arg), printEscape);
}
lispPrinter.printEol();
return car(arg);
}
static Object writeln(ObjectWriter lispPrinter, Object arg) {
if (lispPrinter == null) throw errorUnsupported("writeln", "%s: lispStdout is " + NIL);
lispPrinter.printObj(arg, false);
lispPrinter.printEol();
return arg;
}
static Object writeln(ObjectWriter lispPrinter) {
if (lispPrinter == null) throw errorUnsupported("writeln", "%s: lispStdout is " + NIL);
lispPrinter.printEol();
return null;
}
static Object lnwrite(ObjectWriter lispPrinter, ConsCell arg, boolean printEscape) {
if (lispPrinter == null) throw errorUnsupported("lnwrite", "%s: lispStdout is " + NIL);
lispPrinter.printEol();
if (arg == null) return null;
final Object o;
lispPrinter.printObj(o = car(arg), printEscape);
lispPrinter.printString(" ");
return o;
}
static String format(ObjectWriter lispPrinter, boolean haveIO, ConsCell a) {
return format(lispPrinter, haveIO, false, a);
}
static String formatLocale(ObjectWriter lispPrinter, boolean haveIO, ConsCell a) {
return format(lispPrinter, haveIO, true, a);
}
private static String format(ObjectWriter lispPrinter, boolean haveIO, boolean locale, ConsCell a) {
final String func = locale ? "format-locale" : "format";
varargsMin(func, a, locale ? 3 : 2);
final boolean toString = car(a) == null;
a = (ConsCell) cdr(a);
final String locString;
if (locale) {
if (car(a) != null) {
stringArg(func, "first argument", a);
locString = stringToImmutableString(car(a));
} else locString = null;
a = (ConsCell)cdr(a);
}
else locString = null;
stringArg(func, locale ? "third argument" : "second argument", a);
final String s = stringToImmutableString(car(a));
final Object[] args = listToArray(cdr(a));
try {
if (locString == null) {
if (toString) return EolUtil.anyToUnixEol(String.format(s, args)).toString();
if (!haveIO) throw errorUnsupported(func, "%s: I/O is disabled");
if (lispPrinter == null) throw errorUnsupported(func, "%s: lispStdout is " + NIL);
lispPrinter.printString(EolUtil.anyToUnixEol(String.format(s, args)));
return null;
}
final Locale loc = Locale.forLanguageTag(locString);
if (toString) return EolUtil.anyToUnixEol(String.format(loc, s, args)).toString();
if (lispPrinter == null) throw errorUnsupported(func, "%s: lispStdout is " + NIL);
lispPrinter.printString(EolUtil.anyToUnixEol(String.format(loc, s, args)));
return null;
} catch (IllegalFormatException e) {
// todo sbcl wirft SB-FORMAT:FORMAT-ERROR extends ERROR
throw new SimpleError("%s: illegal format string and/ or arguments: %s. Error ocurred processing the argument(s) %s", func, e.getMessage(), printSEx(a));
}
}
@NotNull private static RuntimeException errorUnsupported(String func, String msg) { throw new LambdaJError(true, msg, func); }
/// misc
static long getInternalRealTime() {
return System.nanoTime();
}
static long getInternalRunTime() {
return getThreadBean("get-internal-run-time").getCurrentThreadCpuTime();
}
@SuppressWarnings("SameParameterValue")
private static ThreadMXBean getThreadBean(final String func) {
final ThreadMXBean threadBean = ManagementFactory.getThreadMXBean();
if (threadBean == null)
throw errorUnsupported(func, "%s: ThreadMXBean not supported in this Java Runtime");
if (!threadBean.isCurrentThreadCpuTimeSupported())
throw errorUnsupported(func, "%s: ThreadMXBean.getCurrentThreadCpuTime() not supported in this Java Runtime");
return threadBean;
}
static Object sleep(Object seconds) {
try {
final long millis = (long)(toDouble("sleep", seconds) * 1e3D);
Thread.sleep(millis);
return null;
} catch (InterruptedException e) {
Thread.currentThread().interrupt();
throw new LambdaJError("sleep: got interrupted");
}
}
static long getUniversalTime() {
final ZoneId utc = ZoneId.of("UTC");
final ZonedDateTime ld1900 = ZonedDateTime.of(1900, 1, 1, 0, 0, 0, 0, utc);
return ld1900.until(ZonedDateTime.now(utc), ChronoUnit.SECONDS);
}
interface Boolresult { Object apply(boolean b); }
static > ConsCell getDecodedTime(T lb, Boolresult boolResult) {
final Instant now = Clock.systemDefaultZone().instant();
final ZonedDateTime n = now.atZone(ZoneId.systemDefault());
final ZoneRules rules = n.getZone().getRules();
final boolean daylightSavings = rules.isDaylightSavings(now);
final double offset = -rules.getOffset(now).get(ChronoField.OFFSET_SECONDS) / 3600.0;
//get-decoded-time => second, minute, hour, date, month, year, day, daylight-p, zone
return (ConsCell)lb.appendElements(n.getSecond(), n.getMinute(), n.getHour(),
n.getDayOfMonth(), n.getMonthValue(), n.getYear(), n.getDayOfWeek().getValue() - 1,
boolResult.apply(daylightSavings), offset, null).first();
}
/** expand a single macro call */
static Object macroexpand1(LambdaJ intp, ConsCell args) {
oneArg("macroexpand-1", args);
final Object maybeMacroCall = car(args);
if (!consp(maybeMacroCall)) {
intp.values = intp.cons(maybeMacroCall, intp.cons(null, null));
return maybeMacroCall;
}
return macroexpandImpl(intp, (ConsCell) maybeMacroCall, null);
}
static Object gensym(Object name) {
if (name != null) return new LambdaJSymbol(requireString("gensym", name));
else return new LambdaJSymbol("gensym");
}
static void error(Map typeSpecs, Object datum, Object... args) {
if (datum instanceof Throwable) wrap0((Throwable)datum);
if (stringp(datum)) { throw new SimpleError(requireString(ERROR, datum), args); }
final String msg;
switch (args.length) {
case 0: msg = null; break;
case 1: msg = String.format(requireString(ERROR, args[0])); break;
default: msg = String.format(requireString(ERROR, args[0]), Arrays.copyOfRange(args, 1, args.length)); break;
}
@SuppressWarnings("SuspiciousMethodCalls")
final TypeSpec murmelTypeSpec = typeSpecs.get(datum);
if (murmelTypeSpec != null) murmelTypeSpec.thrower.accept(msg);
throw new SimpleTypeError("error: unknown condition type " + printSEx(datum) + ": " + msg);
}
}
/// Murmel runtime support for Java FFI - Murmel calls Java
static final class JFFI {
private JFFI() {}
private static class JavaConstructor implements Primitive, MurmelJavaProgram.CompilerPrimitive {
private final Constructor> constructor;
private final UnaryOperator[] argConv;
private JavaConstructor(Constructor> constructor, Iterable> paramClassNames) {
this.constructor = constructor;
this.argConv = makeArgConv(paramClassNames, constructor.getParameterCount(), 0);
}
@Override public void printSEx(WriteConsumer out, boolean ignored) { out.print(toString()); }
@Override public String toString() { return "#'; }
@Override public Object applyPrimitive(ConsCell x) { return applyCompilerPrimitive(listToArray(x)); }
@Override public Object applyCompilerPrimitive(Object... args) {
final String name = "new " + constructor.getDeclaringClass().getName();
javaCallArgCheck(name, constructor, argConv, args);
try { return constructor.newInstance(args); }
catch (InvocationTargetException ite) { throw new LambdaJError(true, "%s: %s", name, ite.getTargetException().toString()); }
catch (Exception e) { throw new LambdaJError(true, "%s: %s", name, e.toString()); }
}
}
@SuppressWarnings("unchecked")
static UnaryOperator[] makeArgConv(Iterable> paramClassNames, int paramCount, int skipThis) {
final UnaryOperator[] argConv = new UnaryOperator[paramCount + skipThis];
int i = 0;
if (paramClassNames != null) for (Object paramClassName: paramClassNames) {
final String strParamClassName = (String)paramClassName;
final Object[] entry = classByName.get(strParamClassName);
if (entry != null) argConv[i + skipThis] = (UnaryOperator)entry[2];
i++;
}
return argConv;
}
private static final class JavaMethod implements Primitive, MurmelJavaProgram.CompilerPrimitive {
@FunctionalInterface private interface Invoker { Object invoke(Object... args) throws Throwable; }
private final Method method;
private final Invoker invoke;
private final UnaryOperator[] argConv;
@SuppressWarnings("unchecked")
private JavaMethod(Method method, Iterable> paramClassNames) {
this.method = method;
int paramCount = method.getParameterCount();
final boolean isStatic = Modifier.isStatic(method.getModifiers());
if (!isStatic) paramCount++; // this + parameters
this.argConv = makeArgConv(paramClassNames, method.getParameterCount(), isStatic ? 0 : 1);
if (!isStatic) {
final String className = method.getDeclaringClass().getName();
final Object[] entry = classByName.get(className);
if (entry != null) argConv[0] = (UnaryOperator)entry[2];
}
try {
final MethodHandle mh = MethodHandles.publicLookup().unreflect(method);
if (method.isVarArgs()) invoke = mh::invokeWithArguments;
else switch (paramCount) {
case 0: invoke = args -> mh.invoke(); break;
case 1: invoke = args -> mh.invoke(args[0]); break;
case 2: invoke = args -> mh.invoke(args[0], args[1]); break;
case 3: invoke = args -> mh.invoke(args[0], args[1], args[2]); break;
case 4: invoke = args -> mh.invoke(args[0], args[1], args[2], args[3]); break;
case 5: invoke = args -> mh.invoke(args[0], args[1], args[2], args[3], args[4]); break;
case 6: invoke = args -> mh.invoke(args[0], args[1], args[2], args[3], args[4], args[5]); break;
case 7: invoke = args -> mh.invoke(args[0], args[1], args[2], args[3], args[4], args[5], args[6]); break;
default: invoke = mh::invokeWithArguments; // that's slow
}
}
catch (IllegalAccessException iae) { throw new LambdaJError(iae, false, "cannot access " + method.getDeclaringClass().getSimpleName(), method.getName()); }
}
@Override public void printSEx(WriteConsumer out, boolean ignored) { out.print(toString()); }
@Override public String toString() { return "#'; }
@Override public Object applyPrimitive(ConsCell x) { return applyCompilerPrimitive(listToArray(x)); }
@Override public Object applyCompilerPrimitive(Object... args) {
final Method method = this.method;
javaCallArgCheck(method.getName(), method, argConv, args);
if (!Modifier.isStatic(method.getModifiers()) && !method.getDeclaringClass().isInstance(args[0]))
throw new SimpleTypeError(JMETHOD + ": %s is not an instance of class %s", args[0], method.getDeclaringClass().getName());
try { return invoke.invoke(args); }
catch (ArithmeticException | ClassCastException | IndexOutOfBoundsException e) { throw new LambdaJError(e); }
catch (LambdaJError e) { throw e; }
catch (Throwable t) { throw new LambdaJError(true, "%s.%s: %s", method.getDeclaringClass().getName(), method.getName(), t.toString()); }
}
}
/** check the number of args vs. number of parameters, and then convert argument types from Murmel to Java */
static void javaCallArgCheck(String name, Executable method, UnaryOperator[] argConv, Object[] args) {
final int paramCount = argConv.length;
final int argCount = args == null ? 0 : args.length;
if (method.isVarArgs()) { if (argCount < paramCount - 1) errorVarargsCount(name, paramCount-1, argCount); }
else { if (paramCount != argCount) errorArgCount(name, paramCount, paramCount, argCount, null); }
UnaryOperator conv = null;
if (args != null) for (int i = 0; i < argCount; i++) {
if (i < argConv.length) conv = argConv[i];
if (conv != null) args[i] = conv.apply(args[i]);
}
}
private static final Class>[] EMPTY_CLASS_ARRAY = new Class[0];
/** find a constructor, static or instance method from the given class with the given name and parameter classes if any. */
static Primitive findMethod(String className, String methodName, Iterable> paramClassNames) {
final ArrayList> paramClasses = new ArrayList<>(10);
if (paramClassNames != null) for (Object paramClassName: paramClassNames) {
final String strParamClassName = (String)paramClassName;
try { paramClasses.add(findClass(strParamClassName)); }
catch (ClassNotFoundException e) { throw new LambdaJError(true, JMETHOD + ": exception finding parameter class %s: %s", strParamClassName, e.toString()); }
}
final Class>[] params = paramClasses.isEmpty() ? null : paramClasses.toArray(EMPTY_CLASS_ARRAY);
try {
final Class> clazz = findClass(className);
return "new".equals(methodName)
? new JavaConstructor(clazz.getDeclaredConstructor(params), paramClassNames)
: new JavaMethod(clazz.getMethod(methodName, params), paramClassNames);
}
catch (LambdaJError le) { throw le; }
catch (Exception e) { throw new LambdaJError(true, JMETHOD + ": exception finding method %s.%s: %s", className, methodName, e.getMessage()); }
}
static final Map classByName = JavaUtil.newHashMap(50);
static {
classByName.put("boolean", new Object[] { boolean.class, "toBoolean", (UnaryOperator)(MurmelJavaProgram::toBoolean) });
classByName.put("byte", new Object[] { byte.class, "toByte", (UnaryOperator)(MurmelJavaProgram::toByte)});
classByName.put("short", new Object[] { short.class, "toShort", (UnaryOperator)(MurmelJavaProgram::toShort) });
classByName.put("int", new Object[] { int.class, "toInt", (UnaryOperator)(MurmelJavaProgram::toInt) });
classByName.put("long", new Object[] { long.class, "toLong", (UnaryOperator)(MurmelJavaProgram::toLong) });
classByName.put("float", new Object[] { float.class, "toFloat", (UnaryOperator)(MurmelJavaProgram::toFloat) });
classByName.put("double", new Object[] { double.class, "toDouble", (UnaryOperator)(MurmelJavaProgram::toDouble)});
classByName.put("char", new Object[] { char.class, "requireChar", (UnaryOperator)(MurmelJavaProgram::requireChar) });
classByName.put("boolean...", new Object[] { boolean[].class, "toBoolean", (UnaryOperator)(MurmelJavaProgram::toBoolean) });
classByName.put("byte...", new Object[] { byte[].class, "toByte", (UnaryOperator)(MurmelJavaProgram::toByte)});
classByName.put("short...", new Object[] { short[].class, "toShort", (UnaryOperator)(MurmelJavaProgram::toShort) });
classByName.put("int...", new Object[] { int[].class, "toInt", (UnaryOperator)(MurmelJavaProgram::toInt) });
classByName.put("long...", new Object[] { long[].class, "toLong", (UnaryOperator)(MurmelJavaProgram::toLong) });
classByName.put("float...", new Object[] { float[].class, "toFloat", (UnaryOperator)(MurmelJavaProgram::toFloat) });
classByName.put("double...", new Object[] { double[].class, "toDouble", (UnaryOperator)(MurmelJavaProgram::toDouble)});
classByName.put("char...", new Object[] { char[].class, "requireChar", (UnaryOperator)(MurmelJavaProgram::requireChar) });
putWithAlias("Object", new Object[] { Object.class, "requireNotNull", (UnaryOperator)(MurmelJavaProgram::requireNotNull) });
putWithAlias("Object?", new Object[] { Object.class, null, null });
putWithAlias("Number", new Object[] { Number.class, "requireNumber", (UnaryOperator)(MurmelJavaProgram::requireNumber) });
putWithAlias("Number?", new Object[] { Number.class, "requireNumberOrNull", (UnaryOperator)(MurmelJavaProgram::requireNumberOrNull) });
putWithAlias("Boolean", new Object[] { Boolean.class, "toBoolean", (UnaryOperator)(MurmelJavaProgram::toBoolean) });
putWithAlias("Byte", new Object[] { Byte.class, "toByte", (UnaryOperator)(MurmelJavaProgram::toByte) });
putWithAlias("Short", new Object[] { Short.class, "toShort", (UnaryOperator)(MurmelJavaProgram::toShort) });
putWithAlias("Integer", new Object[] { Integer.class, "toInt", (UnaryOperator)(MurmelJavaProgram::toInt) });
putWithAlias("Long", new Object[] { Long.class, "toLong", (UnaryOperator)(MurmelJavaProgram::toLong) });
putWithAlias("Float", new Object[] { Float.class, "toFloat", (UnaryOperator)(MurmelJavaProgram::toFloat) });
putWithAlias("Double", new Object[] { Double.class, "toDouble", (UnaryOperator)(MurmelJavaProgram::toDouble) });
putWithAlias("Object...", new Object[] { Object[].class, "requireNotNull", (UnaryOperator)(MurmelJavaProgram::requireNotNull) });
putWithAlias("Object?...", new Object[] { Object[].class, null, null });
putWithAlias("Number...", new Object[] { Number[].class, "requireNumber", (UnaryOperator)(MurmelJavaProgram::requireNumber) });
putWithAlias("Number?...", new Object[] { Number[].class, "requireNumberOrNull", (UnaryOperator)(MurmelJavaProgram::requireNumberOrNull) });
putWithAlias("Boolean...", new Object[] { Boolean[].class, "toBoolean", (UnaryOperator)(MurmelJavaProgram::toBoolean) });
putWithAlias("Byte...", new Object[] { Byte[].class, "toByte", (UnaryOperator)(MurmelJavaProgram::toByte) });
putWithAlias("Short...", new Object[] { Short[].class, "toShort", (UnaryOperator)(MurmelJavaProgram::toShort) });
putWithAlias("Integer...", new Object[] { Integer[].class, "toInt", (UnaryOperator)(MurmelJavaProgram::toInt) });
putWithAlias("Long...", new Object[] { Long[].class, "toLong", (UnaryOperator)(MurmelJavaProgram::toLong) });
putWithAlias("Float...", new Object[] { Float[].class, "toFloat", (UnaryOperator)(MurmelJavaProgram::toFloat) });
putWithAlias("Double...", new Object[] { Double[].class, "toDouble", (UnaryOperator)(MurmelJavaProgram::toDouble) });
putWithAlias("Object?[]", new Object[] { Object[].class, "requireArray", (UnaryOperator)(MurmelJavaProgram::requireArray) });
putWithAlias("Character", new Object[] { Character.class, "requireChar", (UnaryOperator)(MurmelJavaProgram::requireChar) });
putWithAlias("CharSequence", new Object[] { CharSequence.class, "requireCharSequence", (UnaryOperator)(MurmelJavaProgram::requireCharSequence) });
putWithAlias("String", new Object[] { String.class, "requireString", (UnaryOperator)(MurmelJavaProgram::requireString) });
putWithAlias("String?", new Object[] { String.class, "requireStringOrNull", (UnaryOperator)(MurmelJavaProgram::requireStringOrNull) });
putWithAlias("Character...", new Object[] { Character[].class, "requireChar", (UnaryOperator)(MurmelJavaProgram::requireChar) });
putWithAlias("CharSequence...", new Object[] { CharSequence[].class, "requireCharSequence", (UnaryOperator)(MurmelJavaProgram::requireCharSequence) });
putWithAlias("String...", new Object[] { String[].class, "requireString", (UnaryOperator)(MurmelJavaProgram::requireString) });
putWithAlias("String?...", new Object[] { String[].class, "requireStringOrNull", (UnaryOperator)(MurmelJavaProgram::requireStringOrNull) });
putWithUtilAlias("Comparator", new Object[] { Comparator.class, "java.util.Comparator.class.cast", (UnaryOperator)(Comparator.class::cast) });
putWithMurmelAlias("ConsCell?", new Object[] { ConsCell.class, "requireList", (UnaryOperator)(MurmelJavaProgram::requireList) });
putWithMurmelAlias("ConsCell", new Object[] { ConsCell.class, "requireCons", (UnaryOperator)(MurmelJavaProgram::requireCons) });
}
private static void putWithAlias(String clsName, Object[] entry) { classByName.put(clsName, entry); classByName.put("java.lang." + clsName, entry); }
private static void putWithUtilAlias(String clsName, Object[] entry) { classByName.put(clsName, entry); classByName.put("java.util." + clsName, entry); }
private static void putWithMurmelAlias(String clsName, Object[] entry) { classByName.put(clsName, entry); classByName.put("io.github.jmurmel.LambdaJ." + clsName, entry); }
/** find and load the class given by the (possibly abbreviated) name {@code clsName} */
private static Class> findClass(String clsName) throws ClassNotFoundException {
final Object[] entry = classByName.get(clsName);
if (entry != null) return (Class>)entry[0];
return Class.forName(clsName);
}
private static class DynamicProxy implements InvocationHandler {
private final Map methods;
DynamicProxy(Map methods) { this.methods = methods; }
@Override public Object invoke(Object proxy, Method method, Object[] args) throws Throwable {
final MurmelFunction func = methods.get(method);
if (func == null) errorNotAFunction("no function for method %s", method.getName());
if (args == null) return func.apply();
else return func.apply(args);
}
}
// todo ConsCell args umstellen auf Object... args? intf: statt name vergleichen: klasse laden und isInstance?
static Object makeProxy(LambdaJ intp, MurmelJavaProgram program, ConsCell args) {
final String intf = requireString("jproxy", car(args));
final String method = requireString("jproxy", cadr(args));
if ("java.util.Comparator".equals(intf) && "compare".equals(method)) {
return new Comparator() { private final MurmelFunction compare = getFunction(intp, program, caddr(args), int.class);
@Override public String toString() { return "#"; }
@Override public int compare(Object o1, Object o2) { // the (int)-cast is safe because JFFI#getFunction() constructs a function that contains a type conversion
try { return (int)compare.apply(o1, o2); }
catch (Exception e) { throw wrap(e); } } };
}
else if ("java.lang.Runnable".equals(intf) && "run".equals(method)) {
return new Runnable() { private final MurmelFunction f = getFunction(intp, program, caddr(args), void.class);
@Override public String toString() { return "#"; }
@Override public void run() { try { f.apply(); }
catch (Exception e) { wrap0(e); } } };
}
else return makeDynamicProxy(intp, program, intf, args);
}
private static Object makeDynamicProxy(LambdaJ intp, MurmelJavaProgram program, String intf, ConsCell args) {
try {
final Class> clazz = findClass(intf);
final Map methodToMurmelFunction = new HashMap<>(); // todo kann/ soll das eine IdentityHashMap sein?
final Map nameToMethod = new HashMap<>();
final MurmelFunction notImplemented = a -> { throw new UndefinedFunction("method is not implemented"); };
for (Method m: Object.class.getMethods()) {
methodToMurmelFunction.put(m, notImplemented);
nameToMethod.put(m.getName(), m);
}
for (Method m: clazz.getMethods()) {
methodToMurmelFunction.put(m, notImplemented);
nameToMethod.put(m.getName(), m);
}
final String asString = "#";
methodToMurmelFunction.put(nameToMethod.get("toString"), a -> asString);
methodToMurmelFunction.put(Writeable.class.getMethod("printSEx", WriteConsumer.class, boolean.class),
a -> { final WriteConsumer out = (WriteConsumer)a[0]; out.print(asString); return null; });
for (ConsCell lst = requireList("jproxy", cdr(args)); lst != null; ) {
if (cdr(lst) == null) throw new ProgramError("jproxy: odd number of method/functions");
final Object form = cadr(lst);
if (form == null) throw new UndefinedFunction("jproxy: not a function: " + NIL);
final String name = requireString("jproxy", car(lst));
final Method method = nameToMethod.get(name);
if (method == null) throw new UndefinedFunction("jproxy: method %s does not exist in interface %s or is not accessible", name, intf);
methodToMurmelFunction.put(method, getFunction(intp, program, form, method.getReturnType()));
lst = (ConsCell)cddr(lst);
}
return Proxy.newProxyInstance(LambdaJ.class.getClassLoader(), new Class>[] { clazz, Writeable.class }, new DynamicProxy(methodToMurmelFunction));
}
catch (ClassNotFoundException | NoSuchMethodException e) {
throw new LambdaJError(true, "exception loading class %s", intf);
}
}
static @NotNull MurmelFunction getFunction(LambdaJ intp, MurmelJavaProgram program, Object function, Class> returnType) {
final String funcName = printSEx(function).toString();
final Function convertReturnType = makeConvertReturnType(funcName, returnType);
if (function instanceof MurmelJavaProgram.CompilerPrimitive) { return args -> convertReturnType.apply(((MurmelJavaProgram.CompilerPrimitive)function).applyCompilerPrimitive(args)); }
if (function instanceof Primitive) { return args -> convertReturnType.apply(((Primitive)function).applyPrimitiveVarargs(args)); }
if (function instanceof Closure && intp != null) { final CallLambda callLambda = intp.new CallLambda((Closure)function);
return args -> convertReturnType.apply(callLambda.apply(args)); }
if (function instanceof MurmelFunction && program != null) { return args -> convertReturnType.apply(program.funcall((MurmelFunction)function, args)); /* must use the TCO trampoline */ }
throw errorNotAFunction("getFunction: not a primitive or " + LAMBDA + ": %s", funcName);
}
private static Function makeConvertReturnType(String func, Class> returnType) {
if (Boolean.class.equals(returnType) || boolean.class.equals(returnType)) return Objects::nonNull;
if (Byte.class.equals(returnType) || byte.class.equals(returnType)) return value -> requireIntegralNumber(func, value, Byte.MIN_VALUE, Byte.MAX_VALUE).byteValue();
if (Short.class.equals(returnType) || short.class.equals(returnType)) return value -> requireIntegralNumber(func, value, Short.MIN_VALUE, Short.MAX_VALUE).shortValue();
if (Integer.class.equals(returnType) || int.class.equals(returnType)) return value -> requireIntegralNumber(func, value, Integer.MIN_VALUE, Integer.MAX_VALUE).intValue();
if (Long.class.equals(returnType) || long.class.equals(returnType)) return value -> requireIntegralNumber(func, value, Long.MIN_VALUE, Long.MAX_VALUE).longValue();
if (Double.class.equals(returnType) || double.class.equals(returnType)) return value -> requireNumber(func, value).doubleValue();
if (Character.class.equals(returnType) || char.class.equals(returnType)) return value -> requireChar(func, value);
if (Void.class.equals(returnType) || void.class.equals(returnType)) return value -> null;
if (Number.class.equals(returnType)) return value -> requireNumber(func, value);
if (String.class.equals(returnType)) return value -> requireString(func, value);
if (CharSequence.class.equals(returnType)) return value -> requireCharsequence(func, value);
// todo weitere typen und/ oder error oder converter aus der HashMap auslesen? was passiert bei arrays?
return value -> value == null ? null : returnType.cast(value);
}
}
ConsCell values = NO_VALUES;
Random getRandom() {
assert have(Features.HAVE_NUMBERS) : "getRandom() should only be called when feature NUMBERs is enabled";
assert randomStateEnvEntry != null;
if (cdr(randomStateEnvEntry) == null)
randomStateEnvEntry.rplacd(new Random());
return (Random)cdr(randomStateEnvEntry);
}
TurtleFrame current_frame;
/** Return {@code a} as a TurtleFrame or current_frame if null, error if {@code a} is not of type frame. */
TurtleFrame requireFrame(String func, Object a) {
final TurtleFrame ret;
if (a == null) {
ret = current_frame;
}
else {
if (!(a instanceof TurtleFrame)) throw errorArgTypeError("frame", func, a);
ret = (TurtleFrame) a;
}
if (ret == null) throw new UnboundVariable("%s: no frame argument and no current frame", func);
return ret;
}
private ObjectReader lispReader;
private ObjectWriter lispPrinter;
/** return the current stdin */
public ObjectReader getLispReader() { return lispReader; }
/** return the current stdout */
public ObjectWriter getLispPrinter() { return lispPrinter; }
ObjectWriter getLispPrinter(ConsCell args, int nth, ObjectWriter defaultIfNull) {
final ConsCell ccDest = requireList("write", nthcdr(nth, args));
if (ccDest == null) return defaultIfNull;
final Object consumer = car(ccDest);
if (consumer == null) return defaultIfNull;
if (consumer == sT) return lispPrinter;
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));
}
/** set new stdin/stdout */
public void setReaderPrinter(ObjectReader lispStdin, ObjectWriter lispStdout) {
this.lispReader = lispStdin;
this.lispPrinter = lispStdout;
}
/** build an environment by prepending the previous environment {@code env} with the primitive functions,
* generating symbols in the {@link SymbolTable} {@link #symtab} on the fly */
private void environment() {
WellknownSymbol.forAllPrimitives(features, w -> extendGlobal(internWellknown(w.sym), (Primitive)a -> w.applyPrimitive(this, a)));
if (have(Features.HAVE_T)) extendGlobal(sT, sT);
if (have(Features.HAVE_NIL)) extendGlobal(sNil, null);
if (have(Features.HAVE_VECTOR)) extendGlobal(ARRAY_DIMENSION_LIMIT, ARRAY_DIMENSION_LIMIT_VAL);
if (have(Features.HAVE_APPLY)) {
final LambdaJSymbol sApply = intern(APPLY);
ocApply = new OpenCodedPrimitive(sApply);
extendGlobal(sApply, ocApply);
}
if (have(Features.HAVE_XTRA)) {
final LambdaJSymbol sEval = intern(EVAL);
ocEval = new OpenCodedPrimitive(sEval);
extendGlobal(sEval, ocEval);
assert conditionHandlerEnvEntry != null : "when feature XTRA is enabled conditionHandlerEnvEntry should be != null";
extendGlobal(conditionHandlerEnvEntry);
}
if (have(Features.HAVE_UTIL)) {
extendGlobal(featuresEnvEntry);
extendGlobal(INTERNAL_TIME_UNITS_PER_SECOND, (long)1e9);
}
if (have(Features.HAVE_NUMBERS)) {
extendGlobal(PI, Math.PI);
extendGlobal(MOST_POSITIVE_FIXNUM, MOST_POSITIVE_FIXNUM_VAL);
extendGlobal(MOST_NEGATIVE_FIXNUM, MOST_NEGATIVE_FIXNUM_VAL);
assert randomStateEnvEntry != null : "when feature NUMBERs is enabled randomStateEnvEntry should be != null";
extendGlobal(randomStateEnvEntry);
}
}
///
/// ## Invoking the interpreter
///
/// JMurmel native embed API: Java calls Murmel with getValue() and getFunction()
/** eval {@code forms} and return the primary result, interpreter will be reset before eval */
public Object evalString(String forms) {
return evalString(forms, true, null, null);
}
/** eval {@code forms} and return the primary result, {@code reset} determines if the interpreter will be reset before eval */
public Object evalString(String forms, boolean reset, ReadSupplier in, WriteConsumer out) {
try {
final ObjectReader program = new SExpressionReader(features, trace, tracer, symtab, featuresEnvEntry, new StringReader(forms)::read, null);
final ObjectReader inReader = in == null ? null : makeReader(in, null);
final ObjectWriter outWriter = out == null ? null : makeWriter(out);
return interpretExpressions(program, inReader, outWriter, null, reset);
}
catch (LambdaJError e) { throw e; }
catch (Exception e) { throw wrap(e); }
}
/** embed API: interface for compiled lambdas as well as primitives and jmethods, used for embedding as well as compiled Murmel */
public interface MurmelFunction { Object apply(Object... args) throws Exception; }
/** embed API: Return the value of {@code globalSymbol} in the interpreter's current global environment */
public Object getValue(String globalSymbol) {
final ConsCell envEntry = lookupGlobalEntry(intern(globalSymbol));
if (envEntry != null) return cdr(envEntry);
throw errorUnbound("getValue", globalSymbol);
}
private class CallLambda implements MurmelFunction {
private final Closure lambda;
CallLambda(Closure lambda) { this.lambda = lambda; }
@Override public Object apply(Object... args) {
return eval(cons(lambda, arraySlice(args, 0)), null);
}
}
/** embed API: Return the function {@code funcName}
*
*
Function objects of Lambdas will be usable until the interpreter's environment is rebuilt
* by a call to interpretExpression/s, eg.
* MurmelFunction f = getFunction("my-function");
* interpreter.interpretExpressions("...");
* f.apply(1, 2, 3); // this will throw a "stale function..." Exception
*
*/
public @NotNull MurmelFunction getFunction(String funcName) {
return getFunction(this, funcName, getValue(funcName));
}
private static @NotNull MurmelFunction getFunction(LambdaJ intp, String funcName, Object function) {
if (function instanceof MurmelJavaProgram.CompilerPrimitive) { return ((MurmelJavaProgram.CompilerPrimitive)function)::applyCompilerPrimitive; }
if (function instanceof Primitive) { return ((Primitive)function)::applyPrimitiveVarargs; }
if (function instanceof Closure) { return intp.new CallLambda((Closure)function); }
if (function instanceof MurmelFunction) { return args -> intp.compiledProgram.funcall((MurmelFunction)function, args); /* must use the TCO trampoline */ }
throw errorNotAFunction("getFunction: not a primitive or " + LAMBDA + ": %s", funcName);
}
public interface MurmelProgram {
Object getValue(String globalSymbol);
@NotNull MurmelFunction getFunction(String funcName);
Object body();
void setCommandlineArgumentList(ConsCell argList);
ObjectReader getLispReader();
ObjectWriter getLispPrinter();
void setReaderPrinter(ObjectReader reader, ObjectWriter writer);
void setReaderPrinter(ReadSupplier in, WriteConsumer out);
}
/** Turn {@code program} into an interpreted Murmel program: {@code program} will be wrapped in the method
* {@link MurmelProgram#body} that can be run multiple times. */
public MurmelProgram formsToInterpretedProgram(String program, ReadSupplier in, WriteConsumer out) {
return new CallProgram(program, in, out);
}
private class CallProgram implements MurmelProgram {
private final String program;
private ObjectReader lispReader;
private ObjectWriter lispPrinter;
CallProgram(String program, ReadSupplier in, WriteConsumer out) {
this.program = program;
this.lispReader = in == null ? null : new SExpressionReader(features, TraceLevel.TRC_NONE, null, symtab, featuresEnvEntry, in, null);
this.lispPrinter = out == null ? null : makeWriter(out);
}
@Override public Object getValue(String globalSymbol) { return LambdaJ.this.getValue(globalSymbol); }
@Override public @NotNull MurmelFunction getFunction(String funcName) { return LambdaJ.this.getFunction(funcName); }
@Override public void setCommandlineArgumentList(ConsCell args) {
extendGlobal(intern(COMMAND_LINE_ARGUMENT_LIST), args);
}
@Override public ObjectReader getLispReader() { return LambdaJ.this.getLispReader(); }
@Override public ObjectWriter getLispPrinter() { return LambdaJ.this.getLispPrinter(); }
@Override public void setReaderPrinter(ObjectReader reader, ObjectWriter writer) {
LambdaJ.this.setReaderPrinter(reader, writer);
this.lispReader = reader; lispPrinter = writer;
}
@Override public void setReaderPrinter(ReadSupplier in, WriteConsumer out) {
this.lispReader = in == null ? null : new SExpressionReader(features, TraceLevel.TRC_NONE, null, symtab, featuresEnvEntry, in, null);
this.lispPrinter = out == null ? null : makeWriter(out);
LambdaJ.this.setReaderPrinter(lispReader, lispPrinter);
}
@Override public Object body() {
final ObjectReader reader = new SExpressionReader(features, trace, tracer, symtab, featuresEnvEntry, new StringReader(program)::read, null);
return interpretExpressions(reader, this.lispReader, lispPrinter, null, false);
}
}
/// JMurmel JSR-223 embed API - Java calls Murmel with JSR223 eval
/** evalScript is for JSR-223 support. */
public Object evalScript(Reader program, Reader in, Writer out, Map engineBindings) {
final SExpressionReader lispStdin = makeReader(in::read, null);
final SExpressionWriter lispStdout = new SExpressionWriter(new WrappingWriter(out)::append);
if (speed == -1) init(lispStdin, lispStdout, null);
else setReaderPrinter(lispStdin, lispStdout);
if (engineBindings != null) for (Map.Entry entry: engineBindings.entrySet()) {
extendGlobal(entry.getKey(), entry.getValue()); // create new or replace existing binding
}
final ObjectReader scriptParser = makeReader(program::read, null);
currentSource = null;
final Object eof = "EOF";
Object result = null;
Object exp;
while ((exp = scriptParser.readObj(true, eof)) != eof) {
result = expandAndEval(exp, null);
}
return result;
}
/// JMurmel native embed API - Java calls Murmel
/** Build environment, read a single S-expression from {@code in}, invoke {@code eval()} and return result.
*
*
After the expression was read from {@code in}, the primitive function {@code read} (if used)
* will read S-expressions from {@code in} as well,
* and {@code write}/ {@code writeln} will write S-Expressions to {@code out}. */
public Object interpretExpression(ReadSupplier in, WriteConsumer out) {
final ObjectReader parser = init(in, out, null);
final Object exp = parser.readObj(true, null);
final long tStart = System.nanoTime();
final Object result = expandAndEval(exp, null); // don't just use eval - maybe there are no macros to expand but expandAndEval also does syntax checks. Also they could pass a progn form containing macros.
traceStats(tStart);
return result;
}
/**
Build environment, repeatedly read an S-expression from {@code programSupplier} and invoke {@code eval()} until EOF,
* return result of last expression.
*
*
The primitive function {@code read} (if used) will read S-expressions from {@code in}
* and {@code write}/ {@code writeln} will write S-Expressions to {@code out}. */
public Object interpretExpressions(ReadSupplier programSupplier, ReadSupplier in, WriteConsumer out) {
final ObjectReader program = new SExpressionReader(features, trace, tracer, symtab, featuresEnvEntry, programSupplier, null);
final ObjectReader inReader = new SExpressionReader(features, TraceLevel.TRC_NONE, null, symtab, featuresEnvEntry, in, null);
final ObjectWriter outWriter = makeWriter(out);
return interpretExpressions(program, inReader, outWriter, null);
}
/**
Build environment, repeatedly read an expression from {@code program} and invoke {@code eval()} until EOF,
* return result of last expression.
*
*
The primitive function {@code read} (if used) will read expressions from {@code inReader},
* and {@code write}/ {@code writeln} will write Objects to {@code out}. */
public Object interpretExpressions(ObjectReader program, ObjectReader inReader, ObjectWriter outWriter, CustomEnvironmentSupplier customEnv) {
return interpretExpressions(program, inReader, outWriter, customEnv, true);
}
public Object interpretExpressions(ObjectReader program, ObjectReader inReader, ObjectWriter outWriter, CustomEnvironmentSupplier customEnv, boolean reset) {
final ConsCell customEnvironment = customEnv == null ? null : customEnv.customEnvironment(symtab);
if (reset || globals.isEmpty()) init(inReader, outWriter, customEnvironment);
else setReaderPrinter(null, outWriter);
currentSource = program.getInput();
final boolean traceStats = trace.ge(TraceLevel.TRC_STATS);
final Object eof = "EOF";
Object result = null;
Object exp;
while ((exp = program.readObj(true, eof)) != eof) {
final long tStart = traceStats ? System.nanoTime() : 0;
result = expandAndEval(exp, null);
if (traceStats) traceStats(tStart);
}
return result;
}
/** print and reset interpreter stats and wall time. preceeded and followed by a newline. */
void traceStats(long startNanos) {
if (trace.ge(TraceLevel.TRC_STATS)) {
tracer.println("");
tracer.println("*** max Murmel evaluator recursion: " + maxEvalLevel + " ***");
tracer.println("*** max eval() on Java stack: " + maxEvalStack + " ***");
tracer.println("*** total ConsCells: " + nCells + " ***");
if (trace.ge(TraceLevel.TRC_ENVSTATS)) tracer.println("*** max env length: " + maxEnvLen + " ***");
final long nanos = System.nanoTime() - startNanos;
final long millis = (long)(nanos * 0.000001D);
final String ms = Long.toString(millis) + '.' + ((long) (nanos * 0.001D + 0.5D) - (long) (millis * 1000D));
tracer.println("*** elapsed wall time: " + ms + "ms ***");
tracer.println("");
resetCounters();
}
}
/// static void main() - run JMurmel from the command prompt (interactive)
/** static main() function for commandline use of the Murmel interpreter */
public static void main(String[] args) {
final int rc = Cli.mainInternal(args);
// if rc == 0 then don't System.exit() but simply return from main so that the program will only end after all TurtleFrames have been closed
if (rc != 0) System.exit(rc);
}
/** wrap all the CLI stuff in a utility class.
* For embedded use of JMurmel/ LambdaJ one could remove the function {@link #main} and the class {@link Cli},
* and (unless it is used) the class {@link MurmelJavaCompiler} as well. */
static final class Cli {
private Cli() {}
private enum Action { INTERPRET, TO_JAVA, TO_JAR, COMPILE_AND_RUN, }
static class Exit extends RuntimeException {
final int rc;
Exit(int rc) { super(null, null, false, false); this.rc = rc; }
}
static final Exit EXIT_SUCCESS = new Exit(0);
static final Exit EXIT_PROGRAM_ERROR = new Exit(1);
static final Exit EXIT_CMDLINE_ERROR = new Exit(128);
static final Exit EXIT_IO_ERROR = new Exit(129);
static final Exit EXIT_RUNTIME_ERROR = new Exit(255);
static InputStream REPL_IN = System.in;
static PrintStream REPL_OUT = System.out;
static PrintStream REPL_ERR = System.err;
static int mainInternal(String[] args) {
try {
final boolean finalResult = finalResult(args);
final boolean script = hasFlag("--script", args, false);
final boolean error = handleScript(args);
final boolean scriptFlagError;
if (script && (hasFlag("--repl", args, false) || hasFlag("--tty", args, false) || hasFlag("--eval", args, false))) {
scriptFlagError = true;
REPL_ERR.println("LambdaJ: when using --script neither --repl nor --tty nor --eval may be used as well");
}
else scriptFlagError = false;
misc(args);
final Action action = action(args);
final TraceLevel trace = trace(args);
final int features = features(args);
final boolean istty = hasFlag("--tty", args) || null != System.console(); // starting with Java20ea-27 the behaviour of System.console() has changed: will return != null even with redirected stdin
// old behaviour can be restored with -Djdk.console=jdk.jshell
// see https://bugs.openjdk.org/browse/JDK-8297226 and https://github.com/openjdk/jdk/pull/11421
final boolean repl = hasFlag("--repl", args);
final boolean echo = hasFlag("--echo", args); // used only in repl
final boolean printResult = hasFlag("--result", args); // print individual results of toplevel forms, used only when interpreting files given on the commandline or interpreting piped input
final boolean verbose = hasFlag("--verbose", args);
final String clsName = flagValue("--class", args);
final String outDir = flagValue("--outdir", args);
final String libDir = flagValue("--libdir", args);
final String immediateForms = flagValues("--eval", args);
if (argError(args) || error || scriptFlagError) {
REPL_ERR.println("LambdaJ: exiting because of previous errors.");
throw EXIT_CMDLINE_ERROR;
}
final Path libPath = getLibPath(libDir);
final LambdaJ interpreter = new LambdaJ(features, trace, null, null, null, null, null, libPath);
final List history = repl ? new ArrayList<>() : null;
// process files given on the commandline
final List files = args(args);
try {
if (!files.isEmpty() || immediateForms != null) {
switch (action) {
case INTERPRET:
interpreter.init(NULL_READCHARS, NULL_WRITECHARS, null);
injectCommandlineArgs(interpreter, args);
Object result = null;
for (String fileName : files) {
if ("--".equals(fileName)) continue;
if (verbose) REPL_OUT.println("interpreting " + fileName + "...");
final Path p = Paths.get(fileName);
result = interpretStream(interpreter, ReadSupplier.of(p), p, printResult, history);
}
if (immediateForms != null) {
result = interpretStream(interpreter, new StringReadSupplier(immediateForms), null, printResult, history);
}
if (finalResult && !printResult && result != null) {
REPL_OUT.println();
REPL_OUT.println("==> " + printSEx(result));
}
if (script) exit(result);
break;
case TO_JAVA:
final boolean javaSuccess = compileFiles(files, immediateForms, false, clsName, libPath, outDir);
if (!istty && !javaSuccess) throw EXIT_RUNTIME_ERROR;
break;
case TO_JAR:
final boolean jarSuccess = compileFiles(files, immediateForms, true, clsName, libPath, outDir);
if (!istty && !jarSuccess) throw EXIT_RUNTIME_ERROR;
break;
case COMPILE_AND_RUN:
final Object res = compileAndRunFiles(files, immediateForms, interpreter, args, verbose, finalResult);
if (script) exit(res);
break;
}
}
}
catch (IOException e) {
REPL_ERR.println(); REPL_ERR.println(e);
throw EXIT_IO_ERROR;
}
interpreter.currentSource = null;
// repl() doesn't return
if (files.isEmpty() && immediateForms == null && istty || repl) repl(interpreter, (immediateForms != null || !files.isEmpty()) && action == Action.INTERPRET, istty, echo, history, args);
if (files.isEmpty() && immediateForms == null) {
final String consoleCharsetName = System.getProperty("sun.stdout.encoding");
final Charset consoleCharset = consoleCharsetName == null ? StandardCharsets.UTF_8 : Charset.forName(consoleCharsetName);
if (action == Action.INTERPRET) {
interpreter.init(NULL_READCHARS, NULL_WRITECHARS, null);
injectCommandlineArgs(interpreter, args);
final Object result = interpretStream(interpreter, new InputStreamReader(REPL_IN, consoleCharset)::read, null, printResult, null);
if (finalResult && !printResult && result != null) {
REPL_OUT.println();
REPL_OUT.print("==> ");
REPL_OUT.println(printSEx(result));
}
}
else {
final SExpressionReader parser = interpreter.makeReader(new InputStreamReader(REPL_IN, consoleCharset)::read, null);
switch (action) {
case TO_JAVA:
final boolean successJava = compileToJava(StandardCharsets.UTF_8, interpreter.getSymbolTable(), interpreter.libDir, parser, clsName, outDir);
if (successJava) REPL_OUT.println("compiled stdin to " + (clsName == null ? "MurmelProgram" : clsName));
break;
case TO_JAR:
final String outFile = outDir != null ? outDir + "/a.jar" : "a.jar";
final boolean successJar = compileToJar(interpreter.getSymbolTable(), libPath, parser, clsName, outFile);
if (successJar) REPL_OUT.println("compiled stdin to " + outFile);
break;
case COMPILE_AND_RUN:
compileAndRunForms(parser, args, interpreter, false, finalResult);
break;
default: assert false : "can't happen";
}
}
}
}
catch (Exit e) {
return e.rc;
}
return 0;
}
/** exit by throwing an {@link Exit} exception, doesn't return. The last form of the program will determine the exitlevel:
* nil will result in 0, a number will result in an exitlevel of number&127, any other non-nil value will result in an exitlevel of 1. */
private static void exit(Object murmelResult) {
if (murmelResult == null) throw new Exit(0);
if (numberp(murmelResult)) throw new Exit(((Number)murmelResult).intValue() & 0x7f); // limit to 127, 255 is reserved for EXIT_RUNTIME_ERROR
throw EXIT_PROGRAM_ERROR;
}
/// functions to interpret, compile and/ or run files or input streams
private static Object interpretStream(final LambdaJ interpreter, ReadSupplier prog, Path fileName, final boolean printResult, List history) {
final Path prev = interpreter.currentSource;
try {
final ObjectReader reader = interpreter.getLispReader();
reader.setInput(prog, fileName);
interpreter.currentSource = fileName;
final ObjectReader inReader = new SExpressionReader(interpreter.features, TraceLevel.TRC_NONE, null, interpreter.getSymbolTable(), interpreter.featuresEnvEntry, REPL_IN::read, null);
final ObjectWriter outWriter = makeWriter(REPL_OUT::print);
interpreter.setReaderPrinter(inReader, outWriter);
final Object eof = "EOF";
Object result = null;
for (;;) {
final Object form = reader.readObj(true, eof);
if (form == eof) break;
if (history != null) history.add(form);
final long tStart = System.nanoTime();
result = interpreter.expandAndEval(form, null);
interpreter.traceStats(tStart);
if (printResult) {
REPL_OUT.println();
REPL_OUT.print("==> "); outWriter.printObj(result, true); REPL_OUT.println();
}
}
return result;
}
catch (Exception e) { return Repl.errorExit(e); }
finally { interpreter.currentSource = prev; }
}
private static boolean compileFiles(final List files, String forms, boolean toJar, String clsName, Path libPath, String outDir) throws IOException {
final SymbolTable symtab = new ListSymbolTable();
final MurmelJavaCompiler c = new MurmelJavaCompiler(symtab, libPath, getTmpDir());
final ObjectReader program = parseFiles(files, forms, c.intp, true);
final String outFile;
final boolean success;
if (toJar) {
outFile = outDir != null ? outDir + "/a.jar" : "a.jar";
success = compileToJar(c, program, clsName, outFile);
}
else {
success = compileToJava(StandardCharsets.UTF_8, c, program, clsName, outDir);
if (clsName == null) clsName = "MurmelProgram";
if (outDir == null) outDir = ".";
outFile = outDir + '/' + clsName + ".java";
}
if (success) REPL_OUT.println("compiled " + files.size() + " file(s) to " + outFile);
return success;
}
private static Object compileAndRunFiles(List files, String forms, LambdaJ interpreter, String[] args, boolean verbose, boolean finalResult) throws IOException {
final ObjectReader program = parseFiles(files, forms, interpreter, verbose);
return compileAndRunForms(program, args, interpreter, false, finalResult);
}
/** compile history to a class and run compiled class */
static Object compileAndRunForms(ObjectReader history, String[] cmdlineArgs, LambdaJ interpreter, boolean repl, boolean finalResult) {
final Path tmpDir;
try { tmpDir = getTmpDir(); }
catch (IOException e) {
REPL_OUT.println("history NOT run as Java - cannot get/ create tmp directory: " + e.getMessage());
if (!repl) throw EXIT_IO_ERROR;
return null;
}
MurmelProgram prg = null;
try {
final MurmelJavaCompiler c = new MurmelJavaCompiler(interpreter.getSymbolTable(), interpreter.libDir, tmpDir);
final Class murmelClass = c.formsToJavaClass("MurmelProgram", history, null);
prg = murmelClass.getDeclaredConstructor().newInstance();
injectCommandlineArgs(prg, cmdlineArgs);
final long tStart = System.nanoTime();
final Object result = prg.body();
final long nanos = System.nanoTime() - tStart;
if (interpreter.trace.ge(TraceLevel.TRC_STATS)) {
interpreter.tracer.println("");
final long millis = (long)(nanos * 0.000001D);
final String ms = Long.toString(millis) + '.' + ((long) (nanos * 0.001D + 0.5D) - (long) (millis * 1000D));
interpreter.tracer.println("*** elapsed wall time: " + ms + "ms ***");
interpreter.tracer.println("");
}
if (repl || finalResult && result != null) {
REPL_OUT.println();
if (repl && ((MurmelJavaProgram)prg).values != null) {
for (Object value : ((MurmelJavaProgram)prg).values) {
REPL_OUT.print(" -> ");
prg.getLispPrinter().printObj(value, true);
REPL_OUT.println();
}
}
else { REPL_OUT.print("==> "); prg.getLispPrinter().printObj(result, true); REPL_OUT.println(); }
}
return result;
}
catch (LambdaJError e) {
if (repl) {
final String msg = (prg != null ? "runtime error" : "error") + location(prg) + ": " + e.getMessage();
REPL_OUT.println("history NOT run as Java - " + msg);
}
else Repl.errorExit(e);
}
catch (Throwable t) {
final String loc = location(prg);
if (repl) {
REPL_OUT.println("history NOT run as Java - " + (prg != null ? "runtime error" : "error") + loc + ":");
t.printStackTrace(REPL_OUT);
}
else REPL_ERR.println("Caught Throwable" + loc + ": " + t);
}
if (!repl) throw EXIT_RUNTIME_ERROR;
return null;
}
private static String location(MurmelProgram prg) {
return prg instanceof MurmelJavaProgram ? " at " + ((MurmelJavaProgram) prg).loc : "";
}
static boolean compileToJava(Charset charset, SymbolTable st, Path libDir, ObjectReader history, Object className, Object filename) {
return compileToJava(charset, new MurmelJavaCompiler(st, libDir, null), history, className, filename);
}
/** compile history to Java source and print or write to a file.
*
* if className is null "MurmelProgram" will be the class' name.
* if filename is t the compiled Java code will be printed to the screen.
* if filename is null the filename will be derived from the className
* if filename not null then filename is interpreted as a base directory and the classname (with packages) will be appended
* */
private static boolean compileToJava(Charset charset, MurmelJavaCompiler c, ObjectReader history, Object className, Object filename) {
final String clsName = className == null ? "MurmelProgram" : className.toString();
if (filename == sT) {
c.formsToJavaSource(new OutputStreamWriter(REPL_OUT, charset), clsName, history);
return true;
}
final Path p;
if (null == filename) p = Paths.get(clsName.replace('.', '/') + ".java");
else p = Paths.get(filename.toString() + '/' + clsName.replace('.', '/') + ".java");
try {
if (p.getParent() != null) Files.createDirectories(p.getParent());
}
catch (Exception e) {
REPL_OUT.println("NOT compiled to Java - error: ");
e.printStackTrace(REPL_OUT);
return false;
}
final CharsetEncoder encoder = StandardCharsets.UTF_8.newEncoder();
try (OutputStream os = Files.newOutputStream(p);
WrappingWriter writer = new WrappingWriter(new BufferedWriter(new OutputStreamWriter(os, encoder)))) {
REPL_OUT.println("compiling...");
c.formsToJavaSource(writer, clsName, history);
REPL_OUT.println("compiled to Java file '" + p + '\'');
return true;
}
catch (LambdaJError e) {
REPL_OUT.println("NOT compiled to Java - error: " + e.getMessage());
return false;
}
catch (Exception e) {
REPL_OUT.println("NOT compiled to Java - error: ");
e.printStackTrace(REPL_OUT);
return false;
}
}
static boolean compileToJar(SymbolTable st, Path libDir, ObjectReader history, Object className, Object jarFile) {
final Path tmpDir;
try { tmpDir = getTmpDir(); }
catch (IOException e) { REPL_OUT.println("NOT compiled to .jar - cannot get/ create tmp directory: " + e.getMessage()); return false; }
return compileToJar(new MurmelJavaCompiler(st, libDir, tmpDir), history, className, jarFile);
}
private static boolean compileToJar(MurmelJavaCompiler c, ObjectReader history, Object className, Object jarFile) {
try {
final String jarFileName = jarFile == null ? "a.jar" : jarFile.toString();
final String clsName = className == null ? "MurmelProgram" : className.toString();
REPL_OUT.println("compiling...");
c.formsToJavaClass(clsName, history, jarFileName);
REPL_OUT.println("compiled to .jar file '" + jarFileName + '\'');
return true;
}
catch (LambdaJError e) {
REPL_OUT.println("NOT compiled to .jar - error: " + e.getMessage());
return false;
}
catch (Exception e) {
REPL_OUT.println("NOT compiled to .jar - error: ");
e.printStackTrace(REPL_OUT);
return false;
}
}
/// repl and helpers
/** Enter REPL, doesn't return */
private static void repl(final LambdaJ interpreter, boolean isInit, final boolean istty, boolean echo, List prevHistory, String[] args) {
String consoleCharsetName = System.getProperty("sun.stdout.encoding");
if (consoleCharsetName == null) consoleCharsetName = "UTF-8";
final Charset consoleCharset = Charset.forName(consoleCharsetName);
final Repl repl = new Repl(new InputStreamReader(REPL_IN, consoleCharset)::read, REPL_OUT, interpreter, isInit, echo, prevHistory, args, consoleCharsetName);
if (!echo) {
REPL_OUT.println("Enter a Murmel form or :command (or enter :h for command help or :q to exit):");
REPL_OUT.println();
}
for (;;) {
if (!repl.echo) {
REPL_OUT.print("JMurmel> ");
if (istty) REPL_OUT.flush();
}
repl.oneForm(istty, System.lineSeparator());
}
}
static class Repl {
private final WriteConsumer stdout;
private final LambdaJ interpreter;
private boolean isInit, echo;
private final String[] args;
private final LambdaJSymbol cmdQuit, cmdHelp, cmdDesc, cmdEcho, cmdNoEcho, cmdEnv, cmdMacros, cmdRes, cmdList, cmdWrite, cmdJava, cmdRun, cmdJar;
private final LambdaJSymbol define, setq, quote;
private final LambdaJSymbol form0;
private final LambdaJSymbol form1, form2, form3;
private final LambdaJSymbol result1, result2, result3;
private final LambdaJSymbol values1, values2, values3;
private final List history;
private SExpressionReader parser;
private ObjectWriter outWriter;
private final Charset consoleCharset;
private final ReadSupplier echoingSupplier;
private final ReadSupplier nonechoingSupplier;
private final boolean replVars;
private final Object bye;
Repl(@NotNull ReadSupplier consoleReader, @NotNull Appendable stdout, @NotNull LambdaJ interpreter, boolean isInit, boolean echo,
List prevHistory, String[] args, String consoleCharsetName) {
this.stdout = makeWriteConsumer(stdout);
this.interpreter = interpreter;
this.isInit = isInit;
this.echo = echo;
this.args = args;
cmdQuit = interpreter.intern(":q");
cmdHelp = interpreter.intern(":h");
cmdDesc = interpreter.intern(":desc");
cmdEcho = interpreter.intern(":echo");
cmdNoEcho = interpreter.intern(":noecho");
cmdEnv = interpreter.intern(":env");
cmdMacros = interpreter.intern(":macros");
cmdRes = interpreter.intern(":res");
cmdList = interpreter.intern(":l");
cmdWrite = interpreter.intern(":w");
cmdJava = interpreter.intern(":java");
cmdRun = interpreter.intern(":r");
cmdJar = interpreter.intern(":jar");
define = interpreter.intern(DEFINE);
setq = interpreter.intern(SETQ);
quote = interpreter.intern(QUOTE);
form0 = interpreter.intern("@-");
form1 = interpreter.intern("@+");
form2 = interpreter.intern("@++");
form3 = interpreter.intern("@+++");
result1 = interpreter.intern("@*");
result2 = interpreter.intern("@**");
result3 = interpreter.intern("@***");
values1 = interpreter.intern("@/");
values2 = interpreter.intern("@//");
values3 = interpreter.intern("@///");
history = prevHistory == null ? new ArrayList<>() : prevHistory;
consoleCharset = consoleCharsetName == null ? StandardCharsets.UTF_8 : Charset.forName(consoleCharsetName);
echoingSupplier = () -> {
final int c = consoleReader.read();
if (c != EOF) stdout.append((char)c);
return c;
};
nonechoingSupplier = consoleReader;
replVars = interpreter.have(Features.HAVE_XTRA) && interpreter.have(Features.HAVE_DEFINE);
bye = new Object();
if (isInit) {
interpreter.resetCounters();
parser = new SExpressionReader(interpreter.features, interpreter.trace, interpreter.tracer, interpreter.getSymbolTable(), interpreter.featuresEnvEntry,
echo ? echoingSupplier : nonechoingSupplier, null);
outWriter = interpreter.getLispPrinter();
if (replVars) initReplVars();
}
}
private void initReplVars() {
for (Object v : new Object[] { form0, form1, form2, form3, result1, result2, result3, values1, values2, values3 }) {
interpreter.eval(ConsCell.list(define, v, null), null);
}
interpreter.eval(ConsCell.list(define,
interpreter.intern("quit"),
(Primitive)a -> { throw new ReturnException(bye, 0, (Object[])null); }),
null);
}
/** read one form (or :command) from the stdin that was passed to the constructor Repl(), write results to stdout, formatted in REPL-style with "==>" or " ->".
* This may block if reading from stdin blocks. If stdin is exhausted (returns -1) then a bye message is printed followed by throw EXIT_SUCCESS.
* The command ":q" or form "(quit)" will throw the exception EXIT_SUCCESS, if "istty" is false then any error will throw EXIT_RUNTIME_ERROR. */
void oneForm(boolean istty, String nl) {
final LambdaJ interpreter = this.interpreter;
final WriteConsumer stdout = this.stdout;
if (!isInit) {
interpreter.resetCounters();
parser = new SExpressionReader(interpreter.features, interpreter.trace, interpreter.tracer, interpreter.getSymbolTable(), interpreter.featuresEnvEntry,
echo ? echoingSupplier : nonechoingSupplier, null);
outWriter = makeWriter(stdout);
interpreter.init(parser, outWriter, null);
if (args != null) injectCommandlineArgs(interpreter, args);
if (replVars) initReplVars();
isInit = true;
}
try {
if (istty) parser.resetPos();
final Object eof = "EOF";
final Object exp = parser.readObj(true, eof);
if (exp != null) {
if (exp == eof
|| exp == cmdQuit) { stdout.print("bye." + nl + nl); throw EXIT_SUCCESS; }
if (exp == cmdHelp) { showHelp(nl); return; }
if (exp == cmdDesc) { final Object name = parser.readObj(eof); if (name == eof) return;
if (!symbolp(name)) { stdout.print(name + " is not a symbol" + nl); return; }
final LambdaJSymbol symbol = (LambdaJSymbol)name;
final ConsCell envEntry = interpreter.globals.get(name);
if (envEntry == null && symbol.macro == null) {
stdout.print(name + " is not bound" + nl); return;
}
if (symbol.macro != null) {
stdout.print("macro " + symbol + ":" + nl);
printClosureInfo(symbol.macro, nl);
}
if (cdr(envEntry) instanceof LambdaJ.Closure) {
stdout.print("function " + symbol + ":" + nl);
printClosureInfo((Closure)cdr(envEntry), nl);
}
stdout.print(LambdaJ.printSEx(cdr(envEntry), true) + nl);
return; }
if (exp == cmdEcho) { echo = true; parser.setInput(echoingSupplier, null); return; }
if (exp == cmdNoEcho) { echo = false; parser.setInput(nonechoingSupplier, null); return; }
if (exp == cmdRes) { isInit = false; history.clear(); return; }
if (exp == cmdList) { listHistory(history, nl); return; }
if (exp == cmdWrite) { writeHistory(history, parser.readObj(false), nl); return; }
if (exp == cmdJava) { compileToJava(consoleCharset, interpreter.getSymbolTable(), interpreter.libDir, makeReader(history), parser.readObj(false), parser.readObj(false)); return; }
if (exp == cmdRun) { compileAndRunForms(makeReader(history), null, interpreter, true, false); return; }
if (exp == cmdJar) { compileToJar(interpreter.getSymbolTable(), interpreter.libDir, makeReader(history), parser.readObj(false), parser.readObj(false)); return; }
//if (":peek".equals(exp.toString())) { System.out.println("gensymcounter: " + interpreter.gensymCounter); return; }
if (exp == cmdEnv) {
final List> toSort = new ArrayList<>(interpreter.globals.entrySet());
toSort.sort(Comparator.comparing(entry -> entry.getKey().toString()));
for (Map.Entry e : toSort) stdout.print(e.getValue() + nl);
stdout.print("env length: " + interpreter.globals.size() + nl + nl);
return;
}
if (exp == cmdMacros) {
final ArrayList names = new ArrayList<>();
for (LambdaJSymbol entry: interpreter.getSymbolTable()) {
if (entry != null && entry.macro != null) names.add(entry);
}
names.sort(Comparator.comparing(Object::toString));
for (LambdaJSymbol name: names) stdout.print(name + ": " + printSEx(ConsCell.cons(name.macro.params(), name.macro.body)) + nl);
stdout.print("number of macros: " + names.size() + nl + nl);
return;
}
}
if (replVars) interpreter.eval(ConsCell.list(setq, form3, form2, form2, form1, form1, form0, form0, ConsCell.list(quote, exp)), null);
interpreter.values = NO_VALUES;
final long tStart = System.nanoTime();
final Object result = interpreter.expandAndEval(exp, null);
final ConsCell resultMv = interpreter.values;
interpreter.traceStats(tStart);
history.add(exp);
if (replVars) {
interpreter.eval(ConsCell.list(setq, result3, result2, result2, result1, result1, ConsCell.list(quote, result)), null);
interpreter.eval(ConsCell.list(setq, values3, values2, values2, values1, values1, ConsCell.list(quote, resultMv == NO_VALUES ? ConsCell.list(result) : resultMv)), null);
}
stdout.print(nl);
if (resultMv == NO_VALUES) {
stdout.print("==> "); outWriter.printObj(result, true); stdout.print(nl);
}
else if (resultMv != null) {
for (Object value : resultMv) {
stdout.print(" -> "); outWriter.printObj(value, true); stdout.print(nl);
}
}
}
catch (ReturnException ex) {
if (ex.tag == bye) {
if (istty) stdout.print("bye." + nl);
stdout.print(nl);
throw EXIT_SUCCESS;
}
else {
if (istty) errorContinue("uncaught throw tag " + LambdaJ.printSEx(ex.tag), nl);
else errorExit("uncaught throw tag " + LambdaJ.printSEx(ex.tag));
}
}
catch (Exit exit) { throw exit; }
catch (Exception e) {
if (istty) errorContinue(e, nl);
else errorExit(e);
}
}
/** if "appendable" doesn't throw then cast, else wrap */
private static WriteConsumer makeWriteConsumer(Appendable appendable) {
final WriteConsumer wc;
if (appendable instanceof StringBuilder) wc = ((StringBuilder)appendable)::append;
else if (appendable instanceof CharBuffer) wc = ((CharBuffer)appendable)::append;
else if (appendable instanceof StringBuffer) wc = ((StringBuffer)appendable)::append;
else if (appendable instanceof StringWriter) wc = ((StringWriter)appendable)::append;
else if (appendable instanceof PrintWriter) wc = ((PrintWriter)appendable)::append;
else if (appendable instanceof PrintStream) wc = ((PrintStream)appendable)::append;
else if (appendable instanceof CharArrayWriter) wc = ((CharArrayWriter)appendable)::append;
else wc = cs -> {
try { appendable.append(cs); }
catch (IOException e) { wrap0(e); }
};
return wc;
}
private static ObjectReader makeReader(List forms) {
final Iterator i = forms.iterator();
return (eof) -> i.hasNext() ? i.next() : eof;
}
private void printClosureInfo(Closure closure, String nl) {
if (closure.body instanceof SExpConsCell) {
final String info = closure.body.lineInfo();
if (!info.isEmpty()) stdout.print(info + nl);
}
stdout.print(LambdaJ.printSEx(ConsCell.cons(LambdaJ.sLambda, ConsCell.cons(closure.params(), closure.body))) + nl);
}
private void errorContinue(Object e, String nl) {
stdout.print(nl + "Error: " + LambdaJ.printSEx(e, true) + nl);
}
static Object errorExit(Object e) {
REPL_ERR.println();
REPL_ERR.println("Error: " + LambdaJ.printSEx(e, true));
throw EXIT_RUNTIME_ERROR;
}
private void listHistory(List history, String nl) {
for (Object sexp : history) {
stdout.print(printSEx(sexp));
stdout.print(nl);
}
}
private void writeHistory(List history, Object filename, String nl) {
try {
final Path p = Paths.get(filename.toString());
Files.createFile(p);
Files.write(p, history.stream()
.map(LambdaJ::printSEx)
.collect(Collectors.toList()));
stdout.print("wrote history to file '" + p + '\'' + nl);
}
catch (Exception e) {
stdout.print("history NOT written - error: " + e.getClass().getSimpleName() + ": " + e.getMessage() + nl);
}
}
private void showHelp(String nl) {
stdout.print("Available commands:\n"
+ " :h ............................. this help screen\n"
+ " :echo .......................... print forms to screen before eval'ing\n"
+ " :noecho ........................ don't print forms\n"
+ " :env ........................... list current global environment\n"
+ " :desc ................. display interpreter data about \n"
+ " :macros ........................ list currently defined macros\n"
+ " :res ........................... 'CTRL-ALT-DEL' the REPL, i.e. reset global environment, clear history\n"
+ "\n"
+ " :l ............................. print history to the screen\n"
+ " :w filename .................... write history to a new file with the given filename\n"
+ "\n"
+ " :r ............................. compile history to Java class 'MurmelProgram' and run it\n"
+ "\n"
+ " :java classname t .............. compile history to Java class 'classname' and print to the screen\n"
+ " :java classname nil ............ compile history to Java class 'classname' and save to a file based on 'classname' in current directory\n"
+ " :java classname directory ...... compile history to Java class 'classname' and save to a file based on 'classname' in directory 'directory'\n"
+ "\n"
+ " :jar classname jarfilename .... compile history to jarfile 'jarfile' containing Java class 'classname'\n"
+ " the generated jar needs jmurmel.jar in the same directory to run\n"
+ "\n"
+ "Available variables:\n"
+ " @- ............................. currently evaluated form\n"
+ " @+, @++, @+++ .................. recently evaluated forms\n"
+ " @*, @**, @*** .................. recently returned primary results\n"
+ " @/, @//, @/// .................. recently returned values\n"
+ "\n"
+ " If 'classname' is nil then 'MurmelProgram' will be used as the classname (in the Java default package).\n"
+ " If 'jarfilename' is nil then 'a.jar' will be used as the jar file name.\n"
+ " classname, directory and jarfilename may need to be enclosed in double quotes if they contain spaces or are longer than SYMBOL_MAX (" + SYMBOL_MAX + ")\n"
+ "\n"
+ " :q ............................. quit JMurmel\n");
stdout.print(nl);
}
}
/// helpers for commandline argument processing
/** whether to print a non-nil result of the final form after exit. Must be called before {@link #handleScript}. Default is false when --script is used, true when --script is not used.
* --final-result turns on printing of a non-nil result of the last form, --no-final-result turns it off.
* If both are given then the last one wins. */
private static boolean finalResult(String[] args) {
boolean ret = !hasFlag("--script", args, false);
for (int i = 0; i < args.length; i++) {
final String arg = args[i];
if ("--".equals(arg)) return ret;
if ("--final-result".equals(arg)) { args[i] = null; ret = true; }
if ("--no-final-result".equals(arg)) { args[i] = null; ret = false; }
}
return ret;
}
/** process --script, return true for error, false for ok */
private static boolean handleScript(String[] args) {
for (int i = 0; i < args.length; i++) {
final String arg = args[i];
if ("--".equals(arg)) return false;
if ("--script".equals(arg)) {
if (args.length <= i+1) {
REPL_ERR.println("LambdaJ: commandline argument --script requires one filename");
args[i] = null; // consume the arg
return true;
}
args[i] = args[i+1];
args[i+1] = "--";
return false;
}
}
return false;
}
private static void misc(String[] args) {
if (hasFlag("--version", args)) {
showVersion();
throw EXIT_SUCCESS;
}
if (hasFlag("--help", args) || hasFlag("--usage", args)) {
showVersion();
REPL_OUT.println();
showUsage();
throw EXIT_SUCCESS;
}
if (hasFlag("--help-features", args)) {
showVersion();
REPL_OUT.println();
showFeatureUsage();
throw EXIT_SUCCESS;
}
}
private static Action action(String[] args) {
final boolean toJava = hasFlag("--java", args);
final boolean toJar = hasFlag("--jar", args);
final boolean run = hasFlag("--run", args);
if (toJar) return Action.TO_JAR;
if (toJava) return Action.TO_JAVA;
if (run) return Action.COMPILE_AND_RUN;
return Action.INTERPRET;
}
private static TraceLevel trace(String[] args) {
TraceLevel trace = TraceLevel.TRC_NONE;
if (hasFlag("--trace=stats", args)) trace = TraceLevel.TRC_STATS;
if (hasFlag("--trace=envstats", args)) trace = TraceLevel.TRC_ENVSTATS;
if (hasFlag("--trace=eval", args)) trace = TraceLevel.TRC_EVAL;
if (hasFlag("--trace=func", args)) trace = TraceLevel.TRC_FUNC;
if (hasFlag("--trace=env", args)) trace = TraceLevel.TRC_ENV;
if (hasFlag("--trace", args)) trace = TraceLevel.TRC_LEX;
return trace;
}
private static int features(String[] args) {
int features = Features.HAVE_ALL_LEXC.bits();
if (hasFlag("--min+", args)) features = Features.HAVE_MINPLUS.bits();
if (hasFlag("--min", args)) features = Features.HAVE_MIN.bits();
if (hasFlag("--lambda+", args)) features = Features.HAVE_LAMBDAPLUS.bits();
if (hasFlag("--lambda", args)) features = Features.HAVE_LAMBDA.bits();
if (hasFlag("--no-nil", args)) features &= ~Features.HAVE_NIL.bits();
if (hasFlag("--no-t", args)) features &= ~Features.HAVE_T.bits();
if (hasFlag("--no-extra", args)) features &= ~Features.HAVE_XTRA.bits();
if (hasFlag("--no-ffi", args)) features &= ~Features.HAVE_FFI.bits();
if (hasFlag("--no-number", args)) features &= ~(Features.HAVE_NUMBERS.bits() | Features.HAVE_DOUBLE.bits() | Features.HAVE_LONG.bits());
if (hasFlag("--no-string", args)) features &= ~Features.HAVE_STRING.bits();
if (hasFlag("--no-vector", args)) features &= ~Features.HAVE_VECTOR.bits();
if (hasFlag("--no-hash", args)) features &= ~Features.HAVE_HASH.bits();
if (hasFlag("--no-io", args)) features &= ~Features.HAVE_IO.bits();
if (hasFlag("--no-gui", args)) features &= ~Features.HAVE_GUI.bits();
if (hasFlag("--no-util", args)) features &= ~Features.HAVE_UTIL.bits();
if (hasFlag("--no-define", args)) features &= ~Features.HAVE_DEFINE.bits();
if (hasFlag("--no-labels", args)) features &= ~Features.HAVE_LABELS.bits();
if (hasFlag("--no-cons", args)) features &= ~Features.HAVE_CONS.bits();
if (hasFlag("--no-cond", args)) features &= ~Features.HAVE_COND.bits();
if (hasFlag("--no-apply", args)) features &= ~Features.HAVE_APPLY.bits();
if (hasFlag("--no-atom", args)) features &= ~Features.HAVE_ATOM.bits();
if (hasFlag("--no-eq", args)) features &= ~Features.HAVE_EQ.bits();
if (hasFlag("--no-quote", args)) features &= ~Features.HAVE_QUOTE.bits();
if (hasFlag("--XX-dyn", args)) features &= ~Features.HAVE_LEXC.bits();
if (hasFlag("--XX-oldlambda", args)) features |= Features.HAVE_OLDLAMBDA.bits();
return features;
}
private static boolean hasFlag(String flag, String[] args) {
return hasFlag(flag, args, true);
}
private static boolean hasFlag(String flag, String[] args, boolean erase) {
for (int i = 0; i < args.length; i++) {
final String arg = args[i];
if ("--".equals(arg)) return false;
if (flag.equals(arg)) {
if (erase) args[i] = null; // consume the arg
return true;
}
}
return false;
}
private static String flagValue(String flag, String[] args) {
for (int i = 0; i < args.length; i++) {
final String arg = args[i];
if ("--".equals(arg)) return null;
if (flag.equals(arg)) {
if (args.length < i+2) {
REPL_ERR.println("LambdaJ: commandline argument " + flag + " requires a value");
return null;
}
args[i] = null; // consume the arg
final String ret = args[i+1];
args[i+1] = null;
return ret;
}
}
return null;
}
private static String flagValues(String flag, String[] args) {
for (int i = 0; i < args.length; i++) {
final String arg = args[i];
if ("--".equals(arg)) return null;
if (flag.equals(arg)) {
if (args.length < i + 2) {
REPL_ERR.println("LambdaJ: commandline argument " + flag + " requires a value");
return null;
}
args[i] = null; // consume the arg
final StringBuilder forms = new StringBuilder();
for (int ii = i+1; ii < args.length; ii++) {
final String form = args[ii];
if ("--".equals(form)) break;
args[ii] = null;
if (form != null) forms.append(form).append(' ');
}
return forms.toString();
}
}
return null;
}
private static boolean argError(String[] args) {
boolean err = false;
for (String arg: args) {
if ("--".equals(arg)) return err;
if (arg != null && arg.startsWith("-")) {
REPL_ERR.println("LambdaJ: unknown or duplicate commandline argument " + arg + " or missing value");
REPL_ERR.println("use '--help' to show available commandline arguments");
err = true;
}
}
return err;
}
/** extract arguments for JMurmel from the commandline that are not flags,
* arguments before "--" are for JMurmel, arguments after "--" are for the Murmel program. */
private static List args(String[] args) {
final ArrayList ret = new ArrayList<>();
for (String arg: args) {
if ("--".equals(arg)) return ret;
if (arg != null) ret.add(arg);
}
return ret;
}
static void injectCommandlineArgs(LambdaJ intp, String[] args) {
int n = 0;
for (String arg: args) {
n++;
if ("--".equals(arg)) break;
}
intp.extendGlobal(intp.intern(COMMAND_LINE_ARGUMENT_LIST), arraySlice(args, n));
}
private static void injectCommandlineArgs(MurmelProgram prg, String[] args) {
int n = 0;
if (args != null) for (String arg: args) {
n++;
if ("--".equals(arg)) break;
}
prg.setCommandlineArgumentList(arraySlice(args, n));
}
/// functions that print info to the screen
private static void showVersion() {
REPL_OUT.println(ENGINE_VERSION);
}
// for updating the usage message edit the file usage.txt and copy/paste its contents here between double quotes
private static void showUsage() {
REPL_OUT.println("Usage:\n"
+ "\n"
+ "java -jar jmurmel.jar ... ...\n"
+ "java -jar jmurmel.jar ... ... '--' args-for-program\n"
+ "java -jar jmurmel.jar ... ... '--script' source-file args-for-program\n"
+ "\n"
+ "In order to pass commandline arguments to the Murmel program either \"--\" or \"--script \"\n"
+ "must be used to indicate the end of JMurmel commandline arguments and the start of program\n"
+ "commandline arguments.\n"
+ "\n"
+ "Commandline flags are:\n"
+ "\n"
+ "Misc flags:\n"
+ "\n"
+ "-- ............... Can be used to indicate:\n"
+ " commandline arguments after this will be passed\n"
+ " to the program\n"
+ "--eval ... Process the given forms after processing any files given as well.\n"
+ " All commandline arguments up to (but not including) '--'\n"
+ " will be processed as Murmel forms.\n"
+ "--script .. Can be used to indicate:\n"
+ " process the file following '--script' and pass any remaining\n"
+ " commandline arguments to the Murmel program.\n"
+ " The last form in the last file will determine the exitlevel\n"
+ " to the OS:\n"
+ " nil -> 0\n"
+ " number -> number & 127\n"
+ " other non-nil -> 1\n"
+ "--no-final-result\n"
+ "--final-result ... Whether or not to print the result of the last form after exit.\n"
+ " Default is to print unless --script is used.\n"
+ "\n"
+ "--version ........ Show version and exit\n"
+ "--help ........... Show this message and exit\n"
+ "--help-features .. Show advanced commandline flags to disable various\n"
+ " Murmel language elements (interpreter only)\n"
+ "--libdir ... (load filespec) also searches in this directory,\n"
+ " default is the directory containing jmurmel.jar.\n"
+ "--verbose ........ List files given on the commandline as they are interpreted.\n"
+ "\n"
+ "--java ........... Compile input files to Java source 'MurmelProgram.java'\n"
+ "--jar ............ Compile input files to jarfile 'a.jar' containing\n"
+ " the class MurmelProgram. The generated jar needs\n"
+ " jmurmel.jar in the same directory to run.\n"
+ "--run ............ Compile and run\n"
+ "--class ... Use 'name' instead of 'MurmelProgram' as the classname\n"
+ " in generated .java- or .jar files\n"
+ "--outdir ... Save .java or .jar files to 'dir' instead of current dir\n"
+ "\n"
+ "--result ......... Print the results of each toplevel form when interpreting\n"
+ " files or stdin.\n"
+ "--tty ............ By default JMurmel will enter REPL only if there\n"
+ " are no filenames given on the commandline and\n"
+ " stdin is a tty.\n"
+ " --tty will make JMurmel enter REPL anyways,\n"
+ " i.e. print prompt and results, support :commands and\n"
+ " continue after runtime errors.\n"
+ " Useful e.g. for Emacs' (run-lisp).\n"
+ "--repl ........... Same as --tty but terminate after runtime errors.\n"
+ "\n"
+ "Flags for REPL:\n"
+ "--echo ........... Echo all input while reading\n"
+ "--trace=stats .... Print stack and memory stats after each form\n"
+ "--trace=envstats . Print stack, memory and environment stats after each form\n"
+ "--trace=eval ..... Print internal interpreter info during executing programs\n"
+ "--trace=func ..... Print internal interpreter info re: function and macro calls\n"
+ "--trace=env ...... Print more internal interpreter info executing programs\n"
+ "--trace .......... Print lots of internal interpreter info during\n"
+ " reading/ parsing/ executing programs");
}
private static void showFeatureUsage() {
REPL_OUT.println("Feature flags:\n"
+ "\n"
+ "--no-ffi ...... no functions 'jmethod' or 'jproxy'\n"
+ "--no-gui ...... no turtle or bitmap graphics\n"
+ "--no-extra .... no special forms if, defun, defmacro,\n"
+ " let, let*, letrec, progn, setq,\n"
+ " multiple-value-call, multiple-value-bind,\n"
+ " load, require, provide, declaim,\n"
+ " catch, throw, unwind-protect, try\n"
+ " no primitive functions eval, rplaca, rplacd, trace, untrace,\n"
+ " values, macroexpand-1\n"
+ " no symbol *condition-handler*\n"
+ "--no-number ... no number support\n"
+ "--no-string ... no string support\n"
+ "--no-vector ... no vector support\n"
+ "--no-hash ..... no hash-table support\n"
+ "--no-io ....... no primitive functions read, write, writeln, lnwrite,\n"
+ "--no-util ..... no primitive functions consp, symbolp, listp, null, error,\n"
+ " append, assoc, assq, list, list*, format, format-locale,\n"
+ " no time related primitives or symbols\n"
+ " no symbol *features*\n"
+ "\n"
+ "--min+ ........ turn off all above features, leaving a Lisp\n"
+ " with 11 special forms and primitives:\n"
+ " S-expressions\n"
+ " symbols and cons-cells (i.e. lists)\n"
+ " function application\n"
+ " the special forms quote, lambda, cond, labels, define\n"
+ " the primitive functions atom, eq, cons, car, cdr, apply\n"
+ " the symbols nil, t\n"
+ "\n"
+ "--no-nil ...... don't predefine symbol nil (hint: use '()' instead)\n"
+ "--no-t ........ don't predefine symbol t (hint: use '(quote t)' instead)\n"
+ "--no-apply .... no function 'apply'\n"
+ "--no-labels ... no special form 'labels' (hint: use Y-combinator instead)\n"
+ "--no-define ... no special form 'define'\n"
+ "\n"
+ "--min ......... turn off all above features, leaving a Lisp with\n"
+ " 8 special forms and primitives:\n"
+ " S-expressions\n"
+ " symbols and cons-cells (i.e. lists)\n"
+ " function application\n"
+ " the special forms quote, lambda, cond\n"
+ " the primitive functions atom, eq, cons, car, cdr\n"
+ "\n"
+ "--no-cons ..... no primitive functions cons/ car/ cdr\n"
+ "--no-cond ..... no special form 'cond'\n"
+ "\n"
+ "--lambda+ ..... turn off pretty much everything except Lambda calculus,\n"
+ " leaving a Lisp with 4 special forms and primitives:\n"
+ " S-expressions\n"
+ " symbols and cons-cells (i.e. lists)\n"
+ " function application\n"
+ " the special form quote, lambda\n"
+ " the primitive functions atom, eq\n"
+ "\n"
+ "--no-atom ..... no primitive function 'atom'\n"
+ "--no-eq ....... no primitive function 'eq'\n"
+ "--no-quote .... no special form quote\n"
+ "\n"
+ "--lambda ...... turns off yet even more stuff, leaving I guess\n"
+ " bare bones Lambda calculus + environment:\n"
+ " S-expressions\n"
+ " symbols and cons-cells (i.e. lists)\n"
+ " function application\n"
+ " the special form lambda\n"
+ "\n"
+ "\n"
+ "--XX-oldlambda Lists whose car is 'lambda' are (anonymous) functions, too.\n"
+ "--XX-dyn ...... Use dynamic environments instead of Murmel's\n"
+ " lexical closures with dynamic global environment.\n"
+ " WARNING: This flag is for experimentation purposes only\n"
+ " and may be removed in future versions.\n"
+ " Use at your own discretion.\n"
+ " Using --XX-dyn JMurmel will no longer implement Murmel\n"
+ " and your programs may silently compute different\n"
+ " results!");
}
/// infrastructure utilities
private static Path getLibPath(String libDir) {
if (libDir == null) return null;
try {
final Path libPath = Paths.get(libDir).toAbsolutePath();
if (!Files.isDirectory(libPath)) {
REPL_ERR.println("LambdaJ: invalid value for --libdir: " + libDir + " is not a directory");
throw EXIT_CMDLINE_ERROR;
}
if (!Files.isReadable(libPath)) {
REPL_ERR.println("LambdaJ: invalid value for --libdir: " + libDir + " is not readable");
throw EXIT_CMDLINE_ERROR;
}
return libPath;
}
catch (Exception e) {
REPL_ERR.println("LambdaJ: cannot process --libdir: " + libDir + ": " + e.getMessage());
throw EXIT_CMDLINE_ERROR;
}
}
private static Path getTmpDir() throws IOException {
final Path tmpDir = Files.createTempDirectory("JMurmel");
tmpDir.toFile().deleteOnExit();
return tmpDir;
}
private static class MultiFileReadSupplier implements ReadSupplier {
private final boolean verbose;
private final Iterator paths;
private String forms;
private final LambdaJ intp;
private final ObjectReader delegate;
private Reader reader;
MultiFileReadSupplier(List paths, String forms, LambdaJ intp, ObjectReader delegate, boolean verbose) {
this.paths = paths.iterator();
this.forms = forms;
this.intp = intp;
this.delegate = delegate;
this.verbose = verbose;
}
private void next() throws IOException {
final Reader old = reader;
reader = null;
if (old != null) old.close();
final Path p = paths.next();
if (verbose) REPL_OUT.println("parsing " + p + "...");
reader = Files.newBufferedReader(p);
delegate.setInput(this, p);
intp.currentSource = p;
}
private void forms() throws IOException {
final Reader old = reader;
reader = null;
if (old != null) old.close();
if (verbose) REPL_OUT.println("parsing commandline forms...");
reader = new StringReader(forms);
forms = null;
delegate.setInput(this, null);
intp.currentSource = null;
}
@Override public int read() throws IOException {
if (reader == null) {
if (paths.hasNext()) next();
else if (forms != null) forms();
else return EOF;
}
try {
final int ret = reader.read();
if (ret != EOF) return ret;
if (paths.hasNext()) next();
else if (forms != null) forms();
else return EOF;
}
catch (IOException e) {
final Reader old = reader;
reader = null;
try { if (old != null) old.close(); }
catch (IOException e2) { e.addSuppressed(e2); }
throw e;
}
return read();
}
}
private static ObjectReader parseFiles(List files, String forms, LambdaJ interpreter, boolean verbose) {
final List paths = new ArrayList<>(files.size());
for (String fileName : files) {
if ("--".equals(fileName)) break;
paths.add(Paths.get(fileName));
}
final ObjectReader reader = interpreter.makeReader(NULL_READCHARS, null);
reader.setInput(new MultiFileReadSupplier(paths, forms, interpreter, reader, verbose), null);
return reader;
}
}
public static class StringRepl extends Cli.Repl {
private final StringBuilderSupplier inBuffer;
private final StringBuilder outBuffer;
private static class StringBuilderSupplier implements ReadSupplier {
private final StringBuilder sb = new StringBuilder();
private int pos;
@Override public int read() {
if (pos >= sb.length()) return -1;
return sb.charAt(pos++) & 0xffff;
}
void reset(String s) { sb.setLength(0); sb.append(s); pos = 0; }
boolean eof() { return pos >= sb.length(); }
}
/** create an object of class StringRepl whose main method is {@link #evalString(String)} */
public static StringRepl makeStringRepl() {
final StringBuilderSupplier inBuffer = new StringBuilderSupplier();
return new StringRepl(inBuffer, new StringBuilder(100));
}
private StringRepl(StringBuilderSupplier in, StringBuilder out) {
super(in, out, new LambdaJ(), false, false, null, null, "UTF-8");
this.inBuffer = in;
outBuffer = out;
}
/** eval all forms in the String "forms" and return a String consisting of the forms' output and their results prepended by "==>" or multiple " ->".
* The returned String looks like REPL output. A prompt is NOT displayed.
*
* @throws Cli.Exit if ":q" was passed as a form */
public String evalString(String forms) {
inBuffer.reset(forms);
while (!inBuffer.eof()) {
try {
oneForm(true, "\n");
}
catch (Cli.Exit e) {
// probably due to EOF, ignore
break;
}
}
final String ret = outBuffer.toString();
outBuffer.setLength(0);
return ret;
}
}
///
/// ## class MurmelJavaProgram
/// class MurmelJavaProgram - base class for compiled Murmel programs
/** Base class for compiled Murmel programs, contains Murmel runtime as well as embed API support for compiled Murmel programs. */
public abstract static class MurmelJavaProgram implements MurmelProgram {
public static class CompilerGlobal {
private Object value;
private ConsCell dynamicStack;
public CompilerGlobal(Object value) { this.value = value; }
public Object get() { return value; }
public Object set(Object value) { return this.value = value; }
public Object setForTry(Object value) { return this.value = value; }
public void push() { dynamicStack = ConsCell.cons(value, dynamicStack); }
public void push(Object value) { dynamicStack = ConsCell.cons(this.value, dynamicStack); this.value = value; }
public void pop() { value = car(dynamicStack); dynamicStack = (ConsCell)cdr(dynamicStack); }
}
public static final CompilerGlobal UNASSIGNED_GLOBAL = new CompilerGlobal(null) { @Override public Object get() { throw new LambdaJError(false, "unassigned value"); } };
public static final Object UNASSIGNED_LOCAL = "#";
public static final Object[] NOARGS = new Object[0];
public interface CompilerPrimitive extends Writeable {
Object applyCompilerPrimitive(Object... args);
@Override default void printSEx(WriteConsumer out, boolean ignored) { out.print("#"); }
}
/** marker interface that the TCO trampoline need not be used, instead at runtime {@link MurmelJavaProgram#funcall(MurmelLeafFunction, Object...)} will be used */
public interface MurmelLeafFunction extends MurmelFunction { }
private final SymbolTable symtab = new ListSymbolTable();
private static final LambdaJSymbol sBit = new LambdaJSymbol(true, "bit"), sCharacter = new LambdaJSymbol(true, "character"), sDynamic = new LambdaJSymbol(true, DYNAMIC);
private final @NotNull ConsCell featuresEnvEntry;
private final @NotNull ConsCell commandlineArgumentListEnvEntry;
private ObjectReader lispReader;
private ObjectWriter lispPrinter;
private TurtleFrame current_frame;
private LambdaJ intp;
protected MurmelJavaProgram() {
// hack so that symbols don't get interned as regular symbols which would break eval at least
symtab.intern(LambdaJ.sT);
symtab.intern(LambdaJ.sNil);
symtab.intern(LambdaJ.sLambda);
symtab.intern(LambdaJ.sProgn);
for (WellknownSymbol ws: WellknownSymbol.values()) {
symtab.intern(new LambdaJSymbol(ws.sym, true));
}
symtab.intern(sDynamic);
symtab.intern(sBit);
symtab.intern(sCharacter);
features.set(makeFeatureList(symtab));
featuresEnvEntry = ConsCell.cons(intern(FEATURES), features.get());
commandlineArgumentListEnvEntry = ConsCell.cons(intern(COMMAND_LINE_ARGUMENT_LIST), null);
lispReader = LambdaJ.makeReader(System.in::read, symtab, featuresEnvEntry);
lispPrinter = LambdaJ.makeWriter(System.out::print);
}
private LambdaJ intpForEval() {
LambdaJ intp = this.intp;
if (intp == null) {
final ConsCell conditionHandlerEnvEntry = ConsCell.cons(intern(CONDITION_HANDLER), conditionHandler.get());
final ConsCell randomStateEnvEntry = ConsCell.cons(intern(RANDOM_STATE), randomState.get());
this.intp = intp = new LambdaJ(Features.HAVE_ALL_LEXC.bits(), TraceLevel.TRC_NONE, null, symtab, featuresEnvEntry, conditionHandlerEnvEntry, randomStateEnvEntry, null);
intp.compiledProgram = this;
intp.init(lispReader, lispPrinter, null);
intp.extendGlobal(commandlineArgumentListEnvEntry);
intp.typeSpecs = typeSpecs();
}
else {
assert intp.conditionHandlerEnvEntry != null : "MurmelJavaProgram has an interpreter with feature XTRA enabled and conditionHandlerEnvEntry should be != null";
intp.conditionHandlerEnvEntry.rplacd(conditionHandler.get());
assert intp.randomStateEnvEntry != null : "MurmelJavaProgram has an interpreter with feature NUMBERs enabled and randomStateEnvEntry should be != null";
intp.randomStateEnvEntry.rplacd(randomState.get());
intp.setReaderPrinter(lispReader, lispPrinter);
}
featuresEnvEntry.rplacd(features.get());
commandlineArgumentListEnvEntry.rplacd(commandlineArgumentList.get());
intp.current_frame = current_frame;
return intp;
}
private void afterEval() {
final LambdaJ intp = this.intp;
if (intp.values == LambdaJ.NO_VALUES) clrValues();
else values = toArray(intp.values);
features.set(cdr(featuresEnvEntry));
conditionHandler.set(cdr(intp.conditionHandlerEnvEntry));
randomState.set(cdr(intp.randomStateEnvEntry));
commandlineArgumentList.set(cdr(commandlineArgumentListEnvEntry));
randomState.set(cdr(intp.randomStateEnvEntry));
current_frame = intp.current_frame;
}
private Random getRandom() {
if (randomState.get() == null) randomState.set(new Random());
return (Random)randomState.get();
}
private ObjectWriter getLispPrinter(Object[] args, int nth, ObjectWriter defaultIfNull) {
if (nth >= args.length) return defaultIfNull;
final Object consumer = args[nth];
if (consumer == null) return defaultIfNull;
if (consumer == sT) return lispPrinter;
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));
}
/// JMurmel native embed API - Java calls compiled Murmel
@Override public final ObjectReader getLispReader() { return lispReader; }
@Override public final ObjectWriter getLispPrinter() { return lispPrinter; }
@Override public final void setReaderPrinter(ObjectReader lispStdin, ObjectWriter lispStdout) { lispReader = lispStdin; lispPrinter = lispStdout; }
@Override public final void setReaderPrinter(ReadSupplier in, WriteConsumer out) {
this.lispReader = in == null ? null : new SExpressionReader(in, symtab, featuresEnvEntry, null);
this.lispPrinter = out == null ? null : makeWriter(out);
}
@Override public final @NotNull MurmelFunction getFunction(String func) {
final Object maybeFunction = getValue(func);
if (maybeFunction instanceof MurmelFunction) {
return args -> funcall((MurmelFunction)maybeFunction, args);
}
if (maybeFunction instanceof CompilerPrimitive) {
return args -> funcall((CompilerPrimitive)maybeFunction, args);
}
throw LambdaJ.errorNotAFunction("getFunction: not a primitive or " + LAMBDA + ": %s", func);
}
protected abstract Object runbody() throws Exception;
@Override public Object body() {
try {
return runbody();
}
catch (UnsupportedOperationException e) {
throw new LambdaJError(e.getMessage() + "\nUnsupported operation occured in " + loc);
}
catch (Exception e) {
return rterror(e);
}
}
public final Object rterror(Exception e) {
clrValues();
throw new LambdaJError(e, e.getMessage() + "\nError occured in " + loc);
}
/// predefined global variables
public static final LambdaJSymbol _t = LambdaJ.sT;
public static final double _pi = Math.PI;
/// predefined aliased global variables
public static final int arrayDimensionLimit = ARRAY_DIMENSION_LIMIT_VAL;
public static final long mostPositiveFixnum = MOST_POSITIVE_FIXNUM_VAL;
public static final long mostNegativeFixnum = MOST_NEGATIVE_FIXNUM_VAL;
public static final long itups = (long)1e9;
// *COMMAND-LINE-ARGUMENT-LIST*: will be assigned/ accessed from generated code
public final CompilerGlobal commandlineArgumentList = new CompilerGlobal(null);
public final CompilerGlobal features = new CompilerGlobal(null);
public final CompilerGlobal conditionHandler = new CompilerGlobal(null);
public final CompilerGlobal randomState = new CompilerGlobal(null);
/// predefined primitives
// Predefined primitives sind vom typ CompilerPrimitive. Benutzt werden sie im generierten code so:
//
// (CompilerPrimitive)rt()::add
//
// muessen public sein, weil sonst gibt z.B. "(let* () (format t "hallo"))" unter Java 8u262 einen Laufzeitfehler:
//
// Exception in thread "main" java.lang.BootstrapMethodError: java.lang.IllegalAccessError:
// tried to access method io.github.jmurmel.LambdaJ$MurmelJavaProgram.format([Ljava/lang/Object;)Ljava/lang/Object; from class MurmelProgram$1
//
// Unter Java 17 gibts den Laufzeitfehler nicht, koennte ein Java 8 bug sein. Oder Java 17 hat den Bug, weil der Zugriff nicht erlaubt sein sollte.
// Gilt nicht fuer methoden, die "normal" aufgerufen werden wie z.B. "cons(Object,Object)", die koennen protected sein (gibt dann halt unmengen synthetische $access$ methoden).
//
// Wenn statt "(CompilerPrimitive)rt()::add" -> "(CompilerPrimitive)((MurmelJavaProgram)rt())::add" generiert wird,
// gibts unter Java 8, 17 und 19 einen Compilefehler.
// basic primitives
public final Object _apply (Object... args) {
twoArgs(APPLY, args);
return apply(args);
}
public final Object apply(Object... args) {
Object fn = args[0];
if (fn == null) errorNotAFunction(sNil);
if (symbolp(fn)) fn = getValue(fn.toString());
return tailcall(fn, listToArray(args[1]));
}
public final Object _eval(Object... args) {
varargs1_2(EVAL, args);
final LambdaJ intp = intpForEval();
final Object ret = intp.expandAndEval(args[0], args.length == 2 ? LambdaJ.requireList(EVAL, args[1]) : null);
afterEval();
return ret;
}
// logic, predicates
private Object bool(boolean result) { clrValues(); return result ? _t : null; }
public final Object _eq (Object... args) { twoArgs(EQ, args); return bool(args[0] == args[1]); }
public final Object _eql (Object... args) { twoArgs(EQL, args); return bool(LambdaJ.Subr.eql(args[0], args[1])); }
public final Object _eql(Object o1, Object o2) { return bool(LambdaJ.Subr.eql(o1, o2)); }
public final Object _equal (Object... args) { twoArgs(EQUAL, args); return bool(LambdaJ.Subr.equal(args[0], args[1])); }
public final Object _equal(Object o1, Object o2) { return bool(LambdaJ.Subr.equal(o1, o2)); }
public final Object _consp (Object... args) { oneArg(CONSP, args); return bool(consp(args[0])); }
public final Object _consp (Object arg) { return bool(consp(arg)); }
public final Object _atom (Object... args) { oneArg(ATOM, args); return bool(atom(args[0])); }
public final Object _atom (Object arg) { return bool(atom(arg)); }
public final Object _symbolp (Object... args) { oneArg(SYMBOLP, args); return bool(symbolp(args[0])); }
public final Object _symbolp (Object arg) { return bool(symbolp(arg)); }
public final Object _null (Object... args) { oneArg(NULL, args); return bool(args[0] == null); }
public final Object _numberp (Object... args) { oneArg(NUMBERP, args); return bool(numberp(args[0])); }
public final Object _numberp (Object arg) { return bool(numberp(arg)); }
public final Object _floatp (Object... args) { oneArg(FLOATP, args); return bool(floatp(args[0])); }
public final Object _floatp (Object arg) { return bool(floatp(arg)); }
public final Object _integerp (Object... args) { oneArg(INTEGERP, args); return bool(integerp(args[0])); }
public final Object _integerp (Object arg) { return bool(integerp(arg)); }
public final Object _characterp(Object... args) { oneArg(CHARACTERP, args); return bool(characterp(args[0])); }
public final Object _randomstatep(Object... args){oneArg(RANDOM_STATE_P, args); return bool(randomstatep(args[0])); }
public final Object _vectorp (Object... args) { oneArg(VECTORP, args); return bool(vectorp(args[0])); }
public final Object _vectorp (Object arg) { return bool(vectorp(arg)); }
public final Object svectorp (Object... args) { oneArg(SIMPLE_VECTOR_P, args); return bool(LambdaJ.svectorp(args[0])); }
public final Object svectorp (Object arg) { return bool(LambdaJ.svectorp(arg)); }
public final Object _stringp (Object... args) { oneArg(STRINGP, args); return bool(stringp(args[0])); }
public final Object _stringp (Object arg) { return bool(stringp(arg)); }
public final Object sstringp (Object... args) { oneArg(SIMPLE_STRING_P, args); return bool(LambdaJ.sstringp(args[0])); }
public final Object sstringp (Object arg) { return bool(LambdaJ.sstringp(arg)); }
public final Object bitvectorp (Object... args) { oneArg(BIT_VECTOR_P, args); return bool(LambdaJ.bitvectorp(args[0])); }
public final Object bitvectorp (Object arg) { return bool(LambdaJ.bitvectorp(arg)); }
public final Object sbitvectorp(Object... args) { oneArg(SIMPLE_BIT_VECTOR_P, args); return bool(LambdaJ.sbitvectorp(args[0])); }
public final Object sbitvectorp(Object arg) { return bool(LambdaJ.sbitvectorp(arg)); }
public final Object hashtablep (Object... args) { oneArg(HASH_TABLE_P, args); return bool(LambdaJ.hashtablep(args[0])); }
public final Object hashtablep (Object arg) { return bool(LambdaJ.hashtablep(arg)); }
public final Object _functionp (Object... args) { oneArg(FUNCTIONP, args); return bool(LambdaJ.functionp0(args[0])); }
public final Object _listp (Object... args) { oneArg(LISTP, args); return bool(listp(args[0])); }
public final Object _listp (Object arg) { return bool(listp(arg)); }
public final Object _typep (Object... args) { twoArgs(TYPEP, args); return bool(typep(symtab, null, typeSpecs(), args[0], args[1])); }
public final Object _typep (Object o, Object t) { return bool(typep(symtab, null, typeSpecs(), o, t)); }
private Map typeSpecs;
private Map typeSpecs() {
if (typeSpecs == null) {
final Map map = new IdentityHashMap<>(JavaUtil.hashMapCapacity(TYPE_SPECS.length));
fillTypespecs(symtab, map);
typeSpecs = map;
}
return typeSpecs;
}
public final Object adjustableArrayP(Object... args) { oneArg(ADJUSTABLE_ARRAY_P, args); return bool(LambdaJ.Subr.adjustableArrayP(args[0])); }
// conses and lists
public final Object _car (Object... args) { oneArg(CAR, args); return _car(args[0]); }
public final Object _car (Object l) { clrValues(); return LambdaJ.car(l); } // also used by generated code
public final Object _car (ConsCell l) { clrValues(); return LambdaJ.car(l); }
public final Object caar (Object l) { clrValues(); return LambdaJ.caar(l); } // used by generated code
public final Object caar (ConsCell l) { clrValues(); return LambdaJ.caar(l); } // used by generated code
public final Object caaar (Object l) { clrValues(); return LambdaJ.caaar(l); } // used by generated code
public final Object caaar (ConsCell l) { clrValues(); return LambdaJ.caaar(l); } // used by generated code
public final Object cadr (Object l) { clrValues(); return LambdaJ.cadr(l); } // used by generated code
public final Object cadr (ConsCell l) { clrValues(); return LambdaJ.cadr(l); } // used by generated code
public final Object caddr (Object l) { clrValues(); return LambdaJ.caddr(l); } // used by generated code
public final Object caddr (ConsCell l) { clrValues(); return LambdaJ.caddr(l); } // used by generated code
public final Object _cdr (Object... args) { oneArg(CDR, args); return _cdr(args[0]); }
public final Object _cdr (Object l) { clrValues(); return LambdaJ.cdr(l); } // also used by generated code
public final Object _cdr (ConsCell l) { clrValues(); return LambdaJ.cdr(l); }
public final Object cdar (Object l) { clrValues(); return LambdaJ.cdar(l); } // used by generated code
public final Object cdar (ConsCell l) { clrValues(); return LambdaJ.cdar(l); } // used by generated code
public final Object cddr (Object l) { clrValues(); return LambdaJ.cddr(l); } // used by generated code
public final Object cddr (ConsCell l) { clrValues(); return LambdaJ.cddr(l); } // used by generated code
public final Object cdddr (Object l) { clrValues(); return LambdaJ.cdddr(l); } // used by generated code
public final Object cdddr (ConsCell l) { clrValues(); return LambdaJ.cdddr(l); } // used by generated code
public final ConsCell _cons (Object... args) { twoArgs(CONS, args); return _cons(args[0], args[1]); }
public final ConsCell _cons(Object car, Object cdr) { clrValues(); return ConsCell.cons(car, cdr); } // also used by generated code
public final ConsCell _rplaca (Object... args) { twoArgs(RPLACA, args); return _rplaca(args[0], args[1]); }
public final ConsCell _rplaca(Object l, Object newCar) { clrValues(); return Chk.requireCons(RPLACA, l).rplaca(newCar); }
public final ConsCell _rplaca(ConsCell l, Object newCar) { clrValues(); return l.rplaca(newCar); }
public final ConsCell _rplacd (Object... args) { twoArgs(RPLACD, args); return _rplacd(args[0], args[1]); }
public final ConsCell _rplacd(Object l, Object newCdr) { clrValues(); return Chk.requireCons(RPLACD, l).rplacd(newCdr); }
public final ConsCell _rplacd(ConsCell l, Object newCdr) { clrValues(); return l.rplacd(newCdr); }
public final ConsCell _list (Object... args) { clrValues(); return ConsCell.list(args); }
public final ConsCell list2(Object o1, Object o2) { clrValues(); return ConsCell.cons(o1, ConsCell.cons(o2, null)); }
public final ConsCell list3(Object o1, Object o2, Object o3) { clrValues(); return ConsCell.cons(o1, ConsCell.cons(o2, ConsCell.cons(o3, null))); }
public final ConsCell list4(Object o1, Object o2, Object o3, Object o4) { clrValues(); return ConsCell.cons(o1, ConsCell.cons(o2, ConsCell.cons(o3, ConsCell.cons(o4, null)))); }
public final ConsCell list5(Object o1, Object o2, Object o3, Object o4, Object o5) { clrValues(); return ConsCell.cons(o1, ConsCell.cons(o2, ConsCell.cons(o3, ConsCell.cons(o4, ConsCell.cons(o5, null))))); }
public final Object listStar (Object... args) { clrValues(); varargs1(LISTSTAR, args); return ConsCell.listStar(args); }
public final Object listStar0(Object... args) { clrValues(); return ConsCell.listStar(args); }
public final Object _append (Object... args) {
clrValues();
int nArgs;
if (args == null || (nArgs = args.length) == 0) return null;
if (nArgs == 1) return args[0];
if (!listp(args[0])) throw new SimpleTypeError(APPEND + ": first argument is not a list: %s", printSEx(args[0]));
nArgs--;
int first = 0;
while (first < nArgs && args[first] == null)
++first; // skip leading nil args if any
if (first == nArgs)
return args[first];
final ConsCell ret = ConsCell.cons(null, null);
ConsCell appendTo = ret;
int current = first;
for (; current < nArgs; current++) {
final Object o = args[current];
if (o == null) continue;
if (!consp(o)) throw new SimpleTypeError(APPEND + ": argument is not a list: %s", printSEx(o));
for (ConsCell obj = (ConsCell)o; obj != null; obj = requireList(cdr(obj))) {
final ConsCell next = ConsCell.cons(car(obj), null);
appendTo.rplacd(next);
appendTo = next;
}
}
appendTo.rplacd(args[current]);
return ret.cdr();
}
public final ConsCell _assq (Object... args) { clrValues(); twoArgs(ASSQ, args); return assq(args[0], args[1]); }
public final ConsCell _assoc (Object... args) { clrValues(); twoArgs(ASSOC, args); return assoc(args[0], args[1]); }
// numbers, characters
public final double add (Object... args) { clrValues(); if (args.length > 0) { double ret = toDouble(args[0]); for (int i = 1; i < args.length; i++) ret += toDouble(args[i]); return ret; } return 0.0; }
public final double mul (Object... args) { clrValues(); if (args.length > 0) { double ret = toDouble(args[0]); for (int i = 1; i < args.length; i++) ret *= toDouble(args[i]); return ret; } return 1.0; }
public final double sub (Object... args) { clrValues(); varargs1("-", args);
if (args.length == 1) return 0.0 - toDouble(args[0]);
double ret = toDouble(args[0]); for (int i = 1; i < args.length; i++) ret -= toDouble(args[i]); return ret; }
public final double quot (Object... args) { clrValues(); varargs1("/", args);
if (args.length == 1) return 1.0 / toDouble(args[0]);
double ret = toDouble(args[0]); for (int i = 1; i < args.length; i++) ret /= toDouble(args[i]); return ret; }
public final Object numbereq (Object... args) { return compare("=", args, (d1, d2) -> d1 == d2); }
public final Object ne (Object... args) { return compare("/=", args, (d1, d2) -> d1 != d2); }
public final Object lt (Object... args) { return compare("<", args, (d1, d2) -> d1 < d2); }
public final Object le (Object... args) { return compare("<=", args, (d1, d2) -> d1 <= d2); }
public final Object ge (Object... args) { return compare(">=", args, (d1, d2) -> d1 >= d2); }
public final Object gt (Object... args) { return compare(">", args, (d1, d2) -> d1 > d2); }
private Object compare(String op, Object[] args, DoubleBiPred pred) {
clrValues();
varargs1(op, args);
double prev = toDouble(args[0]);
final int length = args.length;
for (int i = 1; i < length; i++) {
final double next = toDouble(args[i]);
if (!pred.test(prev, next)) return null;
prev = next;
}
return _t;
}
public final Number inc (Object... args) { clrValues(); oneArg("1+", args); return LambdaJ.Subr.inc(args[0]); }
public final Number inc (Object arg) { clrValues(); return LambdaJ.Subr.inc(arg); }
public final Number incinc (Object arg) { clrValues(); return LambdaJ.Subr.incinc(arg); }
public final Number dec (Object... args) { clrValues(); oneArg("1-", args); return LambdaJ.Subr.dec(args[0]); }
public final Number dec (Object arg) { clrValues(); return LambdaJ.Subr.dec(arg); }
public final Number _signum (Object... args) { clrValues(); oneArg("signum", args); return cl_signum (args[0]); }
public final long _round (Object... args) { varargs1_2("round", args); return toFixnum(cl_round (quot12(args))); }
public final long _floor (Object... args) { varargs1_2("floor", args); return toFixnum(Math.floor (quot12(args))); }
public final long _ceiling (Object... args) { varargs1_2("ceiling", args); return toFixnum(Math.ceil (quot12(args))); }
public final long _truncate(Object... args) { varargs1_2("truncate", args); return toFixnum(cl_truncate(quot12(args))); }
public final double _fround (Object... args) { varargs1_2("fround", args); return cl_round (quot12(args)); }
public final double _ffloor (Object... args) { varargs1_2("ffloor", args); return Math.floor (quot12(args)); }
public final double _fceiling (Object... args) { varargs1_2("fceiling", args); return Math.ceil (quot12(args)); }
public final double _ftruncate(Object... args) { varargs1_2("ftruncate",args); return cl_truncate(quot12(args)); }
public static double cl_round(double d) { return Math.rint(d); }
public static double cl_truncate(double d) { return LambdaJ.Subr.cl_truncate(d); }
public static long toFixnum(double d) { return LambdaJ.Chk.toFixnum(d); }
private double quot12(Object[] args) { clrValues(); return args.length == 2 ? toDouble(args[0]) / toDouble(args[1]) : toDouble(args[0]); }
public final double _sqrt (Object... args) { clrValues(); oneArg("sqrt", args); return Math.sqrt (toDouble(args[0])); }
public final double _log (Object... args) { clrValues(); varargs1_2("log", args); return args.length == 1 ? Math.log(toDouble(args[0])) : Math.log(toDouble(args[0])) / Math.log(toDouble(args[1])); }
public final double _log10 (Object... args) { clrValues(); oneArg("log10", args); return Math.log10(toDouble(args[0])); }
public final double _exp (Object... args) { clrValues(); oneArg("exp", args); return Math.exp (toDouble(args[0])); }
public final double _expt (Object... args) { clrValues(); twoArgs("expt", args); return Math.pow (toDouble(args[0]), toDouble(args[1])); }
public final double _mod (Object... args) { twoArgs("mod", args); return cl_mod(toDouble(args[0]), toDouble(args[1])); }
public final double cl_mod(double lhs, double rhs) { clrValues(); return LambdaJ.Subr.cl_mod(lhs, rhs); }
public final double _rem (Object... args) { clrValues(); twoArgs("rem", args); return toDouble(args[0]) % toDouble(args[1]); }
public final Number _random(Object... args) {
clrValues(); varargs1_2("random", args);
final Object state;
if (args.length == 2) state = args[1];
else state = getRandom();
return random(args[0], state);
}
public final Random makeRandomState(Object... args) {
clrValues(); varargs0_1("make-random-state", args);
final Object state;
final Random current;
if (args.length == 1 && args[0] != null) { state = args[0]; current = null; }
else { state = null; current = getRandom(); }
return Subr.makeRandomState(current, state);
}
// vectors, sequences
public final Object makeArray(Object... args) { clrValues(); varargsMinMax(MAKE_ARRAY, args, 1, 3);
if (args.length == 1) return new Object[toArrayIndex(args[0])];
return LambdaJ.Subr.makeArray(sBit, sCharacter, arraySlice(args)); }
public final Object makeArray1(Object size) { clrValues(); return new Object[toArrayIndex(size)]; }
public final Object makeArray2(Object size, Object type) { clrValues(); return LambdaJ.Subr.makeArray(sBit, sCharacter, size, type); }
public final Object makeArray3(Object size, Object type, Object cap) { clrValues(); return LambdaJ.Subr.makeArray(sBit, sCharacter, ConsCell.list(size, type, cap)); }
public final long vectorLength(Object... args) { clrValues(); oneArg("vector-length", args); return LambdaJ.Subr.vectorLength(args[0]); }
public final Object vectorCopy (Object... args) { clrValues(); varargs1_2("vector-copy", args); return LambdaJ.Subr.vectorCopy(args[0], secondArgNotNull(args)); }
public final Object vectorFill (Object... args) { clrValues(); varargsMinMax(VECTOR_FILL, args, 2, 4);
return LambdaJ.Subr.vectorFill(args[0], args[1], nth(2, args), nth(3, args)); }
public final long vectorAdd (Object... args) { clrValues(); varargsMinMax("vector-add", args, 2, 3);
if (args.length == 3) return LambdaJ.Subr.vectorAdd(args[0], args[1], toArrayIndex(args[2]));
return LambdaJ.Subr.vectorAdd(args[0], args[1]); }
public final Object vectorRemove(Object... args) { clrValues(); twoArgs("vector-add" ,args); return LambdaJ.Subr.vectorRemove(args[0], toArrayIndex(args[1])); }
public final Object vectorToList (Object... args) {
clrValues(); oneArg("vector->list", args);
final Object maybeVector = args[0];
if (LambdaJ.svectorp(maybeVector)) return simpleVectorToList(args);
if (stringp(maybeVector)) return stringToList(args);
if (LambdaJ.sbitvectorp(maybeVector)) return bitVectorToList(args);
if (maybeVector instanceof Bitvector || maybeVector instanceof List) {
final Iterator> it = ((Iterable>)maybeVector).iterator();
if (!it.hasNext()) return null;
final ListBuilder ret = new ListBuilder();
do { ret.append(it.next()); }
while (it.hasNext());
return ret.first();
}
throw errorNotAVector("vector->list", maybeVector);
}
public final Object listToVector(Object... args) { clrValues(); varargs1_2("list->vector", args); return LambdaJ.Subr.listToVector(args[0], secondArgNotNull(args)); }
public final long _svlength (Object... args) { clrValues(); oneArg("svlength", args); return svlength(args[0]); }
public final Object _svref (Object... args) { twoArgs("svref", args); return _svref(args[0], args[1]); }
public final Object _svref(Object v, Object idx) { clrValues(); return LambdaJ.Subr.svref(v, toArrayIndex(idx)); }
public final Object _svset (Object... args) { threeArgs("svref", args); return _svset(args[0], args[1], args[2]); }
public final Object _svset(Object v, Object idx, Object val) { clrValues(); return LambdaJ.Subr.svset(v, toArrayIndex(idx), val); }
public final Object simpleVectorToList (Object... args) {
clrValues(); oneArg("simple-vector->list", args);
final Object maybeVector = args[0];
final Object[] s = LambdaJ.Chk.requireSimpleVector("simple-vector->list", maybeVector);
final ListBuilder ret = new ListBuilder();
final int len = s.length;
for (int i = 0; i < len; i++) ret.append(s[i]);
return ret.first();
}
public final Object listToSimpleVector(Object... args) { clrValues(); oneArg("list->simple-vector", args); return LambdaJ.listToArray(args[0]); }
public final Object _vector (Object... args) { clrValues(); return args; }
public final Object _vect (Object... args) { clrValues(); varargs1(VECT, args); return LambdaJ.listToArray(arraySlice(args, 1), toInt(args[0])); }
public final Object _string (Object... args) { clrValues(); oneArg("string", args); return stringDesignatorToString(args[0]); }
public final long _slength(Object... args) { clrValues(); oneArg("slength", args); return slength(args[0]); }
public final char _sref (Object... args) { clrValues(); twoArgs("sref", args); return LambdaJ.Subr.sref(args[0], toArrayIndex(args[1])); }
public final char _sset (Object... args) { clrValues(); threeArgs("sset", args); return LambdaJ.Subr.sset(args[0], toArrayIndex(args[1]), requireChar(args[2])); }
public final Object stringeq (Object... args) { twoArgs("string=", args); return bool(LambdaJ.Subr.stringEq(args[0], args[1])); }
public final Object stringToList (Object... args) {
clrValues(); oneArg("string->list", args);
final Object maybeString = args[0];
final ListBuilder ret = new ListBuilder();
if (maybeString instanceof char[]) {
final char[] carry = (char[])maybeString;
final int len = carry.length;
for (int i = 0; i < len; i++) ret.append(carry[i]);
return ret.first();
}
final CharSequence s = requireCharsequence("string->list", maybeString);
final int len = s.length();
for (int i = 0; i < len; i++) ret.append(s.charAt(i));
return ret.first();
}
public final Object listToString(Object... args) { clrValues(); varargs1_2("list->string", args); return LambdaJ.Subr.listToString(args[0], secondArgNotNull(args)); }
public final long charInt (Object... args) { clrValues(); oneArg("char-code", args); return (long) LambdaJ.Chk.requireChar("char-code", args[0]); }
public final long charInt (Object arg) { clrValues(); return (long) LambdaJ.Chk.requireChar("char-code", arg); }
public final char intChar (Object... args) { clrValues(); oneArg("code-char", args); return (char) toInt(args[0]); }
public final char intChar (Object arg) { clrValues(); return (char) toInt(arg); }
public final long _bvlength (Object... args) { clrValues(); oneArg("bvlength", args); return bvlength(args[0]); }
public final long _bvref (Object... args) { twoArgs("bvref", args); return _bvref(args[0], args[1]); }
public final long _bvref (Object v, Object idx) { clrValues(); return LambdaJ.Subr.bvref(v, toArrayIndex(idx)); }
public final long _bvref (Object v, long idx) { clrValues(); return LambdaJ.Subr.bvref(v, toArrayIndex(idx)); }
public final long _bvset (Object... args) { threeArgs("bvset", args); return _bvset(args[0], args[1], args[2]); }
public final long _bvset(Object v, Object idx, Object val) { clrValues(); return LambdaJ.Subr.bvset(v, toArrayIndex(idx), toBit(val)); }
public final long _bvset(Object v, Object idx, long val) { clrValues(); return LambdaJ.Subr.bvset(v, toArrayIndex(idx), toBit(val)); }
public final long _bvset(Object v, long idx, long val) { clrValues(); return LambdaJ.Subr.bvset(v, toArrayIndex(idx), toBit(val)); }
public final Object bvEq (Object... args) { twoArgs("bv=", args); return bool(LambdaJ.Subr.bvEq(args[0], args[1])); }
public final Object bitVectorToList(Object... args) {
clrValues(); oneArg("bit-vector->list", args);
final Object maybeVector = args[0];
if (maybeVector instanceof boolean[]) {
final boolean[] s = (boolean[])maybeVector;
final int len = s.length;
if (len == 0) return null;
final ListBuilder ret = new ListBuilder();
for (int i = 0; i < len; i++) ret.append(s[i] ? 1L : 0L);
return ret.first();
}
else if (maybeVector instanceof Bitvector) {
final Bitvector bv = (Bitvector)maybeVector;
final ListBuilder ret = new ListBuilder();
for (Object bit: bv) ret.append(bit);
return ret.first();
}
else throw errorNotABitVector("bit-vector->list", maybeVector);
}
public final Object listToBitVector(Object... args) {
clrValues(); varargs1_2("list->bit-vector", args);
return LambdaJ.Subr.listToBitVector(LambdaJ.requireList("list->bit-vector", args[0]), secondArgNotNull(args));
}
public final Object _seqref (Object... args) { clrValues(); twoArgs("seqref", args); return LambdaJ.Subr.seqref(args[0], toArrayIndex(args[1])); }
public final Object _seqset (Object... args) { clrValues(); threeArgs(SEQSET, args); return LambdaJ.Subr.seqset(args[0], toArrayIndex(args[1]), args[2]); }
// Hashtables
public final Object _hash (Object... args) { clrValues(); return LambdaJ.Subr.hash(symtab, arraySlice(args)); }
public final Object makeHash (Object... args) { clrValues(); varargsMinMax(MAKE_HASH_TABLE, args, 0, 2);
return makeHashTable(symtab, nth(0, args), args.length > 1 ? toNonnegInt(MAKE_HASH_TABLE, args[1]) : DEFAULT_HASH_SIZE); }
public final Object _hashref (Object... args) { varargsMinMax("hashref", args, 2, 3); return retn(hashref(args[0], args[1], args.length > 2 ? args[2] : NO_DEFAULT_VALUE)); }
public final Object _hashset (Object... args) { clrValues(); varargsMinMax("hashset", args, 2, 3); return hashset(arraySlice(args)); }
public final Object hashTableCount(Object... args) { clrValues(); oneArg("hash-table-count", args); return LambdaJ.Subr.hashTableCount(args[0]); }
public final Object _clrhash (Object... args) { clrValues(); oneArg("clrhash", args); return LambdaJ.Subr.clrhash(args[0]); }
public final Object hashRemove (Object... args) { varargs1_2("hash-table-remove", args); return bool(LambdaJ.Subr.hashRemove(arraySlice(args))); }
public final Object _sxhash (Object... args) { clrValues(); oneArg("sxhash", args); return LambdaJ.Subr.sxhash(args[0]); }
public final Object _sxhash (Object obj) { clrValues(); return LambdaJ.Subr.sxhash(obj); }
public final Object scanHash (Object... args) { clrValues(); oneArg("scan-hash-table", args); return scanHashCompiler(args[0]); }
interface CompilerIteratorGenerator extends IteratorGenerator, CompilerPrimitive {}
private CompilerIteratorGenerator scanHashCompiler(Object hash) {
final Map map = requireHash("scan-hash-table", hash);
final Function, Object> getKey;
if (map instanceof MurmelMap) getKey = ((MurmelMap)map)::getKey;
else getKey = Map.Entry::getKey;
final Iterator> it = map.entrySet().iterator();
if (it.hasNext()) return new CompilerIteratorGenerator() {
private Map.Entry entry;
@Override public Object applyCompilerPrimitive(Object... args) {
if (it.hasNext()) { entry = it.next(); final ConsCell tuple = ConsCell.cons(getKey.apply(entry), entry.getValue()); return ret2(tuple, sT); }
else { entry = null; return ret2(null, null); }
}
@Override public Object set(Object value) { if (entry != null) { entry.setValue(value); return value; } else throw new SimpleError("no such element"); }
@Override public boolean remove() { it.remove(); entry = null; return true; }
@Override public void printSEx(WriteConsumer out, boolean ignored) { out.print("#"); }
};
else return new CompilerIteratorGenerator() { @Override public Object applyCompilerPrimitive(Object... args) { return ret2(null, null); }
@Override public void printSEx(WriteConsumer out, boolean ignored) { out.print("#"); } };
}
// I/O
public final Object _read (Object... args) { clrValues(); varargs0_1("read", args); return LambdaJ.Subr.read(lispReader, arraySlice(args)); }
public final Object readFromStr (Object... args) { varargsMinMax("read-from-string", args, 1, 4);
featuresEnvEntry.rplacd(features.get());
return retn(LambdaJ.Subr.readFromString(symtab, featuresEnvEntry, arraySlice(args))); }
public final Object readTextfileLines (Object... args) { clrValues(); varargs1_2("read-textfile-lines", args); return LambdaJ.Subr.readTextfileLines(arraySlice(args)); }
public final Object readTextfile (Object... args) { clrValues(); varargsMinMax("read-textfile", args, 1, 3); return LambdaJ.Subr.readTextfile(arraySlice(args)); }
public final Object writeTextfileLines(Object... args) { clrValues(); varargsMinMax("write-textfile-lines", args, 2, 4); return LambdaJ.Subr.writeTextfileLines(arraySlice(args)); }
public final Object writeTextfile (Object... args) { clrValues(); varargsMinMax("write-textfile", args, 2, 5); return LambdaJ.Subr.writeTextfile(arraySlice(args)); }
public final Object writeToString (Object... args) { clrValues(); varargs1_2("write-to-string", args); return LambdaJ.Subr.writeToString(args[0], noSecondArgOrNotNull(args)); }
public final Object _write (Object... args) { clrValues(); varargsMinMax("write", args, 1, 3); return LambdaJ.Subr.write (getLispPrinter(args, 2, lispPrinter), args[0], noSecondArgOrNotNull(args)); }
public final Object writeStdout (Object arg) { clrValues(); return LambdaJ.Subr.write (lispPrinter, arg, false); }
public final Object _writeln (Object... args) { clrValues(); varargsMinMax("writeln", args, 0, 3); return LambdaJ.Subr.writeln(getLispPrinter(args, 2, lispPrinter), arraySlice(args), noSecondArgOrNotNull(args)); }
public final Object writelnStdout () { clrValues(); return LambdaJ.Subr.writeln(lispPrinter); }
public final Object writelnStdout (Object arg) { clrValues(); return LambdaJ.Subr.writeln(lispPrinter, arg); }
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 format (Object... args) { clrValues(); varargs2("format", args); return LambdaJ.Subr.format(getLispPrinter(args, 0, null), true, arraySlice(args)); }
public final Object formatLocale (Object... args) { clrValues(); varargs3("format-locale", args); return LambdaJ.Subr.formatLocale(getLispPrinter(args, 0, null), true, arraySlice(args)); }
// misc
public Object[] values;
public final Object _values (Object... args) { if (args.length == 1) clrValues(); else values = args; if (args.length == 0) return null; return args[0]; }
public final Object _gensym (Object... args) { clrValues(); varargs0_1("gensym", args); return LambdaJ.Subr.gensym(args.length == 0 ? null : args[0]); }
public final Object _trace (Object... args) { clrValues(); return null; }
public final Object _untrace (Object... args) { clrValues(); return null; }
public final Object _error (Object... args) { clrValues(); varargs1(ERROR, args); LambdaJ.Subr.error(typeSpecs(), args[0], Arrays.copyOfRange(args, 1, args.length)); return null; }
public final Object error1 (Object a1) { clrValues(); LambdaJ.Subr.error(typeSpecs(), a1, NOARGS); return null; }
public final Object error2 (Object a1, Object a2) { clrValues(); LambdaJ.Subr.error(typeSpecs(), a1, a2); return null; }
public final Object error3 (Object a1, Object a2, Object a3) { clrValues(); LambdaJ.Subr.error(typeSpecs(), a1, a2, a3); return null; }
public final Object error4 (Object a1, Object a2, Object a3, Object a4) { clrValues(); LambdaJ.Subr.error(typeSpecs(), a1, a2, a3, a4); return null; }
public final Object errorN (Object a1, Object a2, Object a3, Object... args) {
clrValues();
final Object[] newArgs = new Object[args.length + 2];
newArgs[0] = a2;
newArgs[1] = a3;
System.arraycopy(args, 0, newArgs, 2, args.length);
LambdaJ.Subr.error(typeSpecs(), a1, newArgs);
return null;
}
public final Object implType (Object... args) { clrValues(); noArgs("lisp-implementation-type", args); return "JMurmel"; }
public final Object implVersion(Object... args) { clrValues(); noArgs("lisp-implementation-version", args); return LambdaJ.ENGINE_VERSION_NUM; }
// time
public final long getInternalRealTime(Object... args) { clrValues(); noArgs("get-internal-real-time", args); return LambdaJ.Subr.getInternalRealTime(); }
public final long getInternalRunTime (Object... args) { clrValues(); noArgs("get-internal-run-time", args); return LambdaJ.Subr.getInternalRunTime(); }
public final Object sleep (Object... args) { clrValues(); oneArg("sleep", args); return LambdaJ.Subr.sleep(args[0]); }
public final long getUniversalTime (Object... args) { clrValues(); noArgs("get-universal-time", args); return LambdaJ.Subr.getUniversalTime(); }
public final Object getDecodedTime (Object... args) { clrValues(); noArgs("get-decoded-time", args); return LambdaJ.Subr.getDecodedTime(new ListBuilder(), this::bool); }
// Java FFI
public final Object _jmethod (Object... args) {
clrValues(); varargs2(JMETHOD, args);
return JFFI.findMethod(LambdaJ.requireString(JMETHOD, args[0]), LambdaJ.requireString(JMETHOD, args[1]), arraySlice(args, 2));
}
public final Primitive findMethod(Object className, Object methodName, Object... paramClasses) {
clrValues();
return JFFI.findMethod(LambdaJ.requireString(JMETHOD, className), LambdaJ.requireString(JMETHOD, methodName), arraySlice(paramClasses));
}
// makeProxy kann auch interpretierte funktionen. wenn intp==null ist, kanns aber keine geben
public final Object _jproxy (Object... args) { clrValues(); varargs3("jproxy", args); return JFFI.makeProxy(intp, this, arraySlice(args)); }
// graphics
public final Object makeFrame (Object... args) {
clrValues(); varargsMinMax("make-frame", args, 1, 4);
final String title = LambdaJ.requireString("make-frame", args[0]);
final TurtleFrame ret = new TurtleFrame(title, LambdaJ.Chk.requireNumberOrNull("make-frame", nth(1, args)), LambdaJ.Chk.requireNumberOrNull("make-frame", nth(2, args)), LambdaJ.Chk.requireNumberOrNull("make-frame", nth(3, args)));
current_frame = ret;
return ret;
}
public final Object openFrame (Object... args) { varargs0_1("open-frame", args); return requireFrame("open-frame", 0, args).open(); }
public final Object closeFrame (Object... args) { varargs0_1("close-frame", args); return requireFrame("close-frame", 0, args).close(); }
public final Object resetFrame (Object... args) { varargs0_1("reset-frame", args); return requireFrame("reset-frame", 0, args).reset(); }
public final Object clearFrame (Object... args) { varargs0_1("clear-frame", args); return requireFrame("clear-frame", 0, args).clear(); }
public final Object repaintFrame (Object... args) { varargs0_1("repaint-frame", args); return requireFrame("repaint-frame", 0, args).repaint(); }
public final Object flushFrame (Object... args) { varargs0_1("flush-frame", args); return requireFrame("flush-frame", 0, args).flush(); }
// set new current frame, return previous frame
public final Object currentFrame (Object... args) { varargs0_1("current-frame", args);
final Object prev = current_frame;
if (args.length > 0 && args[0] != null) current_frame = requireFrame("current-frame", args[0]);
return prev; }
public final Object pushPos (Object... args) { varargs0_1("push-pos", args); return requireFrame("push-pos", 0, args).pushPos(); }
public final Object popPos (Object... args) { varargs0_1("pop-pos", args); return requireFrame("pop-pos", 0, args).popPos(); }
public final Object penUp (Object... args) { varargs0_1("pen-up", args); return requireFrame("pen-up", 0, args).penUp(); }
public final Object penDown (Object... args) { varargs0_1("pen-down", args); return requireFrame("pen-down", 0, args).penDown(); }
public final Object color (Object... args) { varargs1_2("color", args); return requireFrame("color", 1, args).color (toInt(args[0])); }
public final Object bgColor (Object... args) { varargs1_2("bgcolor", args); return requireFrame("bgcolor", 1, args).bgColor (toInt(args[0])); }
public final Object text (Object... args) { varargs1_2("text", args); return requireFrame("text", 1, args).text (args[0].toString()); }
public final Object right (Object... args) { varargs1_2("right", args); return requireFrame("right", 1, args).right (toDouble(args[0])); }
public final Object left (Object... args) { varargs1_2("left", args); return requireFrame("left", 1, args).left (toDouble(args[0])); }
public final Object forward (Object... args) { varargs1_2("forward", args); return requireFrame("forward", 1, args).forward(toDouble(args[0])); }
public final Object moveTo (Object... args) { varargsMinMax("move-to", args, 2, 3); return requireFrame("move-to", 2, args).moveTo (toDouble(args[0]), toDouble(args[1])); }
public final Object lineTo (Object... args) { varargsMinMax("line-to", args, 2, 3); return requireFrame("line-to", 2, args).lineTo (toDouble(args[0]), toDouble(args[1])); }
public final Object moveRel (Object... args) { varargsMinMax("move-rel", args, 2, 3); return requireFrame("move-rel", 2, args).moveRel(toDouble(args[0]), toDouble(args[1])); }
public final Object lineRel (Object... args) { varargsMinMax("line-rel", args, 2, 3); return requireFrame("line-rel", 2, args).lineRel(toDouble(args[0]), toDouble(args[1])); }
public final Object makeBitmap (Object... args) { varargsMinMax("make-bitmap", args, 2, 3); return requireFrame("make-bitmap", 2, args).makeBitmap(toInt(args[0]), toInt(args[1])); }
public final Object discardBitmap(Object... args) { varargs0_1("discard-bitmap", args); return requireFrame("discard-bitmap", 0, args).discardBitmap(); }
public final Object setPixel (Object... args) { varargsMinMax("set-pixel", args, 3, 4); return setPixel(toInt(args[0]), toInt(args[1]), toInt(args[2]), nth(3, args)); }
public final Object setPixel (Object x, Object y, Object rgb) { return setPixel(x, y, rgb, null); }
public final Object setPixel (Object x, Object y, Object rgb, Object frame) { clrValues(); return requireFrame("set-pixel", frame).setRGB(toInt(x), toInt(y), toInt(rgb)); }
public final long rgbToPixel (Object... args) { threeArgs("rgb-to-pixel", args); return rgbToPixel(args[0], args[1], args[2]); }
@SuppressWarnings("RedundantCast")
public final long rgbToPixel (Object red, Object green, Object blue) { clrValues(); return (int)((toInt(red) << 16) | (toInt(green) << 8) | toInt(blue)); }
public final long hsbToPixel (Object... args) { threeArgs("hsb-to-pixel", args); return hsbToPixel(args[0], args[1], args[2]); }
public final long hsbToPixel (Object h, Object s, Object b) { clrValues(); return Color.HSBtoRGB(toFloat(h), toFloat(s), toFloat(b)); }
private static Object nth(int n, Object[] args) { return args.length > n ? args[n] : null; }
private static boolean secondArgNotNull (Object[] args) { return args.length > 1 && args[1] != null; }
private static boolean noSecondArgOrNotNull(Object[] args) { return args.length < 2 || args[1] != null; }
private Object retn(Object[] _values) { values = _values; return _values[0]; }
private Object ret2(Object prim, Object v2) { values = new Object[] { prim, v2 }; return prim; }
public final boolean clrValues(boolean b) { clrValues(); return b; }
public final Object clrValues(Object o) { clrValues(); return o; }
public final void clrValues() { values = null; }
private Object rc;
public boolean setRc(boolean rc) { this.rc = rc ? _t : null; return rc; }
public Object setRc(Object rc) { this.rc = rc; return rc; }
public Object getRc() { final Object rc = this.rc; this.rc = null; return rc; }
/// Helpers that the Java code compiled from Murmel will use, i.e. compiler intrinsics
public final LambdaJSymbol intern(String symName) { clrValues(); return symtab.intern(symName); }
public final Object arrayToList(Object[] args, int start) {
clrValues();
if (start >= args.length) return null;
if (args.length-start == 1) return ConsCell.cons(args[start], null);
final ListBuilder ret = new ListBuilder();
for (int i = start; i < args.length; i++) ret.append(args[i]);
return ret.first();
}
public final Map hash(ConsCell args) { return LambdaJ.Subr.hash(symtab, args); }
public static ConsCell arraySlice(Object[] o, int offset) { return LambdaJ.arraySlice(o, offset); }
public static ConsCell arraySlice(Object[] o) { return arraySlice(o, 0); }
/** convert null, an array or a list to a (possibly empty) Object[] */
public static Object[] toArray(Object o) {
if (o == null) return NOARGS;
if (o instanceof Object[]) return (Object[])o;
return listToArray(o);
}
private static int toArrayIndex(Object o) {
if (o instanceof Long) { final long l = (Long)o; final int i = Math.abs((int)l); if (l == i) return i; errorNotAnArrayIndex(o); }
if (o instanceof Double) { final double d = (Double)o; final int i = Math.abs((int)d); if (d == i) return i; errorNotAnArrayIndex(o); }
if (o instanceof Number) { final Number n = (Number)o; final int i = Math.abs(n.intValue()); if (n.equals(i)) return i; errorNotAnArrayIndex(o); }
throw errorNotAnArrayIndex(o);
}
private static int toArrayIndex(long l) {
final int i = Math.abs((int)l);
if (l == i) return i;
throw errorNotAnArrayIndex(l);
}
private static long toBit(Object o) {
if (o instanceof Long) { final long l = (Long)o; if (l == 0 || l == 1) return l; errorNotABit(o); }
if (o instanceof Double) { final double d = (Double)o; final long l = (int)d; if (d == l && (l == 0 || l == 1)) return l; errorNotABit(o); }
if (o instanceof Number) { final Number n = (Number)o; final long l = n.longValue(); if (n.equals(l) && (l == 0 || l == 1)) return l; errorNotABit(o); }
throw errorNotABit(o);
}
private static long toBit(long l) {
if (l == 0 || l == 1) return l;
throw errorNotABit(l);
}
public static double toDouble(Object n) {
// the redundant checks are faster than instanceof Number and will succeed most of the time
if (n instanceof Long) return ((Long)n).doubleValue();
if (n instanceof Double) return (Double) n;
return LambdaJ.Chk.toDouble(n);
}
public static double toDouble(Double n) { if (n != null) return n; throw errorNotANumber(null); }
public static double toDouble(double n) { return n; }
public static double toDouble(Long n) { if (n != null) return n; throw errorNotANumber(null); }
public static double toDouble(long n) { return n; }
public static long toLong(Object n) {
// the redundant checks are faster than instanceof Number and will succeed most of the time
if (n instanceof Long) return (Long) n;
if (n instanceof Double) return requireIntegralNumber("toLong", n, Long.MIN_VALUE, Long.MAX_VALUE).longValue();
if (n instanceof Byte) return ((Byte)n).longValue();
if (n instanceof Short) return ((Short)n).longValue();
if (n instanceof Integer) return ((Integer)n).longValue();
if (n instanceof Float) return requireIntegralNumber("toLong", n, Long.MIN_VALUE, Long.MAX_VALUE).longValue();
if (n instanceof Number) return requireIntegralNumber("toLong", n, Long.MIN_VALUE, Long.MAX_VALUE).longValue();
throw errorNotANumber(n);
}
public static long toLong(Long n) { if (n != null) return n; throw errorNotANumber(null); }
public static long toLong(long n) { return n; }
public static int toInt(Object n) { return requireIntegralNumber("toInt", n, Integer.MIN_VALUE, Integer.MAX_VALUE).intValue(); }
public static float toFloat(Object o) {
final Number n = LambdaJ.Chk.requireNumber("toFloat", o);
final double d = n.doubleValue();
if (d >= -Float.MAX_VALUE && d <= Float.MAX_VALUE) return n.floatValue();
throw errorOverflow("toFloat", "java.lang.Float", o);
}
public static boolean toBoolean(Object n) { return n != null; }
public static byte toByte(Object n) { return requireIntegralNumber("toByte", n, Byte.MIN_VALUE, Byte.MAX_VALUE).byteValue(); }
public static short toShort(Object n) { return requireIntegralNumber("toShort", n, Short.MIN_VALUE, Short.MAX_VALUE).shortValue(); }
/** used by generated Java code */
public static Object requireNotNull(Object obj) {
if (obj == null) { throw new SimpleTypeError("object is " + NIL); }
return obj;
}
public static Object[] requireArray(Object obj) {
if (obj == null) { throw new SimpleTypeError("object is " + NIL); }
if (obj instanceof Object[]) return (Object[])obj;
if (obj instanceof List) return ((List>)obj).toArray(new Object[0]);
throw new SimpleTypeError("not an array: %s", printSEx(obj));
}
/** used by generated Java code */
public static ConsCell requireList(Object lst) {
if (lst == null) return null;
if (!consp(lst)) errorNotAList(lst);
return (ConsCell)lst;
}
/** used by JFFI and generated inline JFFI */
public static ConsCell requireCons(Object lst) {
if (!consp(lst)) errorNotACons(lst);
return (ConsCell)lst;
}
/** used by JFFI and generated inline JFFI */
public static Character requireChar(Object o) {
if (!characterp(o)) errorNotACharacter(o);
return (Character)o;
}
/** used by JFFI and generated inline JFFI */
public static CharSequence requireCharSequence(Object o) {
if (o instanceof char[]) return String.valueOf((char[])o);
if (!(o instanceof CharSequence)) errorNotAString(o);
return (CharSequence)o;
}
/** used by JFFI and generated inline JFFI */
public static String requireString(Object o) {
if (o instanceof char[]) return String.valueOf((char[])o);
if (!stringp(o)) errorNotAString(o);
return o.toString();
}
/** used by JFFI and generated inline JFFI */
public static String requireStringOrNull(Object o) {
if (o == null) return null;
if (o instanceof char[]) return String.valueOf((char[])o);
if (!stringp(o)) errorNotAString(o);
return o.toString();
}
/** used by JFFI and generated inline JFFI */
public static Number requireNumber(Object o) {
return LambdaJ.Chk.requireNumber("?", o);
}
/** used by JFFI and generated inline JFFI */
public static Number requireNumberOrNull(Object o) {
if (o == null) return null;
return LambdaJ.Chk.requireNumber("?", o);
}
private TurtleFrame requireFrame(String func, int n, Object[] arg) { return requireFrame(func, nth(n, arg)); }
private TurtleFrame requireFrame(String s, Object o) {
clrValues();
if (o == null) o = current_frame;
if (o instanceof TurtleFrame) return (TurtleFrame)o;
throw errorNotAFrame(s, o);
}
public static Object[] unassigned(int length) { final Object[] ret = new Object[length]; Arrays.fill(ret, UNASSIGNED_LOCAL); return ret; }
public static void argCheck(String expr, int paramCount, Object[] args) { final int argCount = args.length; if (paramCount != argCount) errorArgCount(expr, paramCount, paramCount, argCount); }
public static void argCheckVarargs(String expr, int paramCount, Object[] args) { final int argCount = args.length; if (argCount < paramCount - 1) errorArgCount(expr, paramCount - 1, Integer.MAX_VALUE, argCount); }
@SuppressWarnings("unchecked")
public static T[] toVarargs(Object[] args, int paramCount, UnaryOperator transform, T[] resultArray) {
if (transform == null) {
for (int dst = 0, i = paramCount; i < args.length; ) { resultArray[dst++] = (T)args[i++]; }
}
else {
for (int dst = 0, i = paramCount; i < args.length; ) { resultArray[dst++] = (T)transform.apply(args[i++]); }
}
return resultArray;
}
public static byte[] toVarargs(Object[] args, int paramCount, UnaryOperator transform, byte[] resultArray) {
assert transform != null;
for (int dst = 0, i = paramCount; i < args.length; ) resultArray[dst++] = (byte)transform.apply(args[i++]);
return resultArray;
}
public static short[] toVarargs(Object[] args, int paramCount, UnaryOperator transform, short[] resultArray) {
assert transform != null;
for (int dst = 0, i = paramCount; i < args.length; ) resultArray[dst++] = (short)transform.apply(args[i++]);
return resultArray;
}
public static int[] toVarargs(Object[] args, int paramCount, UnaryOperator transform, int[] resultArray) {
assert transform != null;
for (int dst = 0, i = paramCount; i < args.length; ) resultArray[dst++] = (int)transform.apply(args[i++]);
return resultArray;
}
public static long[] toVarargs(Object[] args, int paramCount, UnaryOperator transform, long[] resultArray) {
assert transform != null;
for (int dst = 0, i = paramCount; i < args.length; ) resultArray[dst++] = (long)transform.apply(args[i++]);
return resultArray;
}
public static float[] toVarargs(Object[] args, int paramCount, UnaryOperator transform, float[] resultArray) {
assert transform != null;
for (int dst = 0, i = paramCount; i < args.length; ) resultArray[dst++] = (float)transform.apply(args[i++]);
return resultArray;
}
public static double[] toVarargs(Object[] args, int paramCount, UnaryOperator transform, double[] resultArray) {
assert transform != null;
for (int dst = 0, i = paramCount; i < args.length; ) resultArray[dst++] = (double)transform.apply(args[i++]);
return resultArray;
}
public static char[] toVarargs(Object[] args, int paramCount, UnaryOperator transform, char[] resultArray) {
assert transform != null;
for (int dst = 0, i = paramCount; i < args.length; ) resultArray[dst++] = (char)transform.apply(args[i++]);
return resultArray;
}
/** Primitives are in the environment as (CompilerPrimitive)... . Compiled code that calls primitives will
* actually call this overload and not funcall(Object, Object...) that contains the TCO thunking code. */
public static Object funcall(CompilerPrimitive fn, Object... args) { return fn.applyCompilerPrimitive(args); }
/** invoke *condition-handler* if any or rethrow, similar to Java's throw fling() doesn't return */
private void fling(Exception e) {
final Object handler = conditionHandler.get();
if (LambdaJ.functionp0(handler)) {
conditionHandler.pop(); // disable current handler, make previous handler active
try { funcall(handler, e); }
finally { conditionHandler.push(handler); /* restore current handler */ }
}
wrap0(e);
}
public static Object tailcall(CompilerPrimitive fn, Object... args) { return funcall(fn, args); }
/** used for (apply sym form) */
public static Object applyHelper(CompilerPrimitive fn, Object argList) { return funcall(fn, toArray(argList)); }
/** used for (apply sym form) */
public static Object applyTailcallHelper(CompilerPrimitive fn, Object argList) { return funcall(fn, toArray(argList)); }
public final Object funcall(@NotNull MurmelLeafFunction fn, Object... args) {
try {
return fn.apply(args);
}
catch (ReturnException re) { throw re; }
catch (Exception e) {
fling(e);
//noinspection ConstantConditions because fling() doesn't return
throw null /*notreached*/;
}
}
/** TCO trampoline, used for function calls, and also for let, labels, progn */
public final Object funcall(@NotNull MurmelFunction fn, Object... args) {
ConsCell cleanups = null;
try {
while (true) {
final Object r = fn.apply(args);
if (r instanceof Tailcall) {
final Tailcall functionCall = (Tailcall)r;
if (functionCall.cleanup != null) cleanups = ConsCell.cons(functionCall.cleanup, cleanups);
if (Thread.interrupted()) throw new InterruptedException("got interrupted");
fn = functionCall.fn;
args = functionCall.args;
continue;
}
return r;
}
}
catch (ReturnException re) { throw re; }
catch (Exception e) {
fling(e);
//noinspection ConstantConditions because fling() doesn't return
throw null /*notreached*/;
}
finally { if (cleanups != null) runCleanups(cleanups); }
}
private static void runCleanups(@NotNull ConsCell cleanups) {
LambdaJError ex = null;
for (Object cl: cleanups) {
try { ((MurmelFunction)cl).apply((Object[])null); }
//catch (LambdaJError e) { if (ex == null) ex = e; else ex.addSuppressed(e); }
//catch (Exception e) { if (ex == null) ex = new LambdaJError(e); else ex.addSuppressed(e); }
catch (LambdaJError e) { ex = e; }
catch (Exception e) { ex = new LambdaJError(e); }
}
if (ex != null) throw ex;
}
public final Object funcall(Object fn, Object... args) {
if (fn instanceof MurmelLeafFunction) return funcall((MurmelLeafFunction)fn, args);
if (fn instanceof MurmelFunction) return funcall((MurmelFunction)fn, args);
if (fn instanceof CompilerPrimitive) return funcall((CompilerPrimitive)fn, args);
return funcallIntp(fn, args);
}
private Object funcallIntp(Object fn, Object[] args) {
if (fn instanceof Primitive) { final Object ret = ((Primitive)fn).applyPrimitive(arraySlice(args)); if (intp != null) afterEval(); return ret; }
if (fn instanceof Closure) return interpret(fn, args);
throw errorNotAFunction(fn);
}
private Object interpret(Object fn, Object[] args) {
final LambdaJ intp = intpForEval();
final Object ret = intp.eval(ConsCell.cons(intern(APPLY),
ConsCell.cons(fn,
ConsCell.cons(ConsCell.cons(intern(QUOTE),
ConsCell.cons(arraySlice(args),
null)),
null))),
null);
afterEval();
return ret;
}
private static final class Tailcall {
MurmelFunction fn;
MurmelFunction cleanup;
Object[] args;
}
private final Tailcall tailcall = new Tailcall();
/** used for function calls */
public final Tailcall tailcall(MurmelFunction fn, Object... args) { return tailcallWithCleanup(fn, null, args); }
public Object tailcallWithCleanup(MurmelLeafFunction fn, MurmelFunction cleanup, Object[] args) {
try {
return funcall(fn, args);
}
finally {
if (cleanup != null) {
try { cleanup.apply((Object[])null); }
//catch (LambdaJError e) { if (ex == null) ex = e; else ex.addSuppressed(e); }
//catch (Exception e) { if (ex == null) ex = new LambdaJError(e); else ex.addSuppressed(e); }
catch (LambdaJError e) { throw e; }
catch (Exception e) { throw new LambdaJError(e); }
}
}
}
public final Tailcall tailcallWithCleanup(MurmelFunction fn, MurmelFunction cleanup, Object... args) {
final Tailcall tailcall = this.tailcall;
tailcall.fn = fn;
tailcall.cleanup = cleanup;
tailcall.args = args;
return tailcall;
}
public final Object tailcall(Object fn, Object... args) { return tailcallWithCleanup(fn, null, args); }
public final Object tailcallWithCleanup(Object fn, MurmelFunction cleanup, Object... args) {
if (fn instanceof MurmelLeafFunction) {
return tailcallWithCleanup((MurmelLeafFunction)fn, cleanup, args);
}
if (fn instanceof MurmelFunction) {
return tailcallWithCleanup((MurmelFunction)fn, cleanup, args);
}
assert cleanup == null : "unexpected: cleanup != null, fn is a " + fn.getClass().getSimpleName();
if (fn instanceof CompilerPrimitive) return funcall((CompilerPrimitive)fn, args);
if (fn instanceof Primitive) return ((Primitive)fn).applyPrimitive(arraySlice(args));
if (fn instanceof Closure) return interpret(fn, args);
throw errorNotAFunction(fn);
}
/** used for (apply sym form) */
public final Object applyHelper(Object fn, Object argList) { return funcall(fn, toArray(argList)); }
/** used for (apply sym form) */
public final Object applyTailcallHelper(Object fn, Object argList) { return tailcall(fn, toArray(argList)); }
public final Object doCatch(Object tag, MurmelFunction body) {
try {
return funcall(body, NOARGS);
}
catch (ReturnException re) {
if (tag == re.tag) { values = re.values; return re.result; }
throw re;
}
catch (LambdaJError le) { throw le; }
catch (Exception e) { return rterror(e); }
}
public final Object catchHelper(Object tag, Exception e) {
if (e instanceof ReturnException) {
final ReturnException re = (ReturnException)e;
if (tag == re.tag) { values = re.values; return re.result; }
throw re;
}
try {
fling(e);
}
catch (Exception e2) { return catchHelper(tag, e2); }
assert false: "notreached"; return null;
}
public final Object doThrow(Object tag, Object primaryResult) {
// todo checken obs tag gibt, sonst (error 'control-error)
throw new ReturnException(tag, primaryResult, values);
}
public final Object doTry(MurmelFunction protectedForm, Object errorObj) {
final Object oldHandler = conditionHandler.get();
conditionHandler.set(null);
try {
return protectedForm.apply(NOARGS);
}
catch (ReturnException e) { throw e; }
catch (Exception e) {
return ret2(errorObj, new LambdaJError(e, true, loc));
}
finally { conditionHandler.setForTry(oldHandler); }
}
/// ## Error "handlers" for compiled code, see also LambdaJ.error...()
private static RuntimeException errorNotANumber(Object n) { throw new SimpleTypeError("not a number: %s", printSEx(n)); }
private static RuntimeException errorNotABit(Object n) { throw new SimpleTypeError("not a bit: %s", printSEx(n)); }
private static RuntimeException errorNotAnArrayIndex(Object n) { throw new SimpleTypeError("invalid array index/ size: %s", printSEx(n)); }
private static void errorNotAList(Object s) { throw new SimpleTypeError("not a list: %s", printSEx(s)); }
private static void errorNotACons(Object s) { throw new SimpleTypeError("not a cons: %s", printSEx(s)); }
private static void errorNotACharacter(Object s) { throw new SimpleTypeError("not a character: %s", printSEx(s)); }
private static void errorNotAString(Object s) { throw new SimpleTypeError("not a string: %s", printSEx(s)); }
private static RuntimeException errorNotAFunction(Object fn) { throw LambdaJ.errorNotAFunction("not a function: %s", printSEx(fn)); }
private static RuntimeException errorNotAFrame(String s, Object o) {
if (o != null) throw new SimpleTypeError("%s: not a frame: %s", s, printSEx(o));
throw new SimpleTypeError("%s: no frame argument and no current frame", s);
}
private static void errorArgCount(String expr, int expectedMin, int expectedMax, int actual) {
if (actual < expectedMin) throw new ProgramError("%s: not enough arguments", expr);
if (expectedMax != -1 && actual > expectedMax) throw new ProgramError("%s: too many arguments", expr);
}
/// ## Error checking functions, see also LambdaJ.varargs...()
private static void noArgs(String expr, Object[] args) { final int argCount = args.length; if (0 != argCount) errorArgCount(expr, 0, 0, argCount); }
private static void oneArg(String expr, Object[] args) { final int argCount = args.length; if (1 != argCount) errorArgCount(expr, 1, 1, argCount); }
private static void twoArgs(String expr, Object[] args) { final int argCount = args.length; if (2 != argCount) errorArgCount(expr, 2, 2, argCount); }
private static void threeArgs(String expr, Object[] args) { final int argCount = args.length; if (3 != argCount) errorArgCount(expr, 3, 3, argCount); }
/** 0..1 args */
private static void varargs0_1(String expr, Object[] args) { final int argCount = args.length; if (argCount > 1) errorArgCount(expr, 0, 1, argCount); }
/** one or more arguments */
private static void varargs1(String expr, Object[] args) { final int argCount = args.length; if (argCount == 0) errorArgCount(expr, 1, -1, 0); }
/** 1..2 args */
private static void varargs1_2(String expr, Object[] args) { final int argCount = args.length; if (argCount < 1 || argCount > 2) errorArgCount(expr, 1, 2, argCount); }
/** two or more arguments */
private static void varargs2(String expr, Object[] args) { final int argCount = args.length; if (argCount < 2) errorArgCount(expr, 2, -1, argCount); }
private static void varargs3(String expr, Object[] args) { final int argCount = args.length; if (argCount < 3) errorArgCount(expr, 3, -1, argCount); }
private static void varargsMinMax(String expr, Object[] args, int min, int max) {
final int argCount = args.length;
if (argCount < min || argCount > max)
errorArgCount(expr, min, max, argCount);
}
@SuppressWarnings("unused") // used by multiple-value-call
public class ValuesBuilder {
private final ArrayList allValues = new ArrayList<>();
public ValuesBuilder() { clrValues(); }
public ValuesBuilder add(Object primary) {
if (values == null) {
allValues.add(primary);
} else if (values.length > 0) {
allValues.addAll(Arrays.asList(values));
}
clrValues();
return this;
}
public Object[] build() { return allValues.toArray(); }
// return an array of length n, filling with nil or truncating as needed
public Object[] build(int n, boolean truncate) {
for (int i = allValues.size(); i < n; i++) allValues.add(null);
if (truncate) return allValues.subList(0, n).toArray();
else return allValues.toArray();
}
}
public final Object[] mv(Object prim, int nVars) {
final Object[] ret;
if (values != null && values.length == nVars) {
ret = values;
return ret;
}
ret = new Object[nVars];
if (values != null) {
for (int m = 0; m < nVars && m < values.length; ++m) ret[m] = values[m];
}
else ret[0] = prim;
return ret;
}
public final Object[] mvVarargs(Object prim, int nVars) {
final Object[] ret = new Object[nVars];
if (values != null) {
int m = 0;
for (; m < nVars-1 && m < values.length; ++m) ret[m] = values[m];
if (m < values.length) ret[m] = arraySlice(Arrays.copyOfRange(values, m, values.length));
}
else ret[0] = prim;
return ret;
}
public String loc;
/** main() will be called from compiled Murmel code */
@SuppressWarnings("unused")
protected static void main(MurmelJavaProgram program) {
program.loc = "";
try {
final Object result = program.body();
if (result != null) {
System.out.println();
System.out.print("==> "); program._write(result);
System.out.println();
//System.exit(0); don't call exit this wouldn't wait for open frames
}
} catch (LambdaJError e) {
System.err.println("Runtime error at " + program.loc + ": " + e.getMessage());
System.exit(1);
} catch (Throwable t) {
System.err.println("Caught Throwable at " + program.loc + ": " + t);
System.exit(1);
}
}
@Override public void setCommandlineArgumentList(ConsCell args) {
commandlineArgumentList.set(args);
}
@Override public Object getValue(String symbol) {
switch (symbol) {
// predefined global variables
case NIL: return null;
case T: return _t;
case PI: return _pi;
case ARRAY_DIMENSION_LIMIT: return arrayDimensionLimit;
case MOST_POSITIVE_FIXNUM: return mostPositiveFixnum;
case MOST_NEGATIVE_FIXNUM: return mostNegativeFixnum;
case INTERNAL_TIME_UNITS_PER_SECOND: return itups;
case COMMAND_LINE_ARGUMENT_LIST: return commandlineArgumentList.get(); // this will be assigned by genereted code at runtime
case FEATURES: return features.get();
case CONDITION_HANDLER: return conditionHandler.get();
case RANDOM_STATE: return randomState.get();
// basic primitives
case APPLY: return (CompilerPrimitive)this::_apply;
case EVAL: return (CompilerPrimitive)this::_eval;
// logic, predicates
case EQ: return (CompilerPrimitive)this::_eq;
case EQL: return (CompilerPrimitive)this::_eql;
case EQUAL: return (CompilerPrimitive)this::_equal;
case CONSP: return (CompilerPrimitive)this::_consp;
case ATOM: return (CompilerPrimitive)this::_atom;
case SYMBOLP: return (CompilerPrimitive)this::_symbolp;
case NULL: return (CompilerPrimitive)this::_null;
case NUMBERP: return (CompilerPrimitive)this::_numberp;
case FLOATP: return (CompilerPrimitive)this::_floatp;
case INTEGERP: return (CompilerPrimitive)this::_integerp;
case CHARACTERP: return (CompilerPrimitive)this::_characterp;
case RANDOM_STATE_P: return (CompilerPrimitive)this::_randomstatep;
case VECTORP: return (CompilerPrimitive)this::_vectorp;
case SIMPLE_VECTOR_P: return (CompilerPrimitive)this::svectorp;
case STRINGP: return (CompilerPrimitive)this::_stringp;
case SIMPLE_STRING_P: return (CompilerPrimitive)this::sstringp;
case BIT_VECTOR_P: return (CompilerPrimitive)this::bitvectorp;
case SIMPLE_BIT_VECTOR_P: return (CompilerPrimitive)this::sbitvectorp;
case HASH_TABLE_P: return (CompilerPrimitive)this::hashtablep;
case FUNCTIONP: return (CompilerPrimitive)this::_functionp;
case LISTP: return (CompilerPrimitive)this::_listp;
case TYPEP: return (CompilerPrimitive)this::_typep;
case ADJUSTABLE_ARRAY_P: return (CompilerPrimitive)this::adjustableArrayP;
// conses and lists
case CAR: return (CompilerPrimitive)this::_car;
case CDR: return (CompilerPrimitive)this::_cdr;
case CONS: return (CompilerPrimitive)this::_cons;
case RPLACA: return (CompilerPrimitive)this::_rplaca;
case RPLACD: return (CompilerPrimitive)this::_rplacd;
case LIST: return (CompilerPrimitive)this::_list;
case LISTSTAR: return (CompilerPrimitive)this::listStar;
case APPEND: return (CompilerPrimitive)this::_append;
case ASSQ: return (CompilerPrimitive)this::_assq;
case ASSOC: return (CompilerPrimitive)this::_assoc;
// numbers, characters
case "+": return (CompilerPrimitive)this::add;
case "*": return (CompilerPrimitive)this::mul;
case "-": return (CompilerPrimitive)this::sub;
case "/": return (CompilerPrimitive)this::quot;
case "=": return (CompilerPrimitive)this::numbereq;
case "/=": return (CompilerPrimitive)this::ne;
case "<": return (CompilerPrimitive)this::lt;
case "<=": return (CompilerPrimitive)this::le;
case ">=": return (CompilerPrimitive)this::ge;
case ">": return (CompilerPrimitive)this::gt;
case "1+": return (CompilerPrimitive)this::inc;
case "1-": return (CompilerPrimitive)this::dec;
case "signum": return (CompilerPrimitive)this::_signum;
case "round": return (CompilerPrimitive)this::_round;
case "floor": return (CompilerPrimitive)this::_floor;
case "ceiling": return (CompilerPrimitive)this::_ceiling;
case "truncate": return (CompilerPrimitive)this::_truncate;
case "fround": return (CompilerPrimitive)this::_fround;
case "ffloor": return (CompilerPrimitive)this::_ffloor;
case "fceiling": return (CompilerPrimitive)this::_fceiling;
case "ftruncate": return (CompilerPrimitive)this::_ftruncate;
case "sqrt": return (CompilerPrimitive)this::_sqrt;
case "log": return (CompilerPrimitive)this::_log;
case "log10": return (CompilerPrimitive)this::_log10;
case "exp": return (CompilerPrimitive)this::_exp;
case "expt": return (CompilerPrimitive)this::_expt;
case "mod": return (CompilerPrimitive)this::_mod;
case "rem": return (CompilerPrimitive)this::_rem;
case "random": return (CompilerPrimitive)this::_random;
case "make-random-state": return (CompilerPrimitive)this::makeRandomState;
// vectors, sequences
case MAKE_ARRAY: return (CompilerPrimitive)this::makeArray;
case "vector-length": return (CompilerPrimitive)this::vectorLength;
case "vector-copy": return (CompilerPrimitive)this::vectorCopy;
case VECTOR_FILL: return (CompilerPrimitive)this::vectorFill;
case "vector-add": return (CompilerPrimitive)this::vectorAdd;
case "vector-remove": return (CompilerPrimitive)this::vectorRemove;
case "vector->list": return (CompilerPrimitive)this::vectorToList;
case "list->vector": return (CompilerPrimitive)this::listToVector;
case "svlength": return (CompilerPrimitive)this::_svlength;
case "svref": return (CompilerPrimitive)this::_svref;
case "svset": return (CompilerPrimitive)this::_svset;
case "simple-vector->list": return (CompilerPrimitive)this::simpleVectorToList;
case "list->simple-vector": return (CompilerPrimitive)this::listToSimpleVector;
case VECTOR: return (CompilerPrimitive)this::_vector;
case VECT: return (CompilerPrimitive)this::_vect;
case "string": return (CompilerPrimitive)this::_string;
case "slength": return (CompilerPrimitive)this::_slength;
case "sref": return (CompilerPrimitive)this::_sref;
case "sset": return (CompilerPrimitive)this::_sset;
case "string=": return (CompilerPrimitive)this::stringeq;
case "string->list": return (CompilerPrimitive)this::stringToList;
case "list->string": return (CompilerPrimitive)this::listToString;
case "char-code": return (CompilerPrimitive)this::charInt;
case "code-char": return (CompilerPrimitive)this::intChar;
case "bvlength": return (CompilerPrimitive)this::_bvlength;
case "bvref": return (CompilerPrimitive)this::_bvref;
case "bvset": return (CompilerPrimitive)this::_bvset;
case "bv=": return (CompilerPrimitive)this::bvEq;
case "bit-vector->list": return (CompilerPrimitive)this::bitVectorToList;
case "list->bit-vector": return (CompilerPrimitive)this::listToBitVector;
case "seqref": return (CompilerPrimitive)this::_seqref;
case SEQSET: return (CompilerPrimitive)this::_seqset;
// Hash tables
case HASH: return (CompilerPrimitive)this::_hash;
case MAKE_HASH_TABLE: return (CompilerPrimitive)this::makeHash;
case "hashref": return (CompilerPrimitive)this::_hashref;
case "hashset": return (CompilerPrimitive)this::_hashset;
case "hash-table-count": return (CompilerPrimitive)this::hashTableCount;
case "clrhash": return (CompilerPrimitive)this::_clrhash;
case "hash-table-remove": return (CompilerPrimitive)this::hashRemove;
case "sxhash": return (CompilerPrimitive)this::_sxhash;
case "scan-hash-table": return (CompilerPrimitive)this::scanHash;
// I/O
case "read": return (CompilerPrimitive)this::_read;
case "read-from-string": return (CompilerPrimitive)this::readFromStr;
case "read-textfile-lines": return (CompilerPrimitive)this::readTextfileLines;
case "read-textfile": return (CompilerPrimitive)this::readTextfile;
case "write-textfile-lines": return (CompilerPrimitive)this::writeTextfileLines;
case "write-textfile": return (CompilerPrimitive)this::writeTextfile;
case "write-to-string": return (CompilerPrimitive)this::writeToString;
case "write": return (CompilerPrimitive)this::_write;
case "writeln": return (CompilerPrimitive)this::_writeln;
case "lnwrite": return (CompilerPrimitive)this::_lnwrite;
case "format": return (CompilerPrimitive)this::format;
case "format-locale": return (CompilerPrimitive)this::formatLocale;
// misc
case VALUES: return (CompilerPrimitive)this::_values;
case "gensym": return (CompilerPrimitive)this::_gensym;
case "trace": return (CompilerPrimitive)this::_trace;
case "untrace": return (CompilerPrimitive)this::_untrace;
case ERROR: return (CompilerPrimitive)this::_error;
case "lisp-implementation-type": return (CompilerPrimitive)this::implType;
case "lisp-implementation-version": return (CompilerPrimitive)this::implVersion;
// time
case "get-internal-real-time": return (CompilerPrimitive)this::getInternalRealTime;
case "get-internal-run-time": return (CompilerPrimitive)this::getInternalRunTime;
case "sleep": return (CompilerPrimitive)this::sleep;
case "get-universal-time": return (CompilerPrimitive)this::getUniversalTime;
case "get-decoded-time": return (CompilerPrimitive)this::getDecodedTime;
// Java FFI
case JMETHOD: return (CompilerPrimitive)this::_jmethod;
case "jproxy": return (CompilerPrimitive)this::_jproxy;
// graphics
case "make-frame": return (CompilerPrimitive)this::makeFrame;
case "open-frame": return (CompilerPrimitive)this::openFrame;
case "close-frame": return (CompilerPrimitive)this::closeFrame;
case "reset-frame": return (CompilerPrimitive)this::resetFrame;
case "clear-frame": return (CompilerPrimitive)this::clearFrame;
case "repaint-frame": return (CompilerPrimitive)this::repaintFrame;
case "flush-frame": return (CompilerPrimitive)this::flushFrame;
case "current-frame": return (CompilerPrimitive)this::currentFrame;
case "color": return (CompilerPrimitive)this::color;
case "bgcolor": return (CompilerPrimitive)this::bgColor;
case "right": return (CompilerPrimitive)this::right;
case "left": return (CompilerPrimitive)this::left;
case "forward": return (CompilerPrimitive)this::forward;
case "move-to": return (CompilerPrimitive)this::moveTo;
case "line-to": return (CompilerPrimitive)this::lineTo;
case "move-rel": return (CompilerPrimitive)this::moveRel;
case "line-rel": return (CompilerPrimitive)this::lineRel;
case "push-pos": return (CompilerPrimitive)this::pushPos;
case "pop-pos": return (CompilerPrimitive)this::popPos;
case "pen-up": return (CompilerPrimitive)this::penUp;
case "pen-down": return (CompilerPrimitive)this::penDown;
case "text": return (CompilerPrimitive)this::text;
case "make-bitmap": return (CompilerPrimitive)this::makeBitmap;
case "discard-bitmap": return (CompilerPrimitive)this::discardBitmap;
case "set-pixel": return (CompilerPrimitive)this::setPixel;
case "rgb-to-pixel": return (CompilerPrimitive)this::rgbToPixel;
case "hsb-to-pixel": return (CompilerPrimitive)this::hsbToPixel;
default: throw errorUnbound("getValue", symbol);
}
}
}
///
/// ## class MurmelJavaCompiler
/// class MurmelJavaCompiler - compile Murmel to Java or to a in-memory Class-object and optionally to a .jar file
///
public static class MurmelJavaCompiler {
private static final boolean USE_SWITCH_EXPR = JavaUtil.jvmVersion() >= 14;
private static final String ARGSEP = ",\n ";
private final JavaCompilerHelper javaCompiler;
final @NotNull LambdaJ intp;
private final LambdaJSymbol sQuote, sDefine, sApply, sEval, sLambda, sList, sCar, sCdr, sJmethod, sValues;
public MurmelJavaCompiler(SymbolTable st, Path libDir, Path outPath) {
final LambdaJ intp = new LambdaJ(Features.HAVE_ALL_LEXC.bits(), TraceLevel.TRC_NONE, null, st, null, null, null, libDir);
intp.init(NULL_READCHARS, System.out::print, null);
this.intp = intp;
sQuote = intern(QUOTE);
sDefine = intern(DEFINE);
sApply = intern(APPLY);
sEval = intern(EVAL);
sLambda = intern(LAMBDA);
sList = intern(LIST);
sCar = intern(CAR);
sCdr = intern(CDR);
sJmethod = intern(JMETHOD);
sValues = intern(VALUES);
this.javaCompiler = outPath == null ? null : new JavaCompilerHelper(outPath);
primitivesBySymbol = makePrimitivesBySymbol();
}
public @NotNull SymbolTable getSymbolTable() { return intp.getSymbolTable(); }
private void note(String msg) { System.err.println("; Note - " + (containingForm == null ? "" : containingForm.lineInfo()) + msg); }
private void noteDead(Object form) { note("removing dead code " + (form == null ? "" : printSEx(form, true))); }
/// symbols and name mangling
public @NotNull LambdaJSymbol intern(String symname) {
if (symname == null) return sNil;
return intp.intern(symname);
}
/** return true if lhs is the same symbol as interned rhs */
private boolean symbolEq(Object lhs, String rhs) {
return lhs == intern(rhs);
}
/** replace chars that are not letters */
private static @NotNull String mangle(String symname, int sfx) {
final int len = symname.length();
final StringBuilder mangled = new StringBuilder(Math.max(len+10, 16));
mangled.append('_');
for (int i = 0; i < len; i++) {
final char c = symname.charAt(i);
if (c == '_' || c >= '0' && c <= '9' || c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z') mangled.append(c);
else mangled.append('_').append((int)c).append('_');
}
if (sfx != 0) mangled.append('_').append(sfx);
return mangled.toString();
}
private @NotNull String mangleFunctionName(String symname, int sfx) {
return mangle(currentFunctionName.substring(1) + symname, sfx);
}
/// environment
/** extend the environment by putting (symbol mangledsymname) in front of {@code prev},
* symbols that are reserved words throw an error. */
private static @NotNull ConsCell extenv(String func, Object symbol, int sfx, ConsCell prev) {
final LambdaJSymbol sym = LambdaJ.symbolOrMalformed(func, symbol);
return extenvIntern(sym, mangle(sym.toString(), sfx), prev);
}
/** extend environment w/o reserved word check */
private static @NotNull ConsCell extenvIntern(LambdaJSymbol sym, String javaName, ConsCell env) {
return cons(cons(sym, javaName), env);
}
private static @NotNull ConsCell extenvprim(LambdaJSymbol sym, String javaName, ConsCell env) {
return extenvIntern(sym, "((CompilerPrimitive)rt()::" + javaName + ')', env);
}
private boolean passTwo;
private Set implicitDecl;
private Set globalDecl;
/** return {@code form} as a Java expression */
private ConsCell containingForm;
private @NotNull String javasym(Object form, ConsCell env) {
if (form == null || form == sNil) return "(Object)null";
final ConsCell symentry = fastassq(form, env);
if (symentry == null) {
if (passTwo) errorMalformedFmt("compilation unit", "undefined symbol %s", form);
note("implicit declaration of " + form);
implicitDecl.add(form);
return mangle(form.toString(), 0) + ".get()"; // on pass 1 assume that undeclared variables are forward references to globals
}
else //noinspection SuspiciousMethodCalls
if (!passTwo && globalDecl.contains(form)) implicitDecl.remove(form);
final String javasym;
if (listp(cdr(symentry))) javasym = (String)cadr(symentry); // function: symentry is (sym . (javasym . (params...)))
else javasym = (String)cdr(symentry);
return javasym;
}
private static void notDefined(String func, Object sym, ConsCell env) {
final ConsCell prevEntry = fastassq(sym, env);
if (prevEntry != null) {
LambdaJ.notReserved(func, (LambdaJSymbol)car(prevEntry));
errorMalformedFmt(func, "can't redefine symbol %s", sym);
}
}
private static void defined(String func, Object sym, ConsCell env) {
if (sym == null) return; // nil is always defined
final ConsCell symentry = fastassq(sym, env);
if (symentry == null) errorMalformedFmt(func, "undefined symbol %s", sym.toString());
}
private static void notAPrimitive(String func, Object symbol, String javaName) {
if (javaName.startsWith("((CompilerPrimitive")) errorNotImplemented("%s: assigning primitives is not implemented: %s", func, symbol.toString());
}
/// Environment for compiled Murmel
private static final String[] globalvars = {NIL, T, PI};
private static final String[][] aliasedGlobals = {
{ MOST_POSITIVE_FIXNUM, "mostPositiveFixnum" }, { MOST_NEGATIVE_FIXNUM, "mostNegativeFixnum" }, { ARRAY_DIMENSION_LIMIT, "arrayDimensionLimit" },
{ INTERNAL_TIME_UNITS_PER_SECOND, "itups" },
{ COMMAND_LINE_ARGUMENT_LIST, "commandlineArgumentList.get()" },
{ FEATURES, "features.get()" }, { CONDITION_HANDLER, "conditionHandler.get()" }, { RANDOM_STATE, "randomState.get()" },
};
private static final String primitives =
CAR + "\n" +CDR + "\n" +CONS + "\n" +RPLACA + "\n" +RPLACD + "\n"
+ /*"apply",*/ EVAL + "\n" +EQ + "\n" +EQL + "\n" +EQUAL + "\n" +NULL + "\n" +"read" + "\n" +"write" + "\n" +"writeln" + "\n" +"lnwrite" + "\n"
+ ATOM + "\n" +CONSP + "\n" +FUNCTIONP + "\n" +LISTP + "\n" +SYMBOLP + "\n" +NUMBERP + "\n" +STRINGP + "\n" +CHARACTERP + "\n" +INTEGERP + "\n" +FLOATP + "\n" +VECTORP + "\n" +TYPEP + "\n"
+ ASSOC + "\n" +ASSQ + "\n" +LIST + "\n" +VECT + "\n" +VECTOR + "\n" +"seqref" + "\n" + SEQSET + "\n" +"svref" + "\n" +"svset" + "\n" +"svlength" + "\n" +"string" + "\n" +"slength" + "\n" +"sref" + "\n" +"sset" + "\n" +"bvref" + "\n" +"bvset" + "\n" +"bvlength" + "\n"
+ APPEND + "\n" +VALUES + "\n"
+ "round" + "\n" +"floor" + "\n" +"ceiling" + "\n" +"truncate" + "\n"
+ "fround" + "\n" +"ffloor" + "\n" +"fceiling" + "\n" +"ftruncate" + "\n"
+ "sqrt" + "\n" +"log" + "\n" +"log10" + "\n" +"exp" + "\n" +"expt" + "\n" +"mod" + "\n" +"rem" + "\n" +"signum" + "\n" +"random" + "\n"
+ "gensym" + "\n" +"trace" + "\n" +"untrace" + "\n"
+ ERROR + "\n" +JMETHOD + "\n" +"jproxy";
private static final String aliasedPrimitives =
"+@add" + "\n" + "*@mul" + "\n" + "-@sub" + "\n" + "/@quot" + "\n"
+ "=@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"
+ "write-textfile-lines@writeTextfileLines" + "\n" + "write-textfile@writeTextfile" + "\n" + "write-to-string@writeToString" + "\n" + "format@format" + "\n" + "format-locale@formatLocale" + "\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"
+ "vector->list@vectorToList" + "\n" + "list->vector@listToVector" + "\n" + "simple-vector->list@simpleVectorToList" + "\n" + "list->simple-vector@listToSimpleVector" + "\n"
+ "bit-vector->list@bitVectorToList" + "\n" + "list->bit-vector@listToBitVector" + "\n"
+ "vector-length@vectorLength" + "\n" + "vector-copy@vectorCopy" + "\n" + VECTOR_FILL+"@vectorFill" + "\n"
+ SIMPLE_VECTOR_P+"@svectorp" + "\n" + SIMPLE_STRING_P+"@sstringp" + "\n" + RANDOM_STATE_P+"@_randomstatep" + "\n" + "make-random-state@makeRandomState" + "\n"
+ BIT_VECTOR_P+"@bitvectorp" + "\n" + "bv=@bvEq" + "\n" + SIMPLE_BIT_VECTOR_P+"@sbitvectorp" + "\n" + HASH_TABLE_P+"@hashtablep" + "\n" + MAKE_ARRAY+"@makeArray" + "\n"
+ HASH+"@_hash" + "\n" + MAKE_HASH_TABLE+"@makeHash" + "\n" + "hashref@_hashref" + "\n" + "hashset@_hashset" + "\n"
+ "hash-table-count@hashTableCount" + "\n" + "clrhash@_clrhash" + "\n" + "hash-table-remove@hashRemove" + "\n" + "sxhash@_sxhash" + "\n" + "scan-hash-table@scanHash" + "\n"
+ LISTSTAR+"@listStar" + "\n"
//+ "macroexpand-1@macroexpand1" + "\n"
+ "lisp-implementation-type@implType" + "\n" + "lisp-implementation-version@implVersion" + "\n"
+ "get-internal-real-time@getInternalRealTime" + "\n" + "get-internal-run-time@getInternalRunTime" + "\n"
+ "sleep@sleep" + "\n" + "get-universal-time@getUniversalTime" + "\n" + "get-decoded-time@getDecodedTime" + "\n"
+ "make-frame@makeFrame" + "\n" + "open-frame@openFrame" + "\n" + "close-frame@closeFrame" + "\n"
+ "reset-frame@resetFrame" + "\n" + "clear-frame@clearFrame" + "\n" + "repaint-frame@repaintFrame" + "\n" + "flush-frame@flushFrame" + "\n"
+ "current-frame@currentFrame" + "\n"
+ "push-pos@pushPos" + "\n" + "pop-pos@popPos" + "\n" + "pen-up@penUp" + "\n" + "pen-down@penDown" + "\n"
+ "color@color" + "\n" + "bgcolor@bgColor" + "\n" + "text@text" + "\n"
+ "right@right" + "\n" + "left@left" + "\n" + "forward@forward" + "\n"
+ "move-to@moveTo" + "\n" + "line-to@lineTo" + "\n" + "move-rel@moveRel" + "\n" + "line-rel@lineRel" + "\n"
+ "make-bitmap@makeBitmap" + "\n" + "discard-bitmap@discardBitmap" + "\n"
+ "set-pixel@setPixel" + "\n"
+ "rgb-to-pixel@rgbToPixel" + "\n" + "hsb-to-pixel@hsbToPixel";
/** maps symbol -> javaNameAsString */
private final @NotNull Map primitivesBySymbol;
private Map makePrimitivesBySymbol() {
final String[] primitives = MurmelJavaCompiler.primitives.split("\n");
final String[][] aliasedPrimitives = Arrays.stream(MurmelJavaCompiler.aliasedPrimitives.split("\n"))
.map(s -> s.split("@"))
.collect(Collectors.toList())
.toArray(new String[0][2]);
final Map map = new IdentityHashMap<>(JavaUtil.hashMapCapacity(primitives.length + aliasedPrimitives.length));
for (String prim: primitives) map.put(intern(prim), mangle(prim, 0));
for (String[] alias: aliasedPrimitives) map.put(intern(alias[0]), alias[1]);
return map;
}
private ConsCell customEnvironment;
/** {@code customEnvironment} must be an alist (symbol . CompilerPrimitive) or (symbol . Primitive) */
public void setCustomEnvironment(ConsCell customEnvironment) { this.customEnvironment = customEnvironment; }
/// Wrappers to compile Murmel to a Java class and optionally a .jar
/** Compile the Murmel compilation unit {@code forms} to a Java class for a standalone application with a "public static void main()" */
public @NotNull Class formsToJavaClass(String unitName, ReadSupplier forms, String jarFileName) throws Exception {
return formsToJavaClass(unitName, makeReader(forms, getSymbolTable(), intp.featuresEnvEntry), null);
}
public @NotNull Class formsToJavaClass(String unitName, ObjectReader forms, String jarFileName) throws Exception {
final StringWriter w = new StringWriter();
formsToJavaSource(w, unitName, forms);
final Class ret = javaCompiler.javaToClass(unitName, w.toString(), jarFileName);
if (customEnvironment != null) {
final ArrayList fp = new ArrayList<>();
for (Object entry: customEnvironment) {
fp.add(cdr((ConsCell)entry));
}
ret.getField("foreign").set(null, fp.toArray(new Object[0]));
}
return ret;
}
/// Wrappers to compile Murmel to Java source
private boolean complexFormSeen;
private MacroEnv macroEnv;
/** Compile the Murmel compilation unit to Java source for a standalone application class {@code unitName}
* with a "public static void main()" */
public void formsToJavaSource(Writer w, String unitName, ObjectReader forms) {
quotedForms.clear(); qCounter = 0; complexFormSeen = false;
ConsCell predefinedEnv = null;
if (customEnvironment != null) {
int n = 0;
for (Object entry: customEnvironment) {
final ConsCell ccEntry = (ConsCell)entry;
final Object foreignFunction = cdr(ccEntry);
if (foreignFunction instanceof MurmelJavaProgram.CompilerPrimitive || foreignFunction instanceof Primitive) {
predefinedEnv = extenvIntern((LambdaJSymbol)car(ccEntry), "rt().foreign[" + n++ + "]", predefinedEnv);
}
else {
throw new ProgramError(car(ccEntry) + " should be a CompilerPrimitive or Primitive");
}
}
}
for (String global: globalvars) predefinedEnv = extenvIntern(intern(global), '_' + global, predefinedEnv);
for (String[] alias: aliasedGlobals) predefinedEnv = extenvIntern(intern(alias[0]), alias[1], predefinedEnv);
for (Map.Entry entry: primitivesBySymbol.entrySet()) predefinedEnv = extenvprim(entry.getKey(), entry.getValue(), predefinedEnv);
// _apply needs to be of type MurmelFunction so that it will be processed by the TCO trampoline
predefinedEnv = extenvIntern(sApply, "((MurmelFunction)rt()::_apply)", predefinedEnv);
final WrappingWriter ret = new WrappingWriter(w);
final String clsName;
final int dotpos = unitName.lastIndexOf('.');
if (dotpos == -1) {
clsName = unitName;
}
else {
ret.append("package ").append(unitName.substring(0, dotpos)).append(";\n\n");
clsName = unitName.substring(dotpos+1);
}
ret.append("import java.util.function.Function;\n"
+ "import java.util.function.Supplier;\n"
+ "import io.github.jmurmel.LambdaJ.*;\n\n"
+ "@SuppressWarnings({\"unchecked\", \"UnnecessaryContinue\", \"UnusedLabel\", \"LoopStatementThatDoesntLoop\", \"IfStatementWithNegatedCondition\", \"ConstantConditions\", \"UnusedAssignment\", \"UnusedReturnValue\"})\n"
+ "public class ").append(clsName).append(" extends MurmelJavaProgram {\n"
+ " public static Object[] foreign;\n"
+ " protected ").append(clsName).append(" rt() { return this; }\n\n"
+ " public static void main(String[] args) {\n"
+ " final ").append(clsName).append(" program = new ").append(clsName).append("();\n"
+ " program.commandlineArgumentList.set(program.arrayToList(args,0));\n"
+ " main(program);\n"
+ " }\n\n");
final ArrayList bodyForms = new ArrayList<>();
final StringBuilder globals = new StringBuilder();
/// first pass: emit toplevel define/ defun forms
final short prevSpeed = intp.speed, prevDebug = intp.debug;
passTwo = false;
implicitDecl = new HashSet<>();
globalDecl = new HashSet<>();
ConsCell globalEnv = predefinedEnv;
macroEnv = new MacroEnv();
final Object eof = "EOF";
Object form;
while (eof != (form = forms.readObj(true, eof))) {
try {
globalEnv = toplevelFormToJava(ret, bodyForms, globals, globalEnv, intp.expandForm(form, macroEnv));
}
catch (LambdaJError e) {
throw e;
}
catch (Exception e) {
throw errorInternal(e, "formToJava: caught exception %s: %s", e.getClass().getName(), e.getMessage(), form); // convenient breakpoint for errors
}
}
if (!implicitDecl.isEmpty()) {
errorMalformedFmt("compilation unit", "undefined symbols: %s", implicitDecl);
}
implicitDecl = null;
globalDecl = null;
intp.clearMacros(); // on pass2 macros will be re-interpreted at the right place so that illegal macro forward-refences are caught
// emit getValue() for embed API
ret.append(" @Override public Object getValue(String symbol) {\n");
if (globals.length() > 0) ret.append(" switch (symbol) {\n").append(globals).append(" }\n");
// ret.append(" switch (symbol) {\n");
// for (String global: globalvars) ret.append(" case \"").append(global) .append("\": return _").append(global).append(";\n");
// for (String[] alias: aliasedGlobals) ret.append(" case \"").append(alias[0]).append("\": return ") .append(alias[1]).append(";\n");
// for (String prim: primitives) ret.append(" case \"").append(prim) .append("\": return (CompilerPrimitive)rt()::_").append(prim).append(";\n");
// for (String[] alias: aliasedPrimitives) ret.append(" case \"").append(alias[0]).append("\": return (CompilerPrimitive)rt()::").append(alias[1]).append(";\n");
// ret.append(" default: throw new LambdaJError(true, \"%s: '%s' is undefined\", \"getValue\", symbol);\n"
// + " }\n");
ret.append(" return super.getValue(symbol);\n"
+ " }\n\n"
+ " // toplevel forms\n"
+ " protected Object runbody() throws Exception {\n");
/// second pass: emit toplevel forms that are not define or defun as well as the actual assignments for define/ defun
intp.speed = prevSpeed; intp.debug = prevDebug;
passTwo = true;
emitToplevelForms(ret, bodyForms, globalEnv, globalEnv);
ret.append(" }\n");
emitConstantPool(ret);
ret.append("}\n");
ret.flush();
macroEnv = null;
}
private ConsCell toplevelFormToJava(WrappingWriter ret, List bodyForms, StringBuilder globals, ConsCell globalEnv, Object form) {
final LambdaJ intp = this.intp;
if (consp(form)) {
final ConsCell ccForm = (ConsCell)form;
containingForm = ccForm;
final Object op = car(ccForm);
assert op != null && op != sNil : "not a function: nil - should have been caught by expandForm()";
if (symbolp(op)) {
switch (((LambdaJSymbol)op).wellknownSymbol) {
case sDefine: {
if (!complexFormSeen) complexFormSeen = consp(caddr(ccForm)) && sJmethod != car(caddr(ccForm));
globalEnv = defineToJava(ret, ccForm, globalEnv, 0);
intp.eval(ccForm, null);
if (complexFormSeen) bodyForms.add(ccForm);
globals.append(" case \"").append(cadr(ccForm)).append("\": return ").append(javasym(cadr(ccForm), globalEnv)).append(";\n");
return globalEnv;
}
case sDefun: {
globalEnv = defunToJava(ret, ccForm, globalEnv);
intp.eval(ccForm, null);
if (complexFormSeen) bodyForms.add(ccForm);
globals.append(" case \"").append(cadr(ccForm)).append("\": return ").append(javasym(cadr(ccForm), globalEnv)).append(";\n");
return globalEnv;
}
case sDefmacro: {
LambdaJ.symbolOrMalformed(DEFMACRO, cadr(ccForm));
intp.eval(ccForm, null);
bodyForms.add(ccForm); // needed if compiled code calls macroexpand-1
return globalEnv;
}
case sProgn: {
// toplevel progn will be replaced by the (macroexpanded) forms it contains.
// Macroexpand is needed in case the progn contained a load or require that contains defmacro forms, see also LambdaJ#expandAndEval()
final ConsCell body = listOrMalformed(PROGN, cdr(ccForm));
for (Object prognForm : body) {
globalEnv = toplevelFormToJava(ret, bodyForms, globals, globalEnv, intp.expandForm(prognForm, macroEnv));
}
return globalEnv;
}
case sLabels:
case sLet:
case sLetStar:
case sLetrec: {
complexFormSeen = true;
if (cadr(ccForm) instanceof LambdaJSymbol) break;
final ConsCell ccBodyForms = (ConsCell)cddr(ccForm);
globalEnv = toplevelLetBody(ret, globals, globalEnv, ccBodyForms, 1);
bodyForms.add(ccForm);
return globalEnv;
}
case sMultipleValueBind: {
complexFormSeen = true;
final ConsCell ccBodyForms = (ConsCell)cdddr(ccForm);
globalEnv = toplevelLetBody(ret, globals, globalEnv, ccBodyForms, 1);
bodyForms.add(ccForm);
return globalEnv;
}
case sLoad: {
final ConsCell ccArgs = listOrMalformed(LOAD, cdr(ccForm));
oneArg(LOAD, ccArgs);
// todo unschoener hack
if (ccForm instanceof SExpConsCell) intp.currentSource = ((SExpConsCell)ccForm).path();
globalEnv = loadFile(LOAD, ret, car(ccArgs), globalEnv, bodyForms, globals);
return globalEnv;
}
case sRequire: {
final ConsCell ccArgs = listOrMalformed(REQUIRE, cdr(ccForm));
varargs1_2(REQUIRE, ccArgs);
if (!stringp(car(ccArgs))) errorMalformed(REQUIRE, "a string argument", ccArgs);
final Object modName = car(ccArgs);
if (!intp.modules.contains(modName)) {
Object modFilePath = cadr(ccArgs);
if (modFilePath == null) modFilePath = modName;
if (ccForm instanceof SExpConsCell) {
final SExpConsCell sExpConsCell = (SExpConsCell)ccForm;
intp.currentSource = sExpConsCell.path();
} // todo unschoener hack
globalEnv = loadFile(REQUIRE, ret, modFilePath, globalEnv, bodyForms, globals);
if (!intp.modules.contains(modName)) errorMalformedFmt(REQUIRE, "require'd file '%s' does not provide '%s'", modFilePath, modName);
}
return globalEnv;
}
case sProvide: {
final ConsCell ccArgs = listOrMalformed(PROVIDE, cdr(ccForm));
oneArg(PROVIDE, ccArgs);
if (!stringp(car(ccArgs))) errorMalformed(PROVIDE, "a string argument", ccArgs);
final Object modName = car(ccArgs);
intp.modules.add(modName);
return globalEnv;
}
case sDeclaim: {
intp.evalDeclaim(1, (ConsCell)cdr(ccForm)); // cast is safe because expandForm will fail on dotted forms
bodyForms.add(ccForm);
return globalEnv;
}
default:
complexFormSeen = true;
break;
}
if (null != ((LambdaJSymbol)op).macro) {
errorInternal("unexpected unexpanded macrocall: %s", printSEx(form));
}
}
}
bodyForms.add(form);
return globalEnv;
}
/** process the bodyforms of a toplevel labels/ let/ let* / letrec/ multiple-value-bind */
private ConsCell toplevelLetBody(WrappingWriter ret, StringBuilder globals, ConsCell globalEnv, ConsCell ccBodyForms, int rsfx) {
if (ccBodyForms != null) for (Object letbodyform : ccBodyForms) {
if (consp(letbodyform)) globalEnv = toplevelLet(ret, globals, globalEnv, (ConsCell)letbodyform, rsfx+1);
}
return globalEnv;
}
/** process one bodyform of a toplevel labels/ let/ let* / letrec/ multiple-value-bind */
private ConsCell toplevelLet(WrappingWriter ret, StringBuilder globals, ConsCell globalEnv, ConsCell ccForm, int rsfx) {
containingForm = ccForm;
final Object op = car(ccForm);
if (symbolp(op)) switch (((LambdaJSymbol)op).wellknownSymbol) {
case sDefine:
case sDefun:
final Object symbol = cadr(ccForm);
globalEnv = defineToJava(ret, ConsCell.list(sDefine, symbol, null), globalEnv, rsfx);
globals.append(" case \"").append(symbol).append("\": return ").append(javasym(symbol, globalEnv)).append(";\n");
break;
case sLabels:
return toplevelLetBody(ret, globals, globalEnv, (ConsCell)cddr(ccForm), rsfx+1);
case sLet:
case sLetStar:
case sLetrec:
final Object maybeBindings = cadr(ccForm);
if (listp(maybeBindings)) return toplevelLetBody(ret, globals, globalEnv, (ConsCell)cddr(ccForm), rsfx+1);
break;
case sMultipleValueBind:
return toplevelLetBody(ret, globals, globalEnv, (ConsCell)cdddr(ccForm), rsfx+1);
case sProgn:
return toplevelLetBody(ret, globals, globalEnv, (ConsCell)cdr(ccForm), rsfx + 1);
}
return globalEnv;
}
/** Emit a member for {@code symbol} and a function that assigns {@code form} to {@code symbol}.
* @param form a list (define symbol form) */
private ConsCell defineToJava(WrappingWriter sb, ConsCell form, ConsCell env, int rsfx) {
varargs1_2(DEFINE, listOrMalformed(DEFINE, cdr(form)));
final LambdaJSymbol symbol = LambdaJ.symbolOrMalformed(DEFINE, cadr(form));
notDefined(DEFINE, symbol, env);
globalDecl.add(symbol);
final String javasym = mangle(symbol.toString(), rsfx);
env = extenvIntern(symbol, javasym + ".get()", env);
if (complexFormSeen) {
sb.append(" // ").append(form.lineInfo()).append("(define ").append(symbol).append(" ...)\n"
+ " public CompilerGlobal ").append(javasym).append(" = UNASSIGNED_GLOBAL;\n");
if (rsfx > 0) {
sb.append("\n");
return env;
}
final boolean isComplex = consp(caddr(form)) && car(caddr(form)) != sQuote;
sb.append(" private Object define").append(javasym).append("() {\n");
if (isComplex) {
emitClearValues(sb, form);
sb.append(" try {\n"
+ " ").append(javasym).append(" = new CompilerGlobal(");
emitForm(sb, caddr(form), env, env, 0, false);
sb.append(");\n }\n"
+ " catch (Exception e) { rterror(e); }\n");
}
else {
emitLoc(sb, form, 40);
sb.append(" ").append(javasym).append(" = new CompilerGlobal(");
emitForm(sb, caddr(form), env, env, 0, false);
sb.append(");\n");
}
sb.append(" return intern(\"").append(symbol).append("\");\n"
+ " }\n\n");
}
else {
sb.append(" public CompilerGlobal ").append(javasym).append(" = new CompilerGlobal(");
emitForm(sb, caddr(form), env, env, 0, false);
sb.append(");\n\n");
}
return env;
}
private void emitClearValues(WrappingWriter sb, ConsCell form) {
emitClearValues(sb);
emitLoc(sb, form, 40);
}
private static void emitClearValues(WrappingWriter sb) {
sb.append(" clrValues();\n");
}
private void emitLoc(WrappingWriter sb, ConsCell form, int maxlen) {
if (intp.debug == 0) sb.append(" // loc = \"");
else sb.append(" loc = \"");
stringToJava(sb, form.lineInfo(), -1);
stringToJava(sb, printSEx(form), maxlen);
sb.append("\";\n");
}
/** @param form a list (defun symbol ((symbol...) forms...)) */
private ConsCell defunToJava(WrappingWriter sb, ConsCell form, ConsCell topEnv) {
final ConsCell symbolParamsAndForms = (ConsCell)cdr(form);
final LambdaJSymbol symbol = LambdaJ.symbolOrMalformed(DEFUN, car(symbolParamsAndForms));
notDefined(DEFUN, symbol, topEnv);
globalDecl.add(symbol);
final Object params = cadr(symbolParamsAndForms);
final ConsCell body = (ConsCell)cddr(symbolParamsAndForms);
final String javasym = mangleFunctionName(symbol.toString(), 0);
sb.append(" // ").append(form.lineInfo()).append("(defun ").append(symbol).append(' ');
printSEx(sb::append, params);
sb.append(" forms...)\n");
if (complexFormSeen) {
sb.append(" public CompilerGlobal ").append(javasym).append(" = UNASSIGNED_GLOBAL;\n");
sb.append(" private LambdaJSymbol defun").append(javasym).append("() {\n");
emitLoc(sb, form, 40);
sb.append(" final MurmelFunction func = ");
emitNamedLambda(DEFUN, sb, symbol, params, body, extenvIntern(symbol, javasym, topEnv), topEnv, 0, true);
sb.append(";\n ");
sb.append(javasym).append(" = new CompilerGlobal(func);\n"
+ " return intern(\"").append(symbol).append("\");\n"
+ " }\n\n");
}
else {
sb.append(" public CompilerGlobal ").append(javasym).append(" = new CompilerGlobal(");
emitNamedLambda(DEFUN, sb, symbol, params, body, extenvIntern(symbol, javasym, topEnv), topEnv, 0, true);
sb.append(");\n\n");
}
return extenvIntern(symbol, javasym + ".get()", topEnv);
}
/** return false if {@code forms} doesn't contain any calls to other Murmel functions, true if there may be such calls, calls to {@code recur} are ignored */
private boolean callsMurmel(ConsCell forms, LambdaJSymbol recur) {
if (forms == null) return false;
for (Object form: forms) {
if (atom(form)) continue;
final ConsCell ccForm = (ConsCell)form;
final Object op = car(ccForm);
if (symbolp(op)) {
if (op != recur) {
if (op == sApply) return true; // todo naechstes symbol checken statt aufgeben
if (op == sEval) return true;
final WellknownSymbol ws = ((LambdaJSymbol)op).wellknownSymbol;
switch (ws) {
case sMultipleValueCall:
case interned:
case notInterned:
return true;
}
}
}
else if (consp(op)) {
if (callsMurmel((ConsCell)op, recur)) return true;
}
// todo bei named let sollte statt recur das looplabel uebergeben werden, bindings sollten gesondert gecheckt werden
// weil sonst wird der variablenname in einem binding als call missinterpretiert
if (callsMurmel((ConsCell)cdr(form), recur)) return true;
}
return false;
}
private String currentFunctionName = "_";
private void emitNamedLambda(String func, WrappingWriter sb, LambdaJSymbol symbol, Object params, ConsCell body, ConsCell env, ConsCell topEnv, int rsfx, boolean emitSelf) {
final String javasym = mangleFunctionName(symbol.toString(), rsfx);
final String prevName = currentFunctionName;
currentFunctionName = javasym + '_';
final String intf;
final boolean maybeRecursive;
if (callsMurmel(body, symbol)) {
//note(null, symbol + " may call Murmel");
intf = "MurmelFunction";
maybeRecursive = true;
}
else {
//note(null, symbol + " doesn't call Murmel");
intf = "MurmelLeafFunction";
maybeRecursive = callsMurmel(body, null);
emitSelf = maybeRecursive;
}
final int minParams, maxParams;
if (params == null) {
minParams = maxParams = 0;
}
else if (symbolp(params)) {
minParams = 0; maxParams = -1;
}
else if (dottedList(params)) {
minParams = listLength((ConsCell)params) - 1;
maxParams = -1;
}
else {
minParams = maxParams = listLength((ConsCell)params);
}
sb.append("new ").append(intf).append("() {\n");
if (emitSelf) sb.append(" private final ").append(intf).append(" ").append(javasym).append(" = this;\n");
sb.append(" public final Object apply(Object... args").append(rsfx).append(") {\n"
+ " return ").append(javasym).append("(args").append(rsfx).append(");\n }\n"
+ " private Object ").append(javasym).append("(Object[] args").append(rsfx).append(") {\n");
final ConsCell extenv = params(func, sb, params, env, rsfx, symbol.toString(), true);
if (cdr(body) == null) {
if (maybeRecursive) sb.append(" ").append(javasym).append(": while (true) {\n");
emitStmts(sb, body, extenv, topEnv, rsfx, " return ", symbol, "args" + rsfx, minParams, maxParams, false, false);
if (maybeRecursive) sb.append(" }\n");
}
else {
final String ret = "ret" + rsfx;
sb.append(" Object ").append(ret).append(";\n");
if (maybeRecursive) sb.append(" ").append(javasym).append(": while (true) {\n");
emitStmts(sb, body, extenv, topEnv, rsfx, " " + ret + " = ", symbol, "args" + rsfx, minParams, maxParams, false, false);
if (maybeRecursive) sb.append(" break;\n }\n");
sb.append(" return ").append(ret).append(";\n");
}
sb.append(" } }");
currentFunctionName = prevName;
}
/// emitToplevelForms - compile a list of Murmel forms to Java source
/** generate Java code for a list of forms. Each form but the last will be emitted as an assignment
* to the local variable "ignoredN" because some forms are emitted as ?: expressions which is not a valid statement by itself. */
private void emitToplevelForms(WrappingWriter sb, @NotNull Iterable forms, ConsCell env, ConsCell topEnv) {
final Iterator it = forms.iterator();
if (!it.hasNext()) {
emitClearValues(sb);
sb.append(" return null;\n");
return;
}
Object next = it.next();
if (it.hasNext()) {
final String retVar = "ignored" + 0;
final String retLhs = " " + retVar + " = ";
sb.append(" Object ").append(retVar).append(";\n");
do {
emitToplevelStmt(sb, next, env, topEnv, retLhs, true);
next = it.next();
} while (it.hasNext());
}
emitToplevelStmt(sb, next, env, topEnv, " return ", false);
}
private void emitStmts(WrappingWriter sb, ConsCell ccBody, ConsCell env, ConsCell topEnv, int rsfx, String retLhs, boolean toplevel, boolean hasNext) {
emitStmts(sb, ccBody, env, topEnv, rsfx, retLhs, null, null, -1, -1, toplevel, hasNext);
}
private void emitStmts(WrappingWriter sb, ConsCell ccBody, ConsCell env, ConsCell topEnv, int rsfx, String retLhs, LambdaJSymbol recur, String recurArgs, int minParams, int maxParams, boolean toplevel, boolean hasNext) {
rsfx++;
if (cdr(ccBody) == null) {
emitStmt(sb, car(ccBody), env, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, toplevel, hasNext, true);
return;
}
final String ignoredVar = "ignored" + rsfx;
final String lhs = " " + ignoredVar + " = ";
sb.append(" {\n Object ").append(ignoredVar).append(";\n");
do {
emitStmt(sb, car(ccBody), env, topEnv, rsfx, lhs, recur, recurArgs, minParams, maxParams, toplevel, true, true);
ccBody = (ConsCell)cdr(ccBody);
} while (cdr(ccBody) != null);
emitStmt(sb, car(ccBody), env, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, toplevel, hasNext, true);
sb.append(" }\n");
}
private void emitToplevelStmt(WrappingWriter sb, Object form, ConsCell env, ConsCell topEnv, String retLhs, boolean hasNext) {
emitStmt(sb, form, env, topEnv, 0, retLhs, null, null, -1, -1, true, hasNext, true);
}
private void emitStmt(WrappingWriter sb, Object form, ConsCell env, ConsCell topEnv, int rsfx, String retLhs, LambdaJSymbol recur, String recurArgs, int minParams, int maxParams, boolean toplevel, boolean hasNext, boolean clearValues) {
if (rsfx == 0) containingForm = null;
if (hasNext) {
if (atom(form)) {
if (form != null) noteDead(form); // don't note nil as that would generate a lot of notes for e.g. "(if a nil (dosomething))"
return; // must be dead code
}
containingForm = (ConsCell)form;
if (car(form) == sQuote) {
noteDead(form);
return; // must be dead code
}
if (symbolEq(car(form), DECLAIM)) {
intp.evalDeclaim(1, (ConsCell)cdr(form)); // cast is safe because expandForm will fail on dotted forms
return; // ignore return value, must be dead code
}
}
if (atom(form)) {
if (clearValues) emitClearValues(sb);
sb.append(retLhs);
if (form != null) emitForm(sb, form, env, topEnv, rsfx, !toplevel && !hasNext);
else sb.append("null"); // emitForm() emits "(Object)null", this avoids lots of unneeded casts
sb.append(";\n");
return;
}
final ConsCell ccForm = (ConsCell)form;
containingForm = ccForm;
final Object op = car(ccForm); // first element of the of the form should be a symbol or a form that computes a symbol
assert op != null && op != sNil : "not a function: nil - should have been caught by expandForm()";
final ConsCell ccArguments = listOrMalformed("emitStmt", cdr(ccForm)); // list with remaining atoms/ forms
final LambdaJSymbol symop;
final WellknownSymbol ws;
final boolean isDefOrLet, isStmtExpr;
if (symbolp(op)) {
symop = (LambdaJSymbol)op;
ws = symop.wellknownSymbol;
isDefOrLet = ws == WellknownSymbol.sDefine || ws == WellknownSymbol.sDefun || ws == WellknownSymbol.sDefmacro
|| ws == WellknownSymbol.sLet || ws == WellknownSymbol.sLetStar || ws == WellknownSymbol.sLetrec;
// whether a form needs to be preceeded by "values = null;" and "... = ".
// This is needed before some special forms (?) and before some primitives that will be opencoded in a special way
isStmtExpr = isDefOrLet || !needsClrValues(symop);
}
else {
symop = null; ws = null; isDefOrLet = isStmtExpr = false;
}
if (clearValues) {
if (!isStmtExpr) emitClearValues(sb);
if (!isDefOrLet) emitLoc(sb, ccForm, 100);
}
if (symop != null) {
switch (ws) {
/// * special forms:
/// - quote
case sQuote: break;
case sIf: {
sb.append(" if (");
emitTruthiness(sb, false, car(ccArguments), env, topEnv, rsfx, false);
sb.append(") {\n");
emitStmt(sb, cadr(ccArguments), env, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, toplevel, hasNext, false);
sb.append(" }\n");
if (caddr(ccArguments) != null) {
sb.append(" else {\n");
emitStmt(sb, caddr(ccArguments), env, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, toplevel, hasNext, false);
sb.append(" }\n");
}
else if (!hasNext) {
sb.append(" else {\n").append(retLhs).append("null;\n }\n");
}
return;
}
case sCond: {
boolean first = true;
for (final Iterator iterator = ccArguments.iterator(); iterator.hasNext(); ) {
final Object clause = iterator.next();
sb.append(" ");
if (first) first = false;
else sb.append("else ");
final Object condExpr = car(clause);
final ConsCell condForms = (ConsCell)cdr(clause);
final boolean moreCondForms = cdr(condForms) != null;
if (condExpr == sT) {
if (condForms == null) sb.append(retLhs).append("_t;\n");
else {
sb.append("{\n");
emitStmt(sb, car(condForms), env, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, toplevel, moreCondForms || hasNext, false);
if (moreCondForms) emitStmts(sb, (ConsCell)cdr(condForms), env, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, toplevel, hasNext);
sb.append(" }\n");
}
if (iterator.hasNext()) note("forms following default 't' form will be ignored");
return;
}
else if (condForms != null) {
sb.append("if ("); emitTruthiness(sb, false, condExpr, env, topEnv, rsfx, false); sb.append(") {\n");
emitStmt(sb, car(condForms), env, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, toplevel, moreCondForms || hasNext, false);
if (moreCondForms) emitStmts(sb, (ConsCell)cdr(condForms), env, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, toplevel, hasNext);
sb.append(" }\n");
}
else {
sb.append("if ("); emitTruthiness(sb, false, condExpr, env, topEnv, rsfx, true); sb.append(") ");
sb.append(retLhs).append("rt().getRc();\n");
}
}
if (!hasNext) sb.append(" else ").append(retLhs).append("null;\n");
return;
}
case sCatch: {
sb.append(" try {\n");
emitStmts(sb, (ConsCell)cdr(ccArguments), env, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, true, hasNext);
sb.append(" }\n"
+ " catch (Exception e) {\n");
if (hasNext) sb.append(" ");
else sb.append(retLhs);
sb.append("catchHelper("); emitForm(sb, car(ccArguments), env, topEnv, rsfx, false); sb.append(", e);\n }\n");
return;
}
case sSetQ: {
if (ccArguments == null) {
if (!hasNext) sb.append(retLhs).append("null;\n");
}
else {
for (Object pairs = ccArguments; pairs != null; pairs = cddr(pairs)) {
if (hasNext || cddr(pairs) != null) sb.append(" ");
else sb.append(retLhs);
final boolean needsClrValues = !hasNext && cddr(pairs) == null; // the last assignment may need clrValues()
emitSetq(sb, pairs, env, topEnv, rsfx, needsClrValues);
sb.append(";\n");
}
}
return;
}
case sProgn: {
final ConsCell ccBody = listOrMalformed(PROGN, cdr(ccForm));
emitStmts(sb, ccBody, env, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, toplevel, hasNext);
return;
}
case sLet:
case sLetStar:
case sLetrec: {
final Object bindings = cadr(ccForm);
if (bindings instanceof LambdaJSymbol) {
if (clearValues) {
emitLoc(sb, ccForm, 100);
}
break;
}
assert bindings != null : "let w/o bindings should have been replaced in expandForm";
rsfx++;
final ConsCell ccBindings = listOrMalformed(symop.name, bindings);
final ConsCell ccBody = listOrMalformed(symop.name, cddr(ccForm));
final boolean asRunnable = hasNext && toplevel;
if (asRunnable) {
sb.append(" new Runnable() { public void run() {\n"
+ " Object tmp = null;\n");
retLhs = " tmp = ";
}
else sb.append(" {\n");
if (clearValues) {
emitLoc(sb, ccForm, 100);
}
final String vName = "v" + rsfx;
final int nVars = listLength(ccBindings);
sb.append(" final Object[] ").append(vName);
if (symop.wellknownSymbol == WellknownSymbol.sLetrec) sb.append(" = unassigned(").append(nVars).append(");\n");
else sb.append(" = new Object[").append(nVars).append("];\n");
ConsCell letrecEnv = env;
if (symop.wellknownSymbol == WellknownSymbol.sLetrec) {
int localCtr = 0;
for (Object binding : ccBindings) {
final ConsCell ccBinding = (ConsCell)binding;
final Object sym = car(ccBinding);
final String name = vName + '[' + localCtr++ + ']';
letrecEnv = extenvIntern((LambdaJSymbol)sym, name, letrecEnv);
}
}
ConsCell extEnv = env;
ConsCell letStarEnv = env;
int localCtr = 0;
final ArrayList varNames = new ArrayList<>(nVars);
for (Object binding : ccBindings) {
final ConsCell ccBinding = (ConsCell)binding;
containingForm = ccBinding;
final Object sym = car(ccBinding);
if (!varNames.contains(sym)) {
varNames.add(sym);
final String name = vName + '[' + localCtr++ + ']';
extEnv = extenvIntern((LambdaJSymbol)sym, name, extEnv);
}
final ConsCell env1 = symop.wellknownSymbol == WellknownSymbol.sLet ? env : symop.wellknownSymbol == WellknownSymbol.sLetStar ? letStarEnv : letrecEnv;
if (cadr(ccBinding) != null) emitStmt(sb, cadr(ccBinding), env1, topEnv, rsfx, " " + javasym(sym, extEnv) + " = ", null, null, -1, -1, true, false, false);
letStarEnv = extEnv;
}
if (asRunnable) {
emitStmts(sb, ccBody, extEnv, topEnv, rsfx, retLhs, toplevel, hasNext);
sb.append(" } }.run();\n");
}
else {
emitStmts(sb, ccBody, extEnv, topEnv, rsfx, retLhs, recur, recurArgs, minParams, maxParams, toplevel, hasNext);
sb.append(" }\n");
}
return;
}
case sMultipleValueBind: {
ConsCell extenv = env;
final Object varDef = car(ccArguments);
assert varDef != null;
rsfx++;
final String prim = "prim" + rsfx;
sb.append(" {\n Object ").append(prim).append(";\n");
emitStmt(sb, cadr(ccArguments), env, topEnv, rsfx + 1, " " + prim + " = ", null, null, -1, -1, true, false, true);
int n = 0;
if (consp(varDef)) {
final ConsCell varList = (ConsCell)varDef;
for (Object arg : varList) {
extenv = extenvIntern(symbolOrMalformed(MULTIPLE_VALUE_BIND, arg), "mv" + rsfx + '[' + n++ + ']', extenv);
}
if (dottedList(varList))
sb.append(" Object mv").append(rsfx).append("[] = mvVarargs(").append(prim).append(", ").append(n).append(");\n");
else
sb.append(" Object mv").append(rsfx).append("[] = mv(").append(prim).append(", ").append(n).append(");\n");
}
else if (symbolp(varDef)) {
extenv = extenvIntern((LambdaJSymbol)varDef, "mv" + rsfx + "[0]", extenv);
sb.append(" Object mv").append(rsfx).append("[] = mvVarargs(").append(prim).append(", 1);\n");
}
else throw errorMalformedFmt(MULTIPLE_VALUE_BIND, "expected a list or a symbol but got %s", printSEx(varDef));
// emit the body
emitStmts(sb, (ConsCell)cddr(ccArguments), extenv, topEnv, rsfx, retLhs, toplevel, hasNext);
sb.append(" }\n");
return;
}
case sDefine:
case sDefun: {
final LambdaJSymbol symbol = (LambdaJSymbol)car(ccArguments);
if (rsfx == 0 || fastassq(symbol, topEnv) == null) {
if (hasNext) {
sb.append(" ");
emitForm(sb, form, env, topEnv, rsfx, false);
sb.append(";\n");
return;
}
break;
}
emitLoc(sb, ccForm, 40);
final String javasym = mangleFunctionName(symbol.toString(), rsfx);
sb.append(" ").append(javasym).append(" = new CompilerGlobal(");
if (ws == WellknownSymbol.sDefine) emitForm(sb, cadr(ccArguments), env, topEnv, rsfx, false);
else emitNamedLambda(DEFUN, sb, symbol, cadr(ccArguments), (ConsCell)cddr(ccArguments), extenvIntern(symbol, javasym, env), topEnv, rsfx, true);
sb.append(");\n");
if (!hasNext) sb.append(retLhs).append("intern(\"").append(symbol).append("\");\n");
return;
}
case sDefmacro: {
if (hasNext) {
intp.expandForm(form, macroEnv); // this will process the macro definition as a side effect in case macroexpand-1 was used
return;
}
break;
}
default: break;
}
}
if (!hasNext && minParams == maxParams && recur != null && recur == symop) {
final int nArgs = listLength(ccArguments);
try { if (nArgs != minParams) errorArgCount(printSEx(recur).toString(), minParams, maxParams, nArgs, form); }
catch (Exception e) { throw new LambdaJError(e, form); }
if (nArgs > 0) {
sb.append(" {\n");
ConsCell args = ccArguments;
for (int i = 0; i < nArgs; ++i) {
sb.append(" final Object tmp").append(i).append(" = ");
emitForm(sb, car(args), env, topEnv, rsfx+1, false);
sb.append(";\n");
args = (ConsCell)cdr(args);
}
for (int i = 0; i < nArgs; ++i) {
sb.append(" ").append(recurArgs).append('[').append(i).append("] = tmp").append(i).append(";\n");
}
sb.append(" }\n");
}
sb.append(" continue;\n");
return;
}
if (hasNext && isStmtExpr) sb.append(" ");
else sb.append(retLhs);
emitForm(sb, form, env, topEnv, rsfx, !toplevel && !hasNext);
sb.append(";\n");
}
/// emitForm - compile a Murmel form to Java source. Note how this is somehow similar to eval:
private void emitForm(WrappingWriter sb, Object form, ConsCell env, ConsCell topEnv, int rsfx, boolean isLast) {
final LambdaJ intp = this.intp;
rsfx++;
try {
/// * symbols
if (symbolp(form)) {
sb.append(javasym(form, env)); return;
}
/// * atoms that are not symbols
if (atom(form)) {
emitAtom(sb, form); return;
}
assert consp(form);
final ConsCell ccForm = (ConsCell)form;
containingForm = ccForm;
final Object op = car(ccForm); // first element of the of the form should be a symbol or a form that computes a symbol
assert op != null && op != sNil : "not a function: nil - should have been caught by expandForm()";
final ConsCell ccArguments = listOrMalformed("emitForm", cdr(ccForm)); // list with remaining atoms/ forms
if (symbolp(op)) {
final LambdaJSymbol symop = (LambdaJSymbol)op;
switch (symop.wellknownSymbol) {
/// * special forms:
/// - quote
case sQuote: {
emitQuotedForm(sb, car(ccArguments), true);
return;
}
/// - if
case sIf: {
sb.append('(');
emitTruthiness(sb, false, car(ccArguments), env, topEnv, rsfx, false);
sb.append("\n ? ("); emitForm(sb, cadr(ccArguments), env, topEnv, rsfx, isLast);
if (caddr(ccArguments) != null) { sb.append(")\n : ("); emitForm(sb, caddr(ccArguments), env, topEnv, rsfx, isLast); sb.append("))"); }
else sb.append(")\n : (Object)null)");
return;
}
/// - cond
case sCond: {
emitCond(sb, ccArguments, env, topEnv, rsfx, isLast);
return;
}
/// eval - (catch tagform forms...) -> object
case sCatch: {
emitCatch(sb, ccArguments, env, topEnv, rsfx);
return;
}
/// eval - (throw tagform resultform) -> |
case sThrow: {
emitThrow(sb, ccArguments, env, topEnv, rsfx);
return;
}
/// try - (try protected-form . errorobj) -> result
case sTry: {
emitTry(sb, ccArguments, env, topEnv, rsfx);
return;
}
/// - lambda
case sLambda: {
emitLambda(sb, ccArguments, env, topEnv, rsfx, true);
return;
}
case sLambdaDynamic: {
errorNotImplemented(LAMBDA_DYNAMIC + " is not supported in compiled Murmel");
//NOTREACHED
}
/// - setq
case sSetQ: {
if (ccArguments == null) sb.append("(Object)null"); // must cast to Object in case it will be used as the only argument to a vararg function
else if (cddr(ccArguments) == null)
emitSetq(sb, ccArguments, env, topEnv, rsfx, true);
else {
sb.append("((Supplier)(() -> {\n");
String javaName = null;
for (Object pairs = ccArguments; pairs != null; pairs = cddr(pairs)) {
sb.append(" ");
javaName = emitSetq(sb, pairs, env, topEnv, rsfx - 1, true);
sb.append(";\n");
}
sb.append(" return ").append(javaName).append(";})).get()");
}
return;
}
case sDefine: {
if (rsfx != 1) errorNotImplemented("define as non-toplevel form is not implemented");
defined(DEFINE, car(ccArguments), env);
final String javasym = mangle(car(ccArguments).toString(), 0);
sb.append("define").append(javasym).append("()");
return;
}
case sDefun: {
if (rsfx != 1) errorNotImplemented("defun as non-toplevel form is not implemented");
defined(DEFUN, car(ccArguments), env);
final String javasym = mangle(car(ccArguments).toString(), 0);
sb.append("defun").append(javasym).append("()");
return;
}
case sDefmacro: {
if (rsfx != 1) errorNotImplemented("defmacro as non-toplevel form is not implemented");
intp.expandForm(form, macroEnv); // this will process the macro definition as a side effect in case macroexpand-1 was used
sb.append("intern(\"").append(car(ccArguments)).append("\")");
return;
}
/// - progn
case sProgn: {
emitProgn(sb, ccArguments, env, topEnv, rsfx, isLast);
return;
}
/// - unwind-protect
case sUnwindProtect: {
emitUnwindProtect(sb, ccArguments, env, topEnv, rsfx, isLast);
return;
}
/// - labels: (labels ((symbol (params...) forms...)...) forms...) -> object
// note how labels is similar to let: let binds values to symbols, labels binds functions to symbols
case sLabels: {
emitLabels(sb, ccArguments, env, topEnv, rsfx, isLast);
return;
}
/// - let: (let ((sym form)...) forms...) -> object
/// - named let: (let sym ((sym form)...) forms...) -> object
case sLet: {
if (car(ccArguments) == intp.sDynamic)
emitLetLetStarDynamic(sb, (ConsCell)cdr(ccArguments), env, topEnv, rsfx, false, isLast);
else
emitLet(sb, ccArguments, env, topEnv, rsfx, isLast);
return;
}
/// - let*: (let* ((sym form)...) forms...) -> Object
/// - named let*: (let sym ((sym form)...) forms...) -> Object
case sLetStar: {
if (car(ccArguments) == intp.sDynamic)
emitLetLetStarDynamic(sb, (ConsCell)cdr(ccArguments), env, topEnv, rsfx, true, isLast);
else
emitLetStarLetrec(sb, ccArguments, env, topEnv, rsfx, false, isLast);
return;
}
/// - letrec: (letrec ((sym form)...) forms) -> Object
/// - named letrec: (letrec sym ((sym form)...) forms) -> Object
case sLetrec: {
emitLetStarLetrec(sb, ccArguments, env, topEnv, rsfx, true, isLast);
return;
}
case sMultipleValueCall: {
sb.append(isLast ? "tailcall(" : "funcall(");
emitForm(sb, car(ccArguments), env, topEnv, rsfx, false);
if (cdr(ccArguments) != null) {
sb.append(", rt().new ValuesBuilder()");
for (Object arg : listOrMalformed(MULTIPLE_VALUE_CALL, cdr(ccArguments))) {
sb.append("\n .add(");
emitForm(sb, arg, env, topEnv, rsfx, false);
sb.append(')');
}
sb.append("\n .build()");
}
else sb.append(", NOARGS");
sb.append(')');
return;
}
/// - multiple-value-bind: (multiple-value-bind (var*) value-form forms)
case sMultipleValueBind: {
final Object vars = car(ccArguments);
int length;
final boolean varargs;
if (consp(vars)) {
varargs = dottedList(vars);
length = listLength((ConsCell)vars);
if (varargs) length--;
}
else if (symbolp(vars)) {
varargs = true;
length = 0;
}
else throw errorMalformedFmt(MULTIPLE_VALUE_BIND, "expected a list or a symbol but got %s", printSEx(vars));
sb.append(isLast ? "tailcall(" : "funcall(");
emitLambda(sb, cons(vars, cddr(ccArguments)), env, topEnv, rsfx, false);
if (cadr(ccArguments) != null) {
sb.append(", rt().new ValuesBuilder()\n .add(");
emitForm(sb, cadr(ccArguments), env, topEnv, rsfx, false);
sb.append(")\n .build(").append(length).append(',').append(String.valueOf(!varargs)).append(')');
}
else sb.append(", NOARGS");
sb.append(')');
return;
}
case sLoad: {
// pass1 has replaced all toplevel (load)s with the file contents
throw errorNotImplemented(LOAD + " as non-toplevel form is not implemented");
}
case sRequire: {
// pass1 has replaced all toplevel (require)s with the file contents
throw errorNotImplemented(REQUIRE + " as non-toplevel form is not implemented");
}
case sProvide: {
// pass 2 shouldn't see this
throw errorNotImplemented(PROVIDE + " as non-toplevel form is not implemented");
}
case sDeclaim: {
intp.evalDeclaim(rsfx, ccArguments);
sb.append("(Object)null");
return;
}
default:
/// * macro expansion - all macros were already expanded
if (null != symop.macro) errorNotAFunction("function application: not a primitive or " + LAMBDA + ": %s is a macro not a function", symop.toString());
/// * special case (hack) for calling macroexpand-1: only quoted forms are supported which can be performed a compile time
if (symbolEq(symop, "macroexpand-1")) {
oneArg("macroexpand-1", ccArguments);
if (!consp(car(ccArguments)) || caar(ccArguments) != sQuote) errorNotImplemented("general macroexpand-1 is not implemented, only quoted forms are: (macroexpand-1 '...");
final Object expandedForm, expanded;
final Object maybeMacroCall = car((ConsCell)cdar(ccArguments));
if (consp(maybeMacroCall)) { expandedForm = macroexpandImpl(intp, (ConsCell)maybeMacroCall, null); expanded = cadr(intp.values) == sT ? "rt()._t" : "null"; }
else { expandedForm = maybeMacroCall; expanded = "null"; }
sb.append("rt()._values("); emitQuotedForm(sb, expandedForm, true); sb.append(", ").append(expanded).append(')');
return;
}
/// * some functions and operators are opencoded:
if (intp.speed >= 1 && opencode(sb, symop, ccArguments, env, topEnv, rsfx, isLast)) return;
}
}
if (intp.speed >= 1 && consp(op) && car(op) == sJmethod
&& emitJmethod(sb, listOrMalformed(JMETHOD + " application", cdr(op)), env, topEnv, rsfx, true, ccArguments)) {
return;
}
/// * function call
sb.append(isLast ? "tailcall(" : "funcall(");
emitForm(sb, op, env, topEnv, rsfx, false);
if (ccArguments != null) {
for (Object arg: ccArguments) {
sb.append(ARGSEP);
emitForm(sb, arg, env, topEnv, rsfx, false);
}
}
else sb.append(", NOARGS");
sb.append(')');
}
catch (ArithmeticException | ClassCastException | IndexOutOfBoundsException | LambdaJError e) {
throw new LambdaJError(e, form);
}
catch (Exception e) {
//e.printStackTrace();
throw errorInternal(e, "emitForm: caught exception %s: %s", e.getClass().getName(), e.getMessage(), form); // convenient breakpoint for errors
}
}
private void emitTruthiness(WrappingWriter sb, boolean negate, Object form, ConsCell env, ConsCell topEnv, int rsfx, boolean setRc) {
final String jTrue, jFalse, isNotNull, maybeBang, pfx, sfx;
if (negate) { jTrue = "false"; jFalse = "true"; isNotNull = " == null"; maybeBang = "!"; }
else { jTrue = "true"; jFalse = "false"; isNotNull = " != null"; maybeBang = ""; }
if (setRc) { pfx = "setRc("; sfx = ")"; }
else { pfx = sfx = ""; }
if (form == null || form == sNil) { sb.append(pfx).append(jFalse).append(sfx); return; }
if (form == sT) { sb.append(pfx).append(jTrue).append(sfx); return; }
if (symbolp(form)) { sb.append(pfx); emitForm(sb, form, env, topEnv, rsfx, false); sb.append(sfx).append(isNotNull); return; }
if (atom(form)) { sb.append(pfx).append(jTrue).append(sfx); return; } // must be an atom other than nil, t or a symbol -> true. Todo note wg. constant condition?
final ConsCell ccForm = (ConsCell)form;
final ConsCell ccArgs = (ConsCell)cdr(ccForm);
final WellknownSymbol ws = intp.speed >= 1 && symbolp(car(ccForm)) ? ((LambdaJSymbol)car(ccForm)).wellknownSymbol : null;
if (ws == WellknownSymbol.sNull) {
// optimize "(null ..."
emitTruthiness(sb, !negate, car(ccArgs), env, topEnv, rsfx, setRc);
return;
}
final boolean clr = !singleValueForm(form);
if (clr) sb.append("clrValues(");
if (ws == WellknownSymbol.sEq) { sb.append(maybeBang); sb.append(pfx); emitEq(sb, false, car(ccArgs), cadr(ccArgs), env, topEnv, rsfx); sb.append(sfx); }
else if (ws == WellknownSymbol.sLt && emitBinOp(sb, false, setRc, negate ? ">=" : "<", ccArgs, env, topEnv, rsfx)) { /* emitBinOp did all as a sideeffect */ }
else if (ws == WellknownSymbol.sNe && emitBinOp(sb, false, setRc, negate ? "==" : "!=", ccArgs, env, topEnv, rsfx)) { /* emitBinOp did all as a sideeffect */ }
else if (ws == WellknownSymbol.sLe && emitBinOp(sb, false, setRc, negate ? ">" : "<=", ccArgs, env, topEnv, rsfx)) { /* emitBinOp did all as a sideeffect */ }
else if (ws == WellknownSymbol.sNeq && emitBinOp(sb, false, setRc, negate ? "!=" : "==", ccArgs, env, topEnv, rsfx)) { /* emitBinOp did all as a sideeffect */ }
else if (ws == WellknownSymbol.sGe && emitBinOp(sb, false, setRc, negate ? "<" : ">=", ccArgs, env, topEnv, rsfx)) { /* emitBinOp did all as a sideeffect */ }
else if (ws == WellknownSymbol.sGt && emitBinOp(sb, false, setRc, negate ? "<=" : ">", ccArgs, env, topEnv, rsfx)) { /* emitBinOp did all as a sideeffect */ }
else if (ws == WellknownSymbol.sIf) {
sb.append('(');
emitTruthiness(sb, negate, car(ccArgs), env, topEnv, rsfx, setRc);
sb.append(" ? ");
emitTruthiness(sb, negate, cadr(ccArgs), env, topEnv, rsfx, setRc);
sb.append(" : ");
emitTruthiness(sb, negate, caddr(ccArgs), env, topEnv, rsfx, setRc);
sb.append(')');
}
else { sb.append('(').append(pfx); emitForm(sb, ccForm, env, topEnv, rsfx, false); sb.append(sfx).append(")").append(isNotNull); }
if (clr) sb.append(")");
}
/** return true if form won't set multiple values, false if form may set multiple values */
private boolean singleValueForm(Object form) {
if (atom(form)) return true;
final ConsCell ccForm = (ConsCell)form;
if (car(ccForm) == sQuote) return true;
final ConsCell ccArgs = (ConsCell)cdr(ccForm);
final Object lhs = car(ccArgs), rhs = cadr(ccArgs);
final WellknownSymbol ws = intp.speed >= 1 && symbolp(car(ccForm)) ? ((LambdaJSymbol)car(ccForm)).wellknownSymbol : null;
if (ws != null && ws.singleValues)
return true;
if (cdr(ccArgs) != null && cddr(ccArgs) == null && singleValueForm(lhs) && singleValueForm(rhs)) {
// exactly two args that are both atoms or quoted forms
if (ws == WellknownSymbol.sEq || ws == WellknownSymbol.sLt || ws == WellknownSymbol.sNe || ws == WellknownSymbol.sLe || ws == WellknownSymbol.sNeq || ws == WellknownSymbol.sGe || ws == WellknownSymbol.sGt) {
return true;
}
}
return ws == WellknownSymbol.sIf && singleValueForm(rhs) && singleValueForm(caddr(ccArgs));
}
/** write atoms that are not symbols (and "nil" is acceptable, too) */
private void emitAtom(WrappingWriter sb, Object form) {
if (form == null || form == sNil) sb.append("(Object)null");
else if (form instanceof Integer) sb.append(Integer.toString((Integer) form));
else if (form instanceof Long) sb.append(Long.toString((Long) form)).append('L');
else if (form instanceof Double) sb.append(Double.toString((Double) form));
else if (form instanceof Character) {
final char c = (Character) form;
switch (c) {
case '\'': sb.append("'\\''"); break;
case '\\': sb.append("'\\\\'"); break;
case '\r': sb.append("'\\r'"); break;
case '\n': sb.append("'\\n'"); break;
case '\t': sb.append("'\\t'"); break;
default:
if (c >= 32 && c < 127) sb.append('\'').append(c).append('\'');
else sb.append(String.format("'\\u%04X'", (int)c));
}
}
//else if (form instanceof String) sb.append("new String(\"").append(form).append("\")"); // new Object so that (eql "a" "a") is nil (Common Lisp allows both nil and t). otherwise the reader must intern strings as well
else if (vectorp(form)) emitVectorLiteral(sb, form);
else if (hashtablep(form)) emitHashLiteral(sb, form);
else errorInternal("emitAtom: atom %s is not implemented", form.toString());
}
private static void stringToJava(WrappingWriter sb, CharSequence s, int maxlen) {
if (s == null) { sb.append("null"); return; }
if (s.length() == 0) { sb.append(""); return; }
final int length = s.length();
for (int i = 0; i < length; i++) {
if (maxlen > 0 && i == maxlen) { sb.append("..."); return; }
final char c = s.charAt(i);
switch (c) {
case '\"': sb.append("\\\""); break;
case '\\': sb.append("\\\\"); break;
case '\r': sb.append("\\r"); break;
case '\n': sb.append("\\n"); break;
case '\t': sb.append("\\t"); break;
default:
if (c >= 32 && c < 127) sb.append(c);
else sb.append(String.format("\\u%04X", (int)c));
}
}
}
private void emitCond(WrappingWriter sb, ConsCell condForm, ConsCell env, ConsCell topEnv, int rsfx, boolean isLast) {
if (condForm == null) {
sb.append("(Object)null");
}
else {
containingForm = condForm;
sb.append('(');
boolean first = true;
for (final Iterator iterator = condForm.iterator(); iterator.hasNext(); ) {
final Object clause = iterator.next();
if (first) first = false;
else sb.append("\n : ");
final Object condExpr = car(clause), condForms = cdr(clause);
if (condExpr == sT) {
if (condForms == null) sb.append("_t");
else emitProgn(sb, condForms, env, topEnv, rsfx, isLast);
sb.append(')');
if (iterator.hasNext()) note("forms following default 't' form will be ignored");
return;
}
else if (condForms != null) {
emitTruthiness(sb, false, condExpr, env, topEnv, rsfx, false);
sb.append("\n ? (");
emitProgn(sb, condForms, env, topEnv, rsfx, isLast);
sb.append(')');
}
else {
emitTruthiness(sb, false, condExpr, env, topEnv, rsfx, true);
sb.append("\n ? rt().getRc()");
}
}
sb.append("\n : (Object)null)");
}
}
/** paramsAndForms = ((sym...) form...) */
private void emitLambda(WrappingWriter sb, final ConsCell paramsAndForms, ConsCell env, ConsCell topEnv, int rsfx, boolean argCheck) {
sb.append("(MurmelFunction)(args").append(rsfx).append(" -> {\n");
final Object params = car(paramsAndForms);
final String expr = "(lambda " + printSEx(params) + " ...)";
env = params(LAMBDA, sb, params, env, rsfx, expr, argCheck);
emitStmts(sb, (ConsCell)cdr(paramsAndForms), env, topEnv, rsfx, " return ", false, false);
sb.append(" })");
}
private int ignoredCounter = 0;
/** emit a list of forms as a single Java expression */
private void emitProgn(WrappingWriter sb, Object forms, ConsCell env, ConsCell topEnv, int rsfx, boolean isLast) {
if (!listp(forms)) errorMalformed(PROGN, "a list of forms", forms);
final ConsCell ccForms = (ConsCell)forms;
if (cdr(ccForms) == null) emitForm(sb, car(ccForms), env, topEnv, rsfx, isLast);
else if (USE_SWITCH_EXPR) {
sb.append("switch (0) {\n default: {\n");
emitStmts(sb, ccForms, env, topEnv, rsfx, " yield ", !isLast, false);
sb.append(" } }");
}
else {
sb.append(isLast ? "tailcall(" : "funcall(").append("(MurmelFunction)(Object... ignoredArg").append(ignoredCounter++).append(") -> {\n");
emitStmts(sb, ccForms, env, topEnv, rsfx, " return ", false, false);
sb.append(" }, (Object[])null)");
}
}
private void emitCatch(WrappingWriter sb, ConsCell tagAndForms, ConsCell env, ConsCell topEnv, int rsfx) {
final Object tag = car(tagAndForms);
final ConsCell bodyForms = (ConsCell)cdr(tagAndForms);
if (USE_SWITCH_EXPR) {
sb.append("switch (0) {\n default: {\n try {\n");
emitStmts(sb, bodyForms, env, topEnv, rsfx, " yield ", true, false);
sb.append(" }\n catch (Exception e) {\n yield catchHelper(");
emitForm(sb, tag, env, topEnv, rsfx, false);
sb.append(", e);\n } } }");
}
else {
final ConsCell body = cons(sLambda, cons(null, bodyForms));
final ConsCell args = cons(tag, cons(body, null));
emitCallPrimitive(sb, "doCatch", args, env, topEnv, rsfx);
}
}
private void emitThrow(WrappingWriter sb, ConsCell tagAndResultForm, ConsCell env, ConsCell topEnv, int rsfx) {
emitCallPrimitive(sb, "doThrow", tagAndResultForm, env, topEnv, rsfx);
}
private void emitTry(WrappingWriter sb, ConsCell formAndErrorobj, ConsCell env, ConsCell topEnv, int rsfx) {
final Object protectedForm = car(formAndErrorobj);
final Object errorObj = cadr(formAndErrorobj);
sb.append("doTry((MurmelFunction)(Object... ignoredArg").append(ignoredCounter++).append(") -> {\n");
if (consp(protectedForm)) emitLoc(sb, (ConsCell)protectedForm, 100);
sb.append(" return ");
emitForm(sb, protectedForm, env, topEnv, rsfx, false);
sb.append(";\n },\n ");
emitForm(sb, errorObj, env, topEnv, rsfx, false);
sb.append(')');
}
private void emitUnwindProtect(WrappingWriter sb, ConsCell ccForms, ConsCell env, ConsCell topEnv, int rsfx, boolean isLast) {
final Object protectedForm = car(ccForms);
final ConsCell cleanupForms = listOrMalformed(UNWIND_PROTECT, cdr(ccForms));
if (isLast) {
sb.append("tailcallWithCleanup(").append("(MurmelFunction)(Object... ignoredArg").append(ignoredCounter++).append(") -> { return ");
emitForm(sb, protectedForm, env, topEnv, rsfx, false);
sb.append("; },\n"
+ " (MurmelFunction)(Object... ignoredArg").append(ignoredCounter++).append(") -> {\n");
emitStmts(sb, cleanupForms, env, topEnv, rsfx, " return ", false, false);
sb.append(" },\n"
+ " (Object[])null)");
}
else {
if (USE_SWITCH_EXPR) sb.append("switch (0) {\n default: {\n try { yield ");
else sb.append("funcall(").append("(MurmelFunction)(Object... ignoredArg").append(ignoredCounter++).append(") -> {\n try { return ");
emitForm(sb, protectedForm, env, topEnv, rsfx, true);
sb.append("; }\n"
+ " finally {\n");
final String tmp = "tmp" + rsfx;
sb.append(" Object ").append(tmp).append(";\n");
emitStmts(sb, cleanupForms, env, topEnv, rsfx, " " + tmp + " = ", false, true);
sb.append(" }\n");
if (USE_SWITCH_EXPR) sb.append(" } }");
else sb.append(" }, (Object[])null)");
}
}
private String emitSetq(WrappingWriter sb, Object pairs, ConsCell env, ConsCell topEnv, int rsfx, boolean _clrValues) {
final LambdaJSymbol symbol = LambdaJ.symbolOrMalformed(SETQ, car(pairs));
final String javaName = javasym(symbol, env);
if (cdr(pairs) == null) errorMalformed(SETQ, "odd number of arguments");
final Object valueForm = cadr(pairs);
notAPrimitive(SETQ, symbol, javaName);
String clrValues = "", closingParen = "";
if (_clrValues && cddr(pairs) == null) {
if (consp(valueForm)) {
final Object valueOp = car((ConsCell)valueForm);
if (valueOp instanceof LambdaJSymbol) {
if (valueOp != sLambda && (valueOp == sValues || needsClrValues((LambdaJSymbol)valueOp))) {
clrValues = "clrValues(";
closingParen = ")";
}
}
}
else {
clrValues = "clrValues(";
closingParen = ")";
}
}
if (fastassq(symbol, env) == fastassq(symbol, topEnv)) {
if (javaName.endsWith(".get()")) {
// either a userdefined global or a
final String symName = javaName.substring(0, javaName.length()-6);
sb.append(symName).append(".set(").append(clrValues); emitForm(sb, valueForm, env, topEnv, rsfx, false); sb.append(closingParen).append(")");
}
else {
// immutable runtime globals such as pi are implemented as regular Java class members (and not as objects of class CompilerGlobal)
errorMalformed(SETQ, "can't modify constant " + symbol);
}
}
else {
sb.append(javaName).append(" = ").append(clrValues); emitForm(sb, valueForm, env, topEnv, rsfx, false); sb.append(closingParen);
}
return javaName;
}
private static boolean needsClrValues(LambdaJSymbol sym) {
final WellknownSymbol ws = sym.wellknownSymbol;
if (ws.stmtExpr
//|| ws == WellknownSymbol.sLambda
|| ws == WellknownSymbol.sIf
|| ws == WellknownSymbol.sCond
|| ws == WellknownSymbol.sSetQ
|| ws == WellknownSymbol.sProgn
|| ws == WellknownSymbol.sCatch
|| ws == WellknownSymbol.sMultipleValueBind
|| ws == WellknownSymbol.sMultipleValueCall)
return false;
return ws != WellknownSymbol.interned && ws != WellknownSymbol.notInterned;
}
/** args = (((symbol (sym...) form...)...) form...) */
private void emitLabels(WrappingWriter sb, final ConsCell args, ConsCell env, ConsCell topEnv, int rsfx, boolean isLast) {
if (args == null) errorMalformed(LABELS, "expected at least one argument");
final Object localFuncs = car(args);
if (localFuncs == null || cddr(args) == null && atom(cadr(args))) {
// no local functions or body is one single atom (the latter can't use the functions so skip them
emitProgn(sb, cdr(args), env, topEnv, rsfx, isLast);
return;
}
sb.append(isLast ? "tailcall(" : "funcall(");
sb.append("new MurmelFunction() {\n");
int ctr = 0;
for (Object localFunc: paramList(LABELS, localFuncs, true)) {
final LambdaJSymbol sym = LambdaJ.symbolOrMalformed(LABELS, localFunc);
final String javaName = "lf" + ctr++ + '_' + rsfx; // don't use the Murmel symbol name in case several local functions' names are gensymmed
env = extenvIntern(sym, javaName, env);
}
for (Object symbolParamsAndBody: (ConsCell) localFuncs) {
final ConsCell ccSymbolParamsAndBody = (ConsCell)symbolParamsAndBody;
containingForm = ccSymbolParamsAndBody;
final LambdaJSymbol symbol = LambdaJ.symbolOrMalformed(Names.LABELS, car(ccSymbolParamsAndBody));
sb.append(" private final MurmelFunction ").append(javasym(symbol, env)).append(" = ");
emitNamedLambda(LABELS, sb, symbol, cadr(ccSymbolParamsAndBody), (ConsCell)cddr(ccSymbolParamsAndBody), env, topEnv, rsfx+1, false);
sb.append(";\n");
}
sb.append(" public final Object apply(Object... ignored) {\n");
emitStmts(sb, (ConsCell)cdr(args), env, topEnv, rsfx, " return ", false, false);
sb.append(" } }, NOARGS)");
}
/** let and named let */
private void emitLet(WrappingWriter sb, ConsCell args, ConsCell env, ConsCell topEnv, int rsfx, boolean isLast) {
final boolean named = car(args) instanceof LambdaJSymbol;
final LambdaJSymbol loopLabel;
final Object bindings;
final ConsCell body;
if (named) { loopLabel = (LambdaJSymbol)car(args); args = (ConsCell)cdr(args); }
else { loopLabel = null; }
bindings = car(args); body = (ConsCell)cdr(args);
assert named || bindings != null : "let w/o bindings should have been replaced in expandForm";
if (bindings == null && body == null) { sb.append("(Object)null"); return; }
sb.append(isLast ? "tailcall(" : "funcall(");
final String op = named ? "named " + LET : LET;
final ConsCell ccBindings = (ConsCell)bindings;
final ConsCell params = paramList(op, ccBindings, false);
if (named) emitNamedLambda(op, sb, loopLabel, params, body, extenvIntern(loopLabel, mangleFunctionName(loopLabel.toString(), rsfx + 1), env), topEnv, rsfx + 1, true);
else emitLambda(sb, cons(params, body), env, topEnv, rsfx + 1, false);
if (ccBindings != null) {
for (Object binding : ccBindings) {
sb.append(ARGSEP);
emitForm(sb, cadr(binding), env, topEnv, rsfx, false);
}
}
else sb.append(", NOARGS");
sb.append(')');
}
/** let* and letrec
* args = ([name] ((symbol form)...) forms...) */
private void emitLetStarLetrec(WrappingWriter sb, ConsCell args, ConsCell env, ConsCell topEnv, int rsfx, boolean letrec, boolean isLast) {
final boolean named = car(args) instanceof LambdaJSymbol;
final LambdaJSymbol loopLabel;
final Object bindings, body;
if (named) { loopLabel = (LambdaJSymbol)car(args); args = (ConsCell)cdr(args); }
else { loopLabel = null; }
bindings = car(args); body = cdr(args);
if (bindings == null && body == null) { sb.append("(Object)null"); return; }
final String sfName = (named ? "named " : "") + (letrec ? LETREC : LETSTAR);
sb.append(isLast ? "tailcall(" : "funcall(");
if (named) {
env = extenv(sfName, loopLabel, rsfx, env);
sb.append("new MurmelFunction() {\n");
sb.append(" private final Object ").append(javasym(loopLabel, env)).append(" = this;\n");
sb.append(" public final Object apply(Object... args").append(rsfx).append(") {\n");
}
else {
sb.append("(MurmelFunction)(args").append(rsfx).append(") -> { {\n");
}
if (!listp(bindings)) errorMalformed(sfName, "a list of bindings", bindings);
final ConsCell ccBindings = (ConsCell)bindings;
final int argCount = listLength(ccBindings);
if (argCount != 0) {
sb.append(" if (args").append(rsfx).append("[0] == UNASSIGNED_LOCAL) {\n");
// letrec: ALL let-bindings are in the environment during binding of the initial values todo value should be undefined
int current = 0;
if (letrec) for (Object binding: ccBindings) {
final LambdaJSymbol sym = LambdaJ.symbolOrMalformed(sfName, car(binding));
final String symName = "args" + rsfx + '[' + current++ + ']';
env = extenvIntern(sym, symName, env);
}
// initial assignments. let*: after the assignment add the let-symbol to the environment so that subsequent bindings will see it
current = 0;
for (Object binding: ccBindings) {
final LambdaJSymbol sym = LambdaJ.symbolOrMalformed(sfName, car(binding));
final Object form = cadr(binding);
final String symName = "args" + rsfx + '[' + current++ + ']';
sb.append(" { ").append(symName).append(" = ");
emitForm(sb, form, env, topEnv, rsfx, false);
if (!letrec) env = extenvIntern(sym, symName, env);
sb.append("; }\n");
}
sb.append(" }\n");
sb.append(" else argCheck(loc, ").append(argCount).append(", args").append(rsfx).append(");\n");
}
if (named) sb.append(" ").append(javasym(loopLabel, env)).append(": while (true) {\n");
emitStmts(sb, (ConsCell)body, env, topEnv, rsfx, " return ", loopLabel, "args" + rsfx, argCount, argCount, false, false);
if (named) sb.append(" }\n");
sb.append(" } }, unassigned(").append(argCount).append("))");
}
/** let dynamic and let* dynamic */
private void emitLetLetStarDynamic(WrappingWriter sb, final ConsCell bindingsAndForms, ConsCell env, ConsCell topEnv, int rsfx, boolean letStar, boolean isLast) {
final Object bindings = car(bindingsAndForms);
if (bindings == null && cdr(bindingsAndForms) == null) { sb.append("(Object)null"); return; }
sb.append(isLast ? "tailcallWithCleanup(" : "funcall(").append("(MurmelFunction)(args").append(rsfx).append(" -> {\n");
final ArrayList globals = new ArrayList<>();
ConsCell _env = env;
if (bindings != null) {
final ConsCell params = paramList(letStar ? ("let* " + DYNAMIC) : ("let " + DYNAMIC), bindings, false);
if (letStar) {
int n = 0;
final HashSet seenSymbols = new HashSet<>();
final Iterator bi = ((ConsCell)bindings).iterator();
for (final Object sym: params) {
final boolean seen = !seenSymbols.add(sym);
final ConsCell maybeGlobal = fastassq(sym, topEnv);
if (maybeGlobal != null) {
final String javaName = cdr(maybeGlobal).toString();
notAPrimitive("let* " + DYNAMIC, sym, javaName);
if (!javaName.endsWith(".get()")) errorMalformed("let* " + DYNAMIC, "cannot modify constant " + car(maybeGlobal));
final String globalName = javaName.substring(0, javaName.length()-6);
if (!seen) {
globals.add(globalName);
sb.append(" ").append(globalName).append(".push();\n");
}
sb.append(" ").append(globalName).append(".set(");
emitForm(sb, cadr(bi.next()), _env, topEnv, rsfx, false);
sb.append(");\n");
}
else { // letXX dynamic can bind both global as well as new local variables
final String javaName;
if (seen) javaName = javasym(sym, _env);
else javaName = "args" + rsfx + "[" + n + "]";
sb.append(" ").append(javaName).append(" = ");
emitForm(sb, cadr(bi.next()), _env, topEnv, rsfx, false);
sb.append(";\n");
if (!seen) _env = extenvIntern((LambdaJSymbol)sym, javaName, _env);
}
n++;
}
}
else {
final ConsCell __env = params("let " + DYNAMIC, sb, params, _env, rsfx, null, false);
int n = 0;
for (final Object sym: params) {
final ConsCell maybeGlobal = fastassq(sym, topEnv);
if (maybeGlobal != null) {
final String javaName = cdr(maybeGlobal).toString();
notAPrimitive("let " + DYNAMIC, sym, javaName);
if (!javaName.endsWith(".get()")) errorMalformed("let " + DYNAMIC, "cannot modify constant " + car(maybeGlobal));
final String globalName = javaName.substring(0, javaName.length()-6);
globals.add(globalName);
sb.append(" ").append(globalName).append(".push(").append(javasym(sym, __env)).append(");\n");
}
else {
_env = extenvIntern((LambdaJSymbol)sym, "args" + rsfx + "[" + n + "]", _env);
}
n++;
}
}
}
if (isLast) {
emitStmts(sb, (ConsCell)cdr(bindingsAndForms), _env, topEnv, rsfx, " return ", false, false);
sb.append(" })\n");
if (globals.isEmpty()) {
sb.append(" , null");
}
else {
sb.append(" , (MurmelFunction)(args").append(rsfx).append(" -> {\n");
for (String globalName : globals) sb.append(" ").append(globalName).append(".pop();\n");
sb.append(" return null;\n })");
}
}
else {
if (!globals.isEmpty()) sb.append(" try {\n");
// set parameter "toplevel" to true to avoid TCO. TCO would effectively disable the finally clause
emitStmts(sb, (ConsCell)cdr(bindingsAndForms), _env, topEnv, rsfx, " return ", bindings != null, false);
if (!globals.isEmpty()) {
sb.append(" }\n finally {\n");
for (String globalName : globals) sb.append(" ").append(globalName).append(".pop();\n");
sb.append(" }\n");
}
sb.append(" })");
}
if (bindings != null)
for (Object binding: (ConsCell)bindings) {
sb.append(ARGSEP);
if (letStar) sb.append("(Object)null");
else emitForm(sb, cadr(binding), env, topEnv, rsfx, false);
}
else sb.append(", NOARGS");
sb.append(')');
}
/** from a list of bindings extract a new list of symbols: ((symbol1 form1)|symbol...) -> (symbol1...) */
private static ConsCell paramList(String func, Object bindings, boolean lists) {
if (bindings == null) return null;
ConsCell params = null, insertPos = null;
for (Object binding: (ConsCell)bindings) {
if (params == null) {
params = cons(null, null);
insertPos = params;
}
else {
insertPos.rplacd(cons(null, null));
insertPos = (ConsCell) insertPos.cdr();
}
if (!lists && symbolp(binding)) insertPos.rplaca(binding);
else if (consp(binding)) insertPos.rplaca(car(binding));
else errorMalformed(func, "a binding", binding);
}
return params;
}
/** optionally emit an arg count check, check that there are no duplicates
* and return an environment extended by accesses to the arg array */
private static ConsCell params(String func, WrappingWriter sb, Object paramList, ConsCell env, int rsfx, String expr, boolean check) {
if (paramList == null) {
if (check) sb.append(" argCheck(\"").append(expr).append("\", 0, args").append(rsfx).append(");\n");
return env;
}
if (symbolp(paramList)) {
// (lambda a forms...) - style varargs
}
else if (dottedList(paramList)) {
if (check) sb.append(" argCheckVarargs(\"").append(expr).append("\", ").append(listLength((ConsCell)paramList)).append(", args").append(rsfx).append(");\n");
}
else if (check) sb.append(" argCheck(\"").append(expr).append("\", ").append(listLength((ConsCell)paramList)).append(", args").append(rsfx).append(");\n");
final HashSet seen = new HashSet<>();
int n = 0;
for (Object params = paramList; params != null; ) {
if (consp(params)) {
final LambdaJSymbol param = LambdaJ.symbolOrMalformed(func, car(params));
if (!seen.add(param)) errorMalformedFmt(func, "duplicate symbol %s", param);
env = extenvIntern(param, "args" + rsfx + "[" + n++ + "]", env);
}
else if (symbolp(params)) {
LambdaJ.notReserved(func, (LambdaJSymbol)params);
if (!seen.add(params)) errorMalformedFmt(func, "duplicate symbol %s", params);
final String javaName = "varargs" + rsfx;
env = extenvIntern((LambdaJSymbol)params, javaName + "[0]", env);
sb.append(" final Object[] ").append(javaName).append(" = new Object[] { arrayToList(args").append(rsfx).append(", ").append(n).append(") };\n");
return env;
}
else errorMalformed(func, "a symbol or a list of symbols", params);
params = cdr(params);
}
return env;
}
private ConsCell loadFile(String func, WrappingWriter sb, Object argument, ConsCell topEnv, List bodyForms, StringBuilder globals) {
assert !passTwo;
final LambdaJ intp = this.intp;
final Path prev = intp.currentSource;
final Path p = intp.findFile(func, argument);
intp.currentSource = p;
try {
final SExpressionReader parser = intp.makeReader(ReadSupplier.of(p), p);
final Object eof = "EOF";
for (;;) {
final Object form = parser.readObj(true, eof);
if (form == eof) return topEnv;
topEnv = toplevelFormToJava(sb, bodyForms, globals, topEnv, intp.expandForm(form, macroEnv));
}
}
catch (IOException e) {
throw wrap(new ReaderError(LOAD + ": error reading file '%s': ", e.getMessage()));
}
finally {
intp.currentSource = prev;
}
}
private static boolean dottedList(Object _l) {
Object l = _l;
for (;;) {
if (l == null) return false;
if (atom(l)) return true;
l = cdr(l);
if (l == _l) throw new ProgramError("circular list detected");
}
}
/** opencode some primitives, avoid trampoline for other primitives and avoid some argcount checks */
private boolean opencode(WrappingWriter sb, LambdaJSymbol op, ConsCell args, ConsCell env, ConsCell topEnv, int rsfx, boolean isLast) {
if (op == null) return false;
if (op == sApply) {
final Object applyOp = car(args);
final Object applyArg = cadr(args);
if (applyOp == null || applyOp == sNil) throw new UndefinedFunction("function application: not a primitive or " + LAMBDA + ": " + NIL);
if (applyOp == sList) { sb.append("requireList("); emitForm(sb, applyArg, env, topEnv, rsfx, false); sb.append(')'); return true; }
if (applyOp != sApply) { // apply needs special treatment for TCO
final String javaName = primitivesBySymbol.get(applyOp);
if (javaName != null) { sb.append(javaName).append("(toArray("); emitForm(sb, applyArg, env, topEnv, rsfx, false); sb.append("))"); return true; }
}
sb.append(isLast ? "tailcall" : "funcall").append("((MurmelFunction)rt()::apply, ");
emitForm(sb, applyOp, env, topEnv, rsfx, false); sb.append(", ");
emitForm(sb, applyArg, env, topEnv, rsfx, false);
sb.append(')');
return true;
}
final WellknownSymbol prim = op.wellknownSymbol;
switch (prim) {
case sCar: {
if (consp(car(args)) && caar(args) == sCdr) {
ConsCell arg = (ConsCell)cdar(args);
if (consp(car(arg)) && caar(arg) == sCdr) {
arg = (ConsCell)cdar(arg);
sb.append("caddr(");
}
else sb.append("cadr(");
emitForm(sb, car(arg), env, topEnv, rsfx, false);
sb.append(')');
return true;
}
if (consp(car(args)) && caar(args) == sCar) {
ConsCell arg = (ConsCell)cdar(args);
if (consp(car(arg)) && caar(arg) == sCar) {
arg = (ConsCell)cdar(arg);
sb.append("caaar(");
}
else sb.append("caar(");
emitForm(sb, car(arg), env, topEnv, rsfx, false);
sb.append(')');
return true;
}
break;
}
case sCdr: {
if (consp(car(args)) && caar(args) == sCdr) {
ConsCell arg = (ConsCell)cdar(args);
if (consp(car(arg)) && caar(arg) == sCdr) {
arg = (ConsCell)cdar(arg);
sb.append("cdddr(");
}
else sb.append("cddr(");
emitForm(sb, car(arg), env, topEnv, rsfx, false);
sb.append(')');
return true;
}
if (consp(car(args)) && caar(args) == sCar) {
final ConsCell arg = (ConsCell)cdar(args);
/*if (consp(car(arg)) && caar(arg) == sCar) {
arg = (ConsCell)cdar(arg);
sb.append("cdaar(");
}
else*/ sb.append("cdar(");
emitForm(sb, car(arg), env, topEnv, rsfx, false);
sb.append(')');
return true;
}
break;
}
case sAdd: assert !prim.stmtExpr; emitAddDbl(sb, "+", 0.0, args, env, topEnv, rsfx); return true;
case sMul: assert !prim.stmtExpr; emitAddDbl(sb, "*", 1.0, args, env, topEnv, rsfx); return true;
case sSub: assert !prim.stmtExpr; emitSubDbl(sb, "-", 0.0, args, env, topEnv, rsfx); return true;
case sDiv: assert !prim.stmtExpr; emitSubDbl(sb, "/", 1.0, args, env, topEnv, rsfx); return true;
case sMod: assert !prim.stmtExpr;
sb.append("cl_mod(");
emitFormAsDouble(sb, "mod", car(args), env, topEnv, rsfx); sb.append(", "); emitFormAsDouble(sb, "mod", cadr(args), env, topEnv, rsfx);
sb.append(')');
return true;
case sRem:
assert !prim.stmtExpr;
sb.append('(');
emitFormAsDouble(sb, "rem", car(args), env, topEnv, rsfx); sb.append(" % "); emitFormAsDouble(sb, "rem", cadr(args), env, topEnv, rsfx);
sb.append(')');
return true;
case sRound: assert !prim.stmtExpr; emitDivision(sb, args, env, topEnv, rsfx, "round", "cl_round", true); return true;
case sFloor: assert !prim.stmtExpr; emitDivision(sb, args, env, topEnv, rsfx, "floor", "Math.floor", true); return true;
case sCeiling: assert !prim.stmtExpr; emitDivision(sb, args, env, topEnv, rsfx, "ceiling", "Math.ceil", true); return true;
case sTruncate: assert !prim.stmtExpr; emitDivision(sb, args, env, topEnv, rsfx, "truncate", "cl_truncate", true); return true;
case sFRound: assert !prim.stmtExpr; emitDivision(sb, args, env, topEnv, rsfx, "fround", "cl_round", false); return true;
case sFFloor: assert !prim.stmtExpr; emitDivision(sb, args, env, topEnv, rsfx, "ffloor", "Math.floor", false); return true;
case sFCeiling: assert !prim.stmtExpr; emitDivision(sb, args, env, topEnv, rsfx, "fceiling", "Math.ceil", false); return true;
case sFTruncate: assert !prim.stmtExpr; emitDivision(sb, args, env, topEnv, rsfx, "ftruncate", "cl_truncate", false); return true;
case sNeq: assert !prim.stmtExpr; if (emitBinOp(sb, true, false, "==", args, env, topEnv, rsfx)) return true; break;
case sNe: assert !prim.stmtExpr; if (emitBinOp(sb, true, false, "!=", args, env, topEnv, rsfx)) return true; break;
case sLt: assert !prim.stmtExpr; if (emitBinOp(sb, true, false, "<", args, env, topEnv, rsfx)) return true; break;
case sLe: assert !prim.stmtExpr; if (emitBinOp(sb, true, false, "<=", args, env, topEnv, rsfx)) return true; break;
case sGe: assert !prim.stmtExpr; if (emitBinOp(sb, true, false, ">=", args, env, topEnv, rsfx)) return true; break;
case sGt: assert !prim.stmtExpr; if (emitBinOp(sb, true, false, ">", args, env, topEnv, rsfx)) return true; break;
case sEq: assert !prim.stmtExpr; emitEq(sb, true, car(args), cadr(args), env, topEnv, rsfx); return true;
case sNull: assert !prim.stmtExpr; emitEq(sb, true, car(args), null, env, topEnv, rsfx); return true;
case sAppend:
assert !prim.stmtExpr;
if (args == null) { // no args
sb.append("(Object)null"); return true;
}
if (cdr(args) == null) { emitForm(sb, car(args), env, topEnv, rsfx, false); return true; }
break;
case sList:
switch (listLength(args)) {
case 0: { sb.append("clrValues(null)"); return true; }
case 1: { sb.append("_cons("); emitForm(sb, car(args), env, topEnv, rsfx, false); sb.append(", null)"); return true; }
case 2: { emitCallPrimitive(sb, "list2", args, env, topEnv, rsfx); return true; }
case 3: { emitCallPrimitive(sb, "list3", args, env, topEnv, rsfx); return true; }
case 4: { emitCallPrimitive(sb, "list4", args, env, topEnv, rsfx); return true; }
case 5: { emitCallPrimitive(sb, "list5", args, env, topEnv, rsfx); return true; }
}
break;
case sListStar:
assert !prim.stmtExpr;
if (cdr(args) == null) { emitForm(sb, car(args), env, topEnv, rsfx, false); return true; }
if (cddr(args) == null) {
sb.append("_cons("); emitForm(sb, car(args), env, topEnv, rsfx, false); sb.append(", "); emitForm(sb, cadr(args), env, topEnv, rsfx, false); sb.append(')'); return true;
}
emitCallPrimitive(sb, "listStar0", args, env, topEnv, rsfx);
return true;
case sJmethod:
assert !prim.stmtExpr;
if (emitJmethod(sb, args, null, null, -1, false, null)) return true;
emitCallPrimitive(sb, "findMethod", args, env, topEnv, rsfx);
return true;
case sError:
switch (listLength(args)) {
case 1: emitCallPrimitive(sb, "error1", args, env, topEnv, rsfx); return true;
case 2: emitCallPrimitive(sb, "error2", args, env, topEnv, rsfx); return true;
case 3: emitCallPrimitive(sb, "error3", args, env, topEnv, rsfx); return true;
case 4: emitCallPrimitive(sb, "error4", args, env, topEnv, rsfx); return true;
default: emitCallPrimitive(sb, "errorN", args, env, topEnv, rsfx); return true;
}
case sMakeArray:
switch (listLength(args)) {
case 1: emitCallPrimitive(sb, "makeArray1", args, env, topEnv, rsfx); return true;
case 2: if (cadr(args) == sT) emitCallPrimitive(sb, "makeArray1", ConsCell.cons(car(args), null), env, topEnv, rsfx);
else emitCallPrimitive(sb, "makeArray2", args, env, topEnv, rsfx);
return true;
case 3: emitCallPrimitive(sb, "makeArray3", args, env, topEnv, rsfx); return true;
default: break;
}
// special handling for writing to stdout, possibly using fewer args and avoiding allocating a varargs array
case sWrite: {
final Object escape = cdr(args) == null ? sT : cadr(args);
final Object dest = caddr(args);
if (escape == null && (dest == null || dest == sT)) { emitCallPrimitive(sb, "writeStdout", ConsCell.list(car(args)), env, topEnv, rsfx); return true; }
break;
}
case sWriteln: {
if (args == null) { sb.append("writelnStdout()"); return true; }
else {
final Object escape = cdr(args) == null ? sT : cadr(args);
final Object dest = caddr(args);
if (escape == null && (dest == null || dest == sT)) {
if ("".equals(car(args))) sb.append("writelnStdout()");
else emitCallPrimitive(sb, "writelnStdout", ConsCell.list(car(args)), env, topEnv, rsfx);
return true;
}
}
}
case sInc: {
if (consp(car(args)) && caar(args) == intern("1+")) {
emitCallPrimitive(sb, "incinc", (ConsCell)cdar(args), env, topEnv, rsfx);
return true;
}
break;
}
default:
break;
}
final String javaName = primitivesBySymbol.get(op);
if (javaName != null) { emitCallPrimitive(sb, javaName, args, env, topEnv, rsfx); return true; }
return false;
}
/** 2 args: divide 2 numbers and apply {@code javaOp} to the result,
* 1 arg: apply {@code javaOp} to the number,
* in both cases if {@code asLong == true} then the result is converted to a fixnum
*/
private void emitDivision(WrappingWriter sb, ConsCell args, ConsCell env, ConsCell topEnv, int rsfx, String murmel, String javaOp, boolean asLong) {
checkNonNumber(murmel, car(args));
if (asLong) sb.append("toFixnum(");
sb.append(javaOp).append('(');
if (cdr(args) == null) {
emitFormAsDouble(sb, murmel, car(args), env, topEnv, rsfx);
}
else {
checkNonNumber(murmel, cadr(args));
emitFormAsDouble(sb, murmel, car(args), env, topEnv, rsfx);
sb.append(" / ");
emitFormAsDouble(sb, murmel, cadr(args), env, topEnv, rsfx);
}
sb.append(')');
if (asLong) sb.append(')');
}
/** emit "==" operator */
private void emitEq(WrappingWriter sb, boolean generalizedBoolean, Object lhs, Object rhs, ConsCell env, ConsCell topEnv, int rsfx) {
if (generalizedBoolean) sb.append("(");
sb.append("((Object)(");
emitForm(sb, lhs, env, topEnv, rsfx, false);
sb.append(") == (Object)(");
if (rhs == null) sb.append(NULL); else emitForm(sb, rhs, env, topEnv, rsfx, false);
sb.append("))");
if (generalizedBoolean) sb.append(" ? _t : null)");
}
/** emit double operator for zero or more number args */
private void emitAddDbl(WrappingWriter sb, String op, double start, ConsCell args, ConsCell env, ConsCell topEnv, int rsfx) {
sb.append('(');
if (args == null) sb.append(start);
else {
boolean first = true;
for (Object arg: args) {
if (first) first = false;
else sb.append(' ').append(op).append(' ');
emitFormAsDouble(sb, op, arg, env, topEnv, rsfx);
}
}
sb.append(')');
}
/** emit double operator for one or more number args */
private void emitSubDbl(WrappingWriter sb, String op, double start, ConsCell args, ConsCell env, ConsCell topEnv, int rsfx) {
sb.append('(');
if (cdr(args) == null) { sb.append(start).append(' ').append(op).append(' '); emitFormAsDouble(sb, op, car(args), env, topEnv, rsfx); }
else {
emitFormAsDouble(sb, op, car(args), env, topEnv, rsfx);
for (Object arg: (ConsCell)cdr(args)) { sb.append(' ').append(op).append(' '); emitFormAsDouble(sb, op, arg, env, topEnv, rsfx); }
}
sb.append(')');
}
/** emit a call to the primitive {@code func} without going through the trampoline,
* if {@code wrapper} is non-null then it will be applied to each function argument */
private void emitCallPrimitive(WrappingWriter sb, String func, ConsCell args, ConsCell env, ConsCell topEnv, int rsfx) {
sb.append(func).append('(');
if (args != null) {
emitForm(sb, car(args), env, topEnv, rsfx, false);
if (cdr(args) != null) for (Object arg: (ConsCell)cdr(args)) {
sb.append(", ");
emitForm(sb, arg, env, topEnv, rsfx, false);
}
}
else sb.append("NOARGS");
sb.append(')');
}
/** if args has two arguments then emit a binary operator (double, double) -> boolean */
private boolean emitBinOp(WrappingWriter sb, boolean generalizedBoolean, boolean setRc, String func, ConsCell args, ConsCell env, ConsCell topEnv, int rsfx) {
if (cdr(args) == null || cddr(args) != null) return false;
if (setRc) sb.append("setRc(");
if (generalizedBoolean) sb.append('(');
emitFormAsDouble(sb, func, car(args), env, topEnv, rsfx);
sb.append(' ').append(func).append(' ');
emitFormAsDouble(sb, func, cadr(args), env, topEnv, rsfx);
if (generalizedBoolean) sb.append(" ? _t : null)");
if (setRc) sb.append(')');
return true;
}
/** eval form and change to double */
private void emitFormAsDouble(WrappingWriter sb, String func, Object form, ConsCell env, ConsCell topEnv, int rsfx) {
checkNonNumber(func, form);
if (form instanceof Long) sb.append(form.toString()).append(".0");
else if (form instanceof Double) sb.append(form.toString());
else { sb.append("toDouble("); emitForm(sb, form, env, topEnv, rsfx, false); sb.append(')'); }
}
/** barf if form cannot eval to a number */
private void checkNonNumber(String func, Object form) {
if (form == null || form instanceof Character || vectorp(form) || consp(form) && car(form) == sQuote) errorNotANumber(func, form);
}
/** argCount is number of arguments at compiletime if known or -1 for check at runtime */
private boolean emitJmethod(WrappingWriter sb, ConsCell args, ConsCell env, ConsCell topEnv, int rsfx, boolean emitCall, ConsCell ccArguments) {
varargsMin(JMETHOD, args, 2);
final Object strClazz = car(args), strMethod = cadr(args);
// if class and method are stringliterals (i.e. java.lang.String objects) then we can do this at compiletime.
// else jmethod() will check the runtime type at runtime
if (!(strClazz instanceof String) || !(strMethod instanceof String)) return false;
final Class> clazz;
final String convReceiver;
final Object[] clazzDesc = JFFI.classByName.get(strClazz);
if (clazzDesc == null) {
try {
clazz = Class.forName((String)strClazz);
convReceiver = clazz.getCanonicalName() + ".class.cast";
}
catch (ClassNotFoundException e) {
note("using reflection at runtime");
return false;
}
}
else {
clazz = (Class>)clazzDesc[0];
convReceiver = (String)clazzDesc[1];
}
// all parameter classes (if any) must be one of the classes that we know how to do Murmel->Java conversion else "return false"
final ArrayList> paramTypes = new ArrayList<>();
final ArrayList paramTypeNames = new ArrayList<>();
if (cddr(args) != null) for (Object arg: (ConsCell)cddr(args)) {
final String paramType = (String)arg;
paramTypeNames.add(paramType);
final Object[] typeDesc = JFFI.classByName.get(paramType);
if (typeDesc == null) { note("using reflection at runtime"); return false; }
final Class> paramClass = (Class>) typeDesc[0];
paramTypes.add(paramClass);
}
// at last check if the method/ constructor with the specified parameter types/ classes exists
final Class>[] params = paramTypes.isEmpty() ? null : paramTypes.toArray(new Class[0]);
final Executable m;
final int startArg;
final boolean voidMethod;
try {
if ("new".equals(strMethod)) { m = clazz.getDeclaredConstructor(params); startArg = 0; voidMethod = false; }
else { m = clazz.getMethod((String)strMethod, params); startArg = Modifier.isStatic(m.getModifiers()) ? 0 : 1; voidMethod = ((Method)m).getReturnType() == void.class; }
}
catch (Exception e) { throw new LambdaJError(true, JMETHOD + ": exception finding method: %s", e.getMessage()); }
final int paramCount = paramTypes.size() + startArg;
if (emitCall) {
// emit new clazz(args...)/ clazz.method(args...)/ firstarg.method(restargs...)
final int argCount = listLength(ccArguments);
if (m.isVarArgs()) { if (argCount < paramCount-1) errorVarargsCount((String)strMethod, paramCount-1, argCount); }
else { if (argCount != paramCount) errorArgCount((String) strMethod, paramCount, paramCount, argCount, null); }
if ("new".equalsIgnoreCase((String) strMethod)) sb.append("new ").append(strClazz);
else {
if (voidMethod) sb.append("((Supplier)(() -> { ");
if (Modifier.isStatic(m.getModifiers())) sb.append(strClazz).append('.').append(strMethod);
else {
// instance method, first arg is the object
if (convReceiver == null) sb.append("(Object)((").append(strClazz).append(')');
else sb.append("(Object)").append(convReceiver).append('(');
emitForm(sb, car(ccArguments), env, topEnv, rsfx, false);
sb.append(").").append(strMethod);
ccArguments = listOrMalformed((String)strMethod, cdr(ccArguments));
}
}
sb.append('(');
boolean first = true;
if (ccArguments != null) {
int i = startArg;
String conv = null;
for (Object arg : ccArguments) {
if (first) first = false;
else sb.append(ARGSEP);
if (!m.isVarArgs() || i - startArg < paramTypeNames.size()) conv = (String) JFFI.classByName.get(paramTypeNames.get(i-startArg))[1];
if (conv == null) emitForm(sb, arg, env, topEnv, rsfx, false);
else { sb.append(conv).append('('); emitForm(sb, arg, env, topEnv, rsfx, false); sb.append(')'); }
i++;
}
}
sb.append(')');
if (voidMethod) sb.append("; return null; })).get()");
}
else {
// emit a lambda that contains an argcount check
sb.append("((MurmelFunction)(args -> { "); // (MurmelJavaProgram.CompilerPrimitive) works too but is half as fast?!?
if (m.isVarArgs()) { sb.append("argCheckVarargs(loc, ").append(paramCount-1).append(", args); ");}
else { sb.append("argCheck(loc, ").append(paramCount).append(", args); "); }
if (!voidMethod) sb.append("return ");
if ("new".equalsIgnoreCase((String) strMethod)) sb.append("new ").append(strClazz);
else if (Modifier.isStatic(m.getModifiers())) sb.append(strClazz).append('.').append(strMethod);
else {
final Object[] desc = JFFI.classByName.get(strClazz);
if (desc != null && desc[1] != null) sb.append(desc[1]).append("(args[0]").append(").").append(strMethod);
else sb.append("((").append(strClazz).append(')').append("args[0]").append(").").append(strMethod);
}
sb.append('(');
if (params != null) {
boolean first = true;
if (m.isVarArgs()) {
for (int i = startArg; i < params.length + startArg - 1; i++) {
if (first) first = false;
else sb.append(ARGSEP);
final Object[] desc = JFFI.classByName.get(paramTypeNames.get(i - startArg));
if (desc == null) sb.append("args[").append(i).append(']');
else sb.append(desc[1]).append("(args[").append(i).append("])");
}
// handle last parameter which is vararg: pass an array of the appropriate type with the remaining args
final Object[] desc = JFFI.classByName.get(paramTypeNames.get(params.length-1));
final int varargPos = params.length + startArg - 1;
final String conv = "(java.util.function.UnaryOperator)(MurmelJavaProgram::" + desc[1] + ')';
sb.append("\n , toVarargs(args, ").append(String.valueOf(varargPos))
.append(", ").append(conv)
.append(", new ").append(((Class>)desc[0]).getComponentType().getCanonicalName()).append("[args.length - ").append(String.valueOf(varargPos)).append("])");
}
else {
for (int i = startArg; i < params.length + startArg; i++) {
if (first) first = false;
else sb.append(ARGSEP);
final String conv = (String)JFFI.classByName.get(paramTypeNames.get(i - startArg))[1];
if (conv == null) sb.append("args[").append(i).append(']');
else sb.append(conv).append("(args[").append(i).append("])");
}
}
}
sb.append("); ");
if (voidMethod) sb.append("return null; ");
sb.append("}))");
}
return true;
}
private void emitVectorLiteral(WrappingWriter sb, Object form) {
if (form instanceof String) { emitStringLiteral(sb, (String)form); }
else if (form instanceof Object[]) { emitSimpleVectorLiteral(sb, (Object[])form); }
else if (form instanceof boolean[]) { emitSimpleBitVectorLiteral(sb, (boolean[])form); }
else errorInternal("emitVectorLiteral: " + VECTOR + " type %s is not implemented", form.toString());
}
private static void emitStringLiteral(WrappingWriter sb, String form) { sb.append('"'); stringToJava(sb, form, -1); sb.append('"'); }
private void emitSimpleVectorLiteral(WrappingWriter sb, Object[] form) {
final StringWriter b = new StringWriter();
final WrappingWriter qsb = new WrappingWriter(b);
qsb.append("new Object[] {");
boolean first = true;
for (Object elem: form) {
if (first) first = false;
else qsb.append(',');
emitQuotedForm(qsb, elem, true);
}
qsb.append("}");
emitReference(sb, b.toString());
}
private void emitSimpleBitVectorLiteral(WrappingWriter sb, boolean[] form) {
final StringWriter b = new StringWriter();
b.append("new boolean[] {");
boolean first = true;
for (boolean elem: form) {
if (first) first = false;
else b.append(',');
b.append(String.valueOf(elem));
}
b.append("}");
emitReference(sb, b.toString());
}
private void emitHashLiteral(WrappingWriter sb, Object form) {
final StringWriter b = new StringWriter();
final WrappingWriter qsb = new WrappingWriter(b);
qsb.append("hash((ConsCell)new ListBuilder()\n .append(");
if (form instanceof EqlMap) qsb.append("intern(\"eql\")");
else if (form instanceof EqlTreeMap) qsb.append("intern(\"compare-eql\")");
else if (form instanceof EqualMap) qsb.append("intern(\"equal\")");
else if (form instanceof EqualTreeMap) qsb.append("intern(\"compare-equal\")");
else if (form instanceof IdentityHashMap) qsb.append("intern(\"eq\")");
else if (form instanceof HashMap) qsb.append("_t");
else errorInternal("emitHashLiteral: hash-table type %s is not implemented", form.toString());
qsb.append(')');
if (form instanceof MurmelMap) {
final MurmelMap map = (MurmelMap)form;
for (Map.Entry,?> entry: map.entrySet()) {
qsb.append("\n .append("); emitQuotedForm(qsb, map.getKey(entry), true); qsb.append(')');
qsb.append("\n .append("); emitQuotedForm(qsb, entry.getValue(), true); qsb.append(')');
}
} else for (Map.Entry,?> entry: ((Map,?>)form).entrySet()) {
qsb.append("\n .append("); emitQuotedForm(qsb, entry.getKey(), true); qsb.append(')');
qsb.append("\n .append("); emitQuotedForm(qsb, entry.getValue(), true); qsb.append(')');
}
qsb.append(".first())");
emitReference(sb, b.toString());
}
/** emit a quoted form.
*
*
Nil, t and atoms that are not symbols are emitted as is.
*
*
For symbols or lists a Java expression is emitted that re-creates the
* quoted form at runtime.
*
*
If pool is true then above Java expression is added as an entry to the constant pool
* and a reference to the new or already existing identical constant pool entry is emitted. */
private void emitQuotedForm(WrappingWriter sb, Object form, boolean pool) {
if (form == null || form == sNil) sb.append("(Object)null");
else if (form == sT) sb.append("_t");
else if (symbolp(form)) {
final LambdaJSymbol sym = (LambdaJSymbol)form;
if (sym.wellknownSymbol == WellknownSymbol.notInterned) {
emitGensym(sb, sym);
}
else {
final String s = "intern(\"" + escapeString(form.toString()) + "\")";
if (pool) emitReference(sb, s);
else sb.append(s);
}
}
else if (atom(form)) { emitAtom(sb, form); }
else if (consp(form)) {
final StringWriter b = new StringWriter();
final WrappingWriter qsb = new WrappingWriter(b);
if (atom(cdr(form))) {
// fast path for dotted pairs and 1 element lists
qsb.append("_cons("); emitQuotedForm(qsb, car(form), false);
qsb.append(", "); emitQuotedForm(qsb, cdr(form), false);
qsb.append(')');
}
else if (atom(cddr(form))) {
// fast path for 2 element lists or dotted 3 element lists
qsb.append("_cons("); emitQuotedForm(qsb, car(form), false);
qsb.append(", _cons("); emitQuotedForm(qsb, cadr(form), false);
qsb.append(", "); emitQuotedForm(qsb, cddr(form), false);
qsb.append("))");
}
else {
qsb.append("new ListBuilder()");
for (Object o = form; ; o = cdr(o)) {
qsb.append("\n .append(");
emitQuotedForm(qsb, car(o), false);
qsb.append(')');
if (cdr(o) == null) break;
if (!consp(cdr(o))) {
qsb.append("\n .appendLast(");
emitQuotedForm(qsb, cdr(o), false);
qsb.append(')');
break;
}
}
qsb.append("\n .first()");
}
final String init = b.toString();
// deduplicate quoted lists (list constants), modifying list constants will lead to unexpected behaviour
if (pool) emitReference(sb, init);
else sb.append(init);
}
else throw errorInternal(QUOTE + ": unexpected form", form);
}
private final Map gensyms = new IdentityHashMap<>();
private void emitGensym(WrappingWriter sb, LambdaJSymbol sym) {
String ref = gensyms.get(sym);
if (ref == null) {
ref = createReference("_gensym(\"" + escapeString(sym.toString()) + "\")");
gensyms.put(sym, ref);
}
sb.append(ref);
}
private int qCounter;
private final List quotedForms = new ArrayList<>();
/** emit a reference to an existing identical constant in the constant pool
* or add a new one to the pool and emit a reference to that */
private void emitReference(WrappingWriter sb, String s) {
final int prev = quotedForms.indexOf(s);
if (prev == -1) sb.append(createReference(s));
else sb.append("q").append(prev);
}
private String createReference(String s) {
final String ret = "q" + qCounter++;
quotedForms.add(s);
return ret;
}
private void emitConstantPool(WrappingWriter ret) {
int ctr = 0;
for (String quotedForm: quotedForms) {
ret.append(" public final Object q").append(ctr).append(" = ").append(quotedForm).append(";\n");
ctr++;
}
}
private static ConsCell cons(Object car, Object cdr) {
return ConsCell.cons(car, cdr);
}
}
@SuppressWarnings("unused")
public static final class JFRHelper {
private JFRHelper() {}
@jdk.jfr.Relational
@Target({ ElementType.FIELD })
@Retention(RetentionPolicy.RUNTIME)
@interface ParentId {}
@jdk.jfr.Category({"JMurmel", "User Events"})
@jdk.jfr.StackTrace(false)
public abstract static class BaseEvent extends jdk.jfr.Event {
private static final AtomicInteger counter = new AtomicInteger(0);
@jdk.jfr.Description("Parent Event Id")
@jdk.jfr.Label("Parent") @ParentId final int parent;
@jdk.jfr.Description("Event Id")
@jdk.jfr.Label("Id") final int id;
@jdk.jfr.Description("Event Name")
@jdk.jfr.Label("Name") String name;
@jdk.jfr.Description("Event Information")
@jdk.jfr.Label("Information") String info;
@SuppressWarnings("CopyConstructorMissesField")
BaseEvent(BaseEvent parent) {
id = counter.getAndIncrement();
if (parent != null) this.parent = parent.id;
else this.parent = -counter.getAndIncrement();
}
}
@jdk.jfr.Description("Generic Events submitted by User Code")
@jdk.jfr.Label("Events")
@jdk.jfr.Name("io.github.jmurmel.MurmelEvent")
public static class JFREvent extends BaseEvent {
JFREvent(BaseEvent parent) {
super(parent);
}
}
@jdk.jfr.Description("Murmel Function Calls")
@jdk.jfr.Label("Function Calls")
@jdk.jfr.Name("io.github.jmurmel.MurmelFunctionCall")
public static class JFRFunctionCall extends BaseEvent {
Object args;
@jdk.jfr.Description("Function Call Arguments")
@jdk.jfr.Label("Arguments") String strArgs;
@jdk.jfr.Description("Function Call Return Value")
@jdk.jfr.Label("Return Value") String ret;
JFRFunctionCall(BaseEvent parent) {
super(parent);
}
}
public static void event(BaseEvent parent, Object name, Object info) {
final JFREvent event = new JFREvent(parent);
if (!event.shouldCommit()) return;
event.name = String.valueOf(name);
event.info = String.valueOf(info);
event.commit();
}
public static JFREvent beginEvent(BaseEvent parent, Object name) {
final JFREvent ret = new JFREvent(parent);
if (!ret.isEnabled()) return ret;
ret.name = name.toString();
ret.begin();
return ret;
}
public static void endEvent(JFREvent event, Object info) {
event.end();
if (!event.shouldCommit()) return;
event.info = info.toString();
event.commit();
}
public static JFRFunctionCall beginFunction(BaseEvent parent, Object name, Object args) {
final JFRFunctionCall ret = new JFRFunctionCall(parent);
if (!ret.isEnabled()) return ret;
ret.name = name.toString();
ret.args = args;
ret.strArgs = LambdaJ.printSEx(args, false).toString();
ret.begin();
return ret;
}
public static Object endFunction(JFRFunctionCall call, Object ret) {
call.end();
if (!call.shouldCommit()) return ret;
final String strRet = LambdaJ.printSEx(ret, false).toString();
call.info = LambdaJ.printSEx(ConsCell.cons(call.name, call.args), false) + " -> " + strRet;
call.ret = strRet;
call.commit();
return ret;
}
}
// Null and NotNull are copied from jakarta.validation-api.jar (and somewhat stripped) in order to avoid this dependency so that "java LambdaJ.java" will work
@Target({ METHOD, FIELD, ANNOTATION_TYPE, CONSTRUCTOR, PARAMETER, TYPE_USE })
@Retention(RetentionPolicy.SOURCE)
@Repeatable(NotNull.List.class)
@Documented
public @interface NotNull {
/**
* Defines several {@link NotNull} annotations on the same element.
*/
@Target({ METHOD, FIELD, ANNOTATION_TYPE, CONSTRUCTOR, PARAMETER, TYPE_USE })
@Retention(RetentionPolicy.SOURCE)
@Documented
@interface List {
NotNull[] value();
}
}
@Target({ METHOD, FIELD, ANNOTATION_TYPE, CONSTRUCTOR, PARAMETER, TYPE_USE })
@Retention(RetentionPolicy.SOURCE)
@Repeatable(Null.List.class)
@Documented
public @interface Null {
/**
* Defines several {@link Null} annotations on the same element.
*/
@Target({ METHOD, FIELD, ANNOTATION_TYPE, CONSTRUCTOR, PARAMETER, TYPE_USE })
@Retention(RetentionPolicy.SOURCE)
@Documented
@interface List {
Null[] value();
}
}
}
/** a utility class with things that Java should support out of the box */
final class JavaUtil {
static final float DEFAULT_LOAD_FACTOR = 0.75f;
private JavaUtil() {}
// from Java 20 HashMap#calculateHashMapCapacity()
static int hashMapCapacity(int numMappings) {
return (int)Math.ceil(numMappings / (double)DEFAULT_LOAD_FACTOR);
}
static HashMap newHashMap(int numMappings) {
return new HashMap<>(hashMapCapacity(numMappings), DEFAULT_LOAD_FACTOR);
}
// Java 11 has CharSequence#compare
static int compare(CharSequence cs1, CharSequence cs2) {
for (int i = 0, len = Math.min(cs1.length(), cs2.length()); i < len; i++) {
final char a = cs1.charAt(i);
final char b = cs2.charAt(i);
if (a != b) { return a - b; }
}
return Integer.compare(cs1.length(), cs2.length());
}
/**
* return value is 16bits at most so -compare() is safe
*/
static int compare(CharSequence cs1, char[] cs2) {
for (int i = 0, len = Math.min(cs1.length(), cs2.length); i < len; i++) {
final char a = cs1.charAt(i);
final char b = cs2[i];
if (a != b) { return a - b; }
}
return Integer.compare(cs1.length(), cs2.length);
}
static int compare(char[] cs1, char[] cs2) {
for (int i = 0, len = Math.min(cs1.length, cs2.length); i < len; i++) {
final char a = cs1[i];
final char b = cs2[i];
if (a != b) { return a - b; }
}
return Integer.compare(cs1.length, cs2.length);
}
static String readString(Path p, Charset cs) throws IOException {
// Java11+ has Files.readString() which does one less copying than this
return new String(Files.readAllBytes(p), cs);
}
static CharSequence readString(InputStream is, Charset cs) throws IOException {
try (Reader r = new InputStreamReader(is, cs)) {
final StringBuilder ret = new StringBuilder(4096);
final char[] buf = new char[4096];
int nRead;
while ((nRead = r.read(buf)) != -1) {
ret.append(buf, 0, nRead);
}
return ret;
}
}
public static List readStrings(InputStream is, Charset cs) throws IOException {
try (BufferedReader reader = new BufferedReader(new InputStreamReader(is, cs))) {
final List result = new ArrayList<>();
for (;;) {
final String line = reader.readLine();
if (line == null)
break;
result.add(line);
}
return result;
}
}
private static int jvmVersion = -1;
static int jvmVersion() {
if (jvmVersion == -1) {
String version = System.getProperty("java.version");
if (version.startsWith("1.")) {
version = version.substring(2, 3);
}
else {
final int dot = version.indexOf('.');
if (dot != -1) version = version.substring(0, dot);
final int dash = version.indexOf('-');
if (dash != -1) version = version.substring(0, dash);
}
return jvmVersion = Integer.parseInt(version);
}
return jvmVersion;
}
}
final class InstallDir {
/** installation directory */
static final Path installDir;
static {
Path path;
try {
final Path p = Paths.get(InstallDir.class.getProtectionDomain().getCodeSource().getLocation().toURI());
if (Files.isDirectory(p)) {
path = p;
}
else {
path = p.getParent();
if (path == null) {
System.out.println("cannot get Murmel dir: " + p + " is not a directory but does not have a parent to use");
}
else if (!Files.isDirectory(path)) {
System.out.println("cannot get Murmel dir: neither " + p + " nor " + path + " are directories");
}
}
}
catch (URISyntaxException e) {
System.out.println("cannot get Murmel dir: " + e.getMessage());
path = Paths.get(".");
}
installDir = path;
}
private InstallDir() {}
}
/// ## class JavaCompilerHelper
/// class JavaCompilerHelper - a helper class that wraps the Java system compiler in tools.jar,
/// used by MurmelJavaCompiler to compile the generated Java to an in-memory class and optionally a .jar file.
final class JavaCompilerHelper {
private static final Map ENV = Collections.singletonMap("create", "true");
private final @NotNull MurmelClassLoader murmelClassLoader;
JavaCompilerHelper(@NotNull Path outPath) {
murmelClassLoader = new MurmelClassLoader(outPath);
}
@SuppressWarnings("unchecked")
@NotNull Class javaToClass(String className, String javaSource, String jarFileName) throws Exception {
final Class program = (Class) javaToClass(className, javaSource);
if (jarFileName == null) {
cleanup();
return program;
}
final Manifest mf = new Manifest();
mf.getMainAttributes().put(Attributes.Name.MANIFEST_VERSION, "1.0");
mf.getMainAttributes().put(Attributes.Name.IMPLEMENTATION_TITLE, LambdaJ.ENGINE_NAME);
mf.getMainAttributes().put(Attributes.Name.IMPLEMENTATION_VERSION, LambdaJ.ENGINE_VERSION);
mf.getMainAttributes().put(Attributes.Name.MAIN_CLASS, className);
mf.getMainAttributes().put(Attributes.Name.CLASS_PATH, new File(LambdaJ.class.getProtectionDomain().getCodeSource().getLocation().getPath()).getName());
final Path zipPath = Paths.get(jarFileName);
final URI uri = URI.create("jar:" + zipPath.toUri());
Files.deleteIfExists(zipPath);
try (FileSystem zipfs = FileSystems.newFileSystem(uri, ENV)) {
Files.createDirectory(zipfs.getPath("META-INF/"));
try (OutputStream out = Files.newOutputStream(zipfs.getPath("META-INF/MANIFEST.MF"))) {
mf.write(out);
}
copyFolder(murmelClassLoader.getOutPath(), zipfs.getPath("/"));
}
finally { cleanup();}
return program;
}
void cleanup() throws IOException {
//System.out.println("cleanup " + murmelClassLoader.getOutPath().toString());
try (Stream files = Files.walk(murmelClassLoader.getOutPath())) {
// delete directory including files and sub-folders
files.sorted(Comparator.reverseOrder())
.map(Path::toFile)
//.peek(f -> System.out.println("delete " + f.toString()))
.forEach(File::deleteOnExit);
}
}
private static void copyFolder(Path src, Path dest) throws IOException {
try (Stream stream = Files.walk(src)) {
stream.forEachOrdered(sourcePath -> {
try {
final Path subSource = src.relativize(sourcePath);
final Path dst = dest.resolve(subSource.toString());
//System.out.println(sourcePath.toString() + " -> " + dst.toString());
if (!sourcePath.equals(src)) {
Files.copy(sourcePath, dst);
}
} catch (IOException e) {
throw new UncheckedIOException(e);
}
});
}
}
/** Compile Java sourcecode of class {@code className} to Java bytecode */
@NotNull Class> javaToClass(String className, String javaSource) throws Exception {
final JavaCompiler comp = ToolProvider.getSystemJavaCompiler();
if (comp == null) throw new LambdaJ.LambdaJError(true, "compilation of class %s failed. No compiler is provided in this environment. Perhaps you are running on a JRE rather than a JDK?", className);
try (StandardJavaFileManager fm = comp.getStandardFileManager(null, null, null)) {
final List options = Arrays.asList("-g", "-proc:none" /*, "-source", "1.8", "-target", "1.8"*/);
fm.setLocation(StandardLocation.CLASS_OUTPUT, Collections.singletonList(murmelClassLoader.getOutPath().toFile()));
// out diag opt classes
final CompilationTask c = comp.getTask(null, fm, null, options, null, Collections.singletonList(new JavaSourceFromString(className, javaSource)));
if (c.call()) {
return Class.forName(className, true, murmelClassLoader);
}
throw new LambdaJ.LambdaJError(true, "compilation of class %s failed", className);
}
}
}
final class JavaSourceFromString extends SimpleJavaFileObject {
/**
* The source code of this "file".
*/
private final String code;
/**
* Constructs a new JavaSourceFromString.
* @param name the name of the compilation unit represented by this file object
* @param code the source code for the compilation unit represented by this file object
*/
JavaSourceFromString(String name, String code) {
super(URI.create("string:///" + name.replace('.','/') + Kind.SOURCE.extension), Kind.SOURCE);
this.code = code;
}
@Override public CharSequence getCharContent(boolean ignoreEncodingErrors) {
return code;
}
}
final class MurmelClassLoader extends ClassLoader {
private final @NotNull Path outPath;
MurmelClassLoader(@NotNull Path outPath) { //noinspection ConstantConditions
assert outPath != null; this.outPath = outPath; }
@Override public Class> findClass(String name) throws ClassNotFoundException {
try {
final byte[] ba = getBytes(name);
if (ba == null) return super.findClass(name);
return defineClass(name, ba, 0, ba.length);
}
catch (IOException e) {
throw new ClassNotFoundException(e.getMessage());
}
}
@NotNull Path getOutPath() { return outPath; }
private byte[] getBytes(String name) throws IOException {
final String path = name.replace('.', '/');
final Path p = outPath.resolve(Paths.get(path + ".class"));
if (!Files.isReadable(p)) return null;
return Files.readAllBytes(p);
}
}
final class EolUtil {
private EolUtil() {}
/**
* From https://stackoverflow.com/questions/3776923/how-can-i-normalize-the-eol-character-in-java/27930311
*
*
Accepts a string and returns the string with all end-of-lines
* normalized to a \n. This means \r\n and \r will both be normalized to \n.
*
* Impl Notes: Although regex would have been easier to code, this approach
* will be more efficient since it's purpose built for this use case. Note we only
* construct a new StringBuilder and start appending to it if there are new end-of-lines
* to be normalized found in the string. If there are no end-of-lines to be replaced
* found in the string, this will simply return the input value.
*
* @param inputValue input value that may or may not contain new lines
* @return the input value or a new StringBuilder that has new lines normalized
*/
static CharSequence anyToUnixEol(CharSequence inputValue){
if (inputValue == null) return null;
if (inputValue.length() == 0) return inputValue;
int index = -1;
for (int i = 0; i < inputValue.length(); i++) {
if (inputValue.charAt(i) == '\r') {
index = i;
break;
}
}
if (index == -1) return inputValue;
final int len = inputValue.length();
final StringBuilder stringBuilder = new StringBuilder(len);
// we get here if we just read a '\r'
// build up the string builder so it contains all the prior characters
stringBuilder.append(inputValue, 0, index);
if (index + 1 < len && inputValue.charAt(index + 1) == '\n') {
// this means we encountered a \r\n ... move index forward one more character
index++;
}
stringBuilder.append('\n');
index++;
while (index < len) {
final char c = inputValue.charAt(index);
if (c == '\r') {
if (index + 1 < len && inputValue.charAt(index + 1) == '\n') {
// this means we encountered a \r\n ... move index forward one more character
index++;
}
stringBuilder.append('\n');
}
else {
stringBuilder.append(c);
}
index++;
}
return stringBuilder;
}
static StringBuilder unixToJavaEol(StringBuilder inputValue){
if (inputValue == null) return null;
if (inputValue.length() == 0) return inputValue;
final String platformEol = System.lineSeparator();
if ("\n".equals(platformEol)) return inputValue;
int index = -1;
for (int i = 0; i < inputValue.length(); i++) {
final char c = inputValue.charAt(i);
if (c == '\n') {
index = i;
break;
}
}
if (index == -1) return inputValue;
final int len = inputValue.length();
final StringBuilder stringBuilder = new StringBuilder(len);
// we get here if we just read a '\n'
// build up the string builder so it contains all the prior characters
stringBuilder.append(inputValue, 0, index);
stringBuilder.append(platformEol);
index++;
while (index < len) {
final char c = inputValue.charAt(index);
if (c == '\n') stringBuilder.append(platformEol);
else stringBuilder.append(c);
index++;
}
return stringBuilder;
}
}
/** A wrapping {@link LambdaJ.WriteConsumer} that translates '\n' to the given line separator {@code eol}. */
final class UnixToAnyEol implements LambdaJ.WriteConsumer {
private final @NotNull LambdaJ.WriteConsumer wrapped;
private final String eol;
UnixToAnyEol(@NotNull LambdaJ.WriteConsumer wrapped, String eol) {
//noinspection ConstantConditions
assert wrapped != null;
this.wrapped = wrapped;
this.eol = eol;
}
@Override public void print(CharSequence s) {
if (s == null
|| s.length() == 0
|| s.charAt(0) != '\n' && s.charAt(s.length() - 1) != '\n' && !hasNewline(s)) {
// fast path for null, empty string or strings w/o '\n'
// the check for '\n' also has a fast path for strings beginning or ending with '\n'
wrapped.print(s); return;
}
final int len = s.length();
for (int index = 0; index < len; index++) {
final char c = s.charAt(index);
if (c == '\n') wrapped.print(eol);
else wrapped.print(String.valueOf(c));
}
}
private static boolean hasNewline(CharSequence s) {
for (int i = 1; i < s.length(); i++) {
if (s.charAt(i) == '\n') return true;
}
return false;
}
}
/** Wrap a java.io.Writer, methods throw unchecked LambdaJError, also add {@code append()} methods for basic data types. */
final class WrappingWriter extends Writer {
private final @NotNull Writer wrapped;
WrappingWriter(@NotNull Writer w) { wrapped = w; }
@Override public WrappingWriter append(CharSequence c) {
try { wrapped.append(c); }
catch (IOException e) { throw new LambdaJ.LambdaJError(e.getMessage()); }
return this;
}
@Override public WrappingWriter append(char c) {
try { wrapped.write(c); }
catch (IOException e) { throw new LambdaJ.LambdaJError(e.getMessage()); }
return this;
}
public WrappingWriter append(String s) { write(s); return this; }
public WrappingWriter append(int n) { write(String.valueOf(n)); return this; }
public WrappingWriter append(long l) { write(String.valueOf(l)); return this; }
public WrappingWriter append(double d) { write(String.valueOf(d)); return this; }
public WrappingWriter append(Object o) { write(String.valueOf(o)); return this; }
@Override public void write(String s) {
try { wrapped.write(s); }
catch (IOException e) { throw new LambdaJ.LambdaJError(e.getMessage()); }
}
@Override public void write(String s, int off, int len) {
try { wrapped.write(s, off, len); }
catch (IOException e) { throw new LambdaJ.LambdaJError(e.getMessage()); }
}
@Override public void write(char[] cbuf, int off, int len) {
try { wrapped.write(cbuf, off, len); }
catch (IOException e) { throw new LambdaJ.LambdaJError(e.getMessage()); }
}
@Override public void flush() {
try { wrapped.flush(); }
catch (IOException e) { throw new LambdaJ.LambdaJError(e.getMessage()); }
}
@Override public void close() {
try { wrapped.close(); }
catch (IOException e) { throw new LambdaJ.LambdaJError(e.getMessage()); }
}
}
/** A frame (window) with methods to draw lines and print text. */
final class TurtleFrame {
private static final Color[] colors = {
Color.white, // 0
Color.black, // 1
Color.red, // 2
Color.green, // 3
Color.blue, // 4
Color.pink, // 5
Color.orange, // 6
Color.yellow, // 7
Color.magenta, // 8
Color.cyan, // 9
Color.darkGray, // 10
Color.gray, // 11
Color.lightGray, // 12
Color.red.darker(),
Color.green.darker(),
Color.blue.darker(),
};
private static class Text {
private final double x, y;
private final @NotNull String s;
Text(double x, double y, @NotNull String s) { this.x = x; this.y = y; this.s = s; }
}
private static class Pos {
private final double x, y, angle;
private Pos(TurtleFrame f) {
x = f.x;
y = f.y;
angle = f.angle;
}
}
private final int padding;
private int bgColor /*= 0*/;
private int color = 1;
private final List