From ea2560dce3d0f892036398fef0d6f6700906d0a3 Mon Sep 17 00:00:00 2001 From: zeroflag Date: Sat, 26 Feb 2022 13:50:13 +0100 Subject: [PATCH] - improved array arithmetic. - fixed pstack overflow bug : tst false if 0 -> x then ; --- src/main/java/com/vectron/fcl/Fcl.java | 27 ++++- .../java/com/vectron/fcl/FclTypeAdapter.java | 3 +- .../vectron/fcl/types/ArithmeticOperand.java | 1 + src/main/java/com/vectron/fcl/types/Bool.java | 5 + src/main/java/com/vectron/fcl/types/Chr.java | 13 +++ src/main/java/com/vectron/fcl/types/Dic.java | 5 + .../java/com/vectron/fcl/types/JvmObj.java | 5 + src/main/java/com/vectron/fcl/types/Lst.java | 87 +++++++++++++- src/main/java/com/vectron/fcl/types/Nil.java | 5 + src/main/java/com/vectron/fcl/types/Num.java | 33 ++++-- src/main/java/com/vectron/fcl/types/Obj.java | 1 + .../java/com/vectron/fcl/types/Primitive.java | 5 + src/main/java/com/vectron/fcl/types/Quot.java | 5 + .../java/com/vectron/fcl/types/Range.java | 5 + src/main/java/com/vectron/fcl/types/Str.java | 14 ++- .../java/com/vectron/fcl/types/Symbol.java | 5 + src/main/res/raw/collections.forth | 4 +- src/main/res/raw/locals.forth | 18 +-- src/main/res/raw/misc.forth | 10 +- src/main/res/raw/ops.forth | 6 +- src/main/res/raw/quotations.forth | 4 - src/test/java/com/vectron/fcl/FclTest.java | 106 ++++++++++++++---- 22 files changed, 298 insertions(+), 69 deletions(-) create mode 100644 src/main/java/com/vectron/fcl/types/Chr.java diff --git a/src/main/java/com/vectron/fcl/Fcl.java b/src/main/java/com/vectron/fcl/Fcl.java index 8e59372..805e972 100644 --- a/src/main/java/com/vectron/fcl/Fcl.java +++ b/src/main/java/com/vectron/fcl/Fcl.java @@ -153,6 +153,11 @@ public class Fcl { ? name.compareTo(((ColonDef) other).name) : -1; } + + @Override + public Bool iterable() { + return Bool.FALSE; + } } public class Var implements Word { @@ -253,6 +258,11 @@ public class Fcl { ? name.compareTo(((Var) other).name) : -1; } + + @Override + public Bool iterable() { + return Bool.FALSE; + } } public class Val implements Word { @@ -352,6 +362,11 @@ public class Fcl { ? name.compareTo(((Val) other).name) : -1; } + + @Override + public Bool iterable() { + return Bool.FALSE; + } } public Fcl(FclStack stack, int heapSize, Transcript transcript) { @@ -381,9 +396,9 @@ public class Fcl { stack.push(a.intDiv(b)); }); addPrimitive("pow", () -> { - Num exponent = stack.pop().asNum(); - Num base = stack.pop().asNum(); - stack.push(base.power(exponent)); + Obj exponent = stack.pop(); + Obj base = stack.pop(); + stack.push(aOp(base).pow(exponent)); }); addPrimitive("and", () -> stack.push(lOp(stack.pop()).and(stack.pop()))); addPrimitive("or", () -> stack.push((lOp(stack.pop())).or(stack.pop()))); @@ -484,7 +499,7 @@ public class Fcl { } } - private ArithmeticOperand aOp(Obj obj) { + public static ArithmeticOperand aOp(Obj obj) { try { return (ArithmeticOperand) obj; } catch (ClassCastException e) { @@ -557,6 +572,10 @@ public class Fcl { * Like: if else then, loops, quotations */ public void compileTmpAndEval(String script) { + // XXX ; make locals work, ; drops the frame, so we need to alloc first, normally this is done by the overridden colon + Word frameAlloc = dict.at("frame.alloc"); + if (frameAlloc != null) + frameAlloc.enter(); int savedDp = dp; Mode savedMode = mode; try { diff --git a/src/main/java/com/vectron/fcl/FclTypeAdapter.java b/src/main/java/com/vectron/fcl/FclTypeAdapter.java index 85965a5..90ffb87 100644 --- a/src/main/java/com/vectron/fcl/FclTypeAdapter.java +++ b/src/main/java/com/vectron/fcl/FclTypeAdapter.java @@ -6,8 +6,8 @@ import com.google.gson.JsonObject; import com.google.gson.TypeAdapter; import com.google.gson.stream.JsonReader; import com.google.gson.stream.JsonWriter; -import com.vectron.fcl.Fcl; import com.vectron.fcl.types.Bool; +import com.vectron.fcl.types.Chr; import com.vectron.fcl.types.Dic; import com.vectron.fcl.types.JvmObj; import com.vectron.fcl.types.Lst; @@ -32,6 +32,7 @@ public class FclTypeAdapter extends TypeAdapter { register("num", Num.class); register("bool", Bool.class); register("str", Str.class); + register("chr", Chr.class); register("dic", Dic.class); register("sym", Symbol.class); register("lst", Lst.class); diff --git a/src/main/java/com/vectron/fcl/types/ArithmeticOperand.java b/src/main/java/com/vectron/fcl/types/ArithmeticOperand.java index 3c01656..b9b3fd9 100644 --- a/src/main/java/com/vectron/fcl/types/ArithmeticOperand.java +++ b/src/main/java/com/vectron/fcl/types/ArithmeticOperand.java @@ -5,4 +5,5 @@ public interface ArithmeticOperand { Obj sub(Obj other); Obj mul(Obj other); Obj div(Obj other); + Obj pow(Obj other); } diff --git a/src/main/java/com/vectron/fcl/types/Bool.java b/src/main/java/com/vectron/fcl/types/Bool.java index e123760..5af453d 100644 --- a/src/main/java/com/vectron/fcl/types/Bool.java +++ b/src/main/java/com/vectron/fcl/types/Bool.java @@ -48,6 +48,11 @@ public class Bool implements Obj, LogicOperand { return value(); } + @Override + public Bool iterable() { + return Bool.FALSE; + } + @Override public long longValue() { if (STRICT) throw new TypeMismatched(this, "long"); diff --git a/src/main/java/com/vectron/fcl/types/Chr.java b/src/main/java/com/vectron/fcl/types/Chr.java new file mode 100644 index 0000000..75bccdb --- /dev/null +++ b/src/main/java/com/vectron/fcl/types/Chr.java @@ -0,0 +1,13 @@ +package com.vectron.fcl.types; + +public class Chr extends Str { + + public Chr(Character chr) { + super(String.valueOf(chr)); + } + + @Override + public Bool iterable() { + return Bool.FALSE; + } +} diff --git a/src/main/java/com/vectron/fcl/types/Dic.java b/src/main/java/com/vectron/fcl/types/Dic.java index aa1a06e..a28f8f1 100644 --- a/src/main/java/com/vectron/fcl/types/Dic.java +++ b/src/main/java/com/vectron/fcl/types/Dic.java @@ -65,6 +65,11 @@ public class Dic implements Obj { return -1; } + @Override + public Bool iterable() { + return Bool.TRUE; + } + public Iterator iterator() { return new Iterator() { private Iterator> it = value.entrySet().iterator(); diff --git a/src/main/java/com/vectron/fcl/types/JvmObj.java b/src/main/java/com/vectron/fcl/types/JvmObj.java index 5bc7159..67c1519 100644 --- a/src/main/java/com/vectron/fcl/types/JvmObj.java +++ b/src/main/java/com/vectron/fcl/types/JvmObj.java @@ -89,6 +89,11 @@ public class JvmObj implements Obj { return value(); } + @Override + public Bool iterable() { + return Bool.FALSE; + } + @Override public int compareTo(Obj o) { return -1; diff --git a/src/main/java/com/vectron/fcl/types/Lst.java b/src/main/java/com/vectron/fcl/types/Lst.java index c630fbc..e278add 100644 --- a/src/main/java/com/vectron/fcl/types/Lst.java +++ b/src/main/java/com/vectron/fcl/types/Lst.java @@ -1,5 +1,6 @@ package com.vectron.fcl.types; +import com.vectron.fcl.Fcl; import com.vectron.fcl.exceptions.TypeMismatched; import java.util.ArrayList; @@ -75,6 +76,10 @@ public class Lst implements Obj, ArithmeticOperand { return value.get(index.intValue()); } + private Obj atIfAbsent(int index, Obj defaultValue) { + return index < size() ? value.get(index) : defaultValue; + } + public int indexOf(Obj item) { return value.indexOf(item); } @@ -104,6 +109,11 @@ public class Lst implements Obj, ArithmeticOperand { value.clear(); } + @Override + public Bool iterable() { + return Bool.TRUE; + } + public Iterator iterator() { return value.iterator(); } @@ -115,6 +125,23 @@ public class Lst implements Obj, ArithmeticOperand { return result; } + public Lst flatten() { + Lst result = Lst.empty(); + result.value.addAll(flatten(this)); + return result; + } + + private static List flatten(Lst nested) { + List result = new ArrayList<>(); + for (Obj each : nested.value) { + if (each instanceof Lst) + result.addAll(flatten((Lst)each)); + else + result.add(each); + } + return result; + } + @Override public Str asStr() { return new Str(toString()); @@ -137,7 +164,15 @@ public class Lst implements Obj, ArithmeticOperand { if (other instanceof Num) { Lst result = Lst.empty(); for (Obj each : value) - result.append(each.asNum().add(other)); + result.append(Fcl.aOp(each).add(other)); + return result; + } else if (other instanceof Lst) { + Lst result = Lst.empty(); + for (int i = 0; i < Math.max(size(), ((Lst) other).size()); i++) { + Obj a = atIfAbsent(i, Num.ZERO); + Obj b = ((Lst)other).atIfAbsent(i, Num.ZERO); + result.append(Fcl.aOp(a).add(b)); + } return result; } else { throw new TypeMismatched("+", this, other); @@ -149,7 +184,15 @@ public class Lst implements Obj, ArithmeticOperand { if (other instanceof Num) { Lst result = Lst.empty(); for (Obj each : value) - result.append(each.asNum().sub(other)); + result.append(Fcl.aOp(each).sub(other)); + return result; + } else if (other instanceof Lst) { + Lst result = Lst.empty(); + for (int i = 0; i < Math.max(size(), ((Lst) other).size()); i++) { + Obj a = atIfAbsent(i, Num.ZERO); + Obj b = ((Lst)other).atIfAbsent(i, Num.ZERO); + result.append(Fcl.aOp(a).sub(b)); + } return result; } else { throw new TypeMismatched("-", this, other); @@ -161,7 +204,15 @@ public class Lst implements Obj, ArithmeticOperand { if (other instanceof Num) { Lst result = Lst.empty(); for (Obj each : value) - result.append(each.asNum().mul(other)); + result.append(Fcl.aOp(each).mul(other)); + return result; + } else if (other instanceof Lst) { + Lst result = Lst.empty(); + for (int i = 0; i < Math.max(size(), ((Lst) other).size()); i++) { + Obj a = atIfAbsent(i, Num.ONE); + Obj b = ((Lst)other).atIfAbsent(i, Num.ONE); + result.append(Fcl.aOp(a).mul(b)); + } return result; } else { throw new TypeMismatched("*", this, other); @@ -173,10 +224,38 @@ public class Lst implements Obj, ArithmeticOperand { if (other instanceof Num) { Lst result = Lst.empty(); for (Obj each : value) - result.append(each.asNum().div(other)); + result.append(Fcl.aOp(each).div(other)); + return result; + } else if (other instanceof Lst) { + Lst result = Lst.empty(); + for (int i = 0; i < Math.max(size(), ((Lst) other).size()); i++) { + Obj a = atIfAbsent(i, Num.ZERO); + Obj b = ((Lst)other).atIfAbsent(i, Num.ONE); + result.append((Fcl.aOp(a)).div(b)); + } return result; } else { throw new TypeMismatched("/", this, other); } } + + @Override + public Obj pow(Obj other) { + if (other instanceof Num) { + Lst result = Lst.empty(); + for (Obj each : value) + result.append(Fcl.aOp(each).pow(other)); + return result; + } else if (other instanceof Lst) { + Lst result = Lst.empty(); + for (int i = 0; i < Math.max(size(), ((Lst) other).size()); i++) { + Obj a = atIfAbsent(i, Num.ONE); + Obj b = ((Lst)other).atIfAbsent(i, Num.ONE); + result.append(Fcl.aOp(a).pow(b)); + } + return result; + } else { + throw new TypeMismatched("pow", this, other); + } + } } diff --git a/src/main/java/com/vectron/fcl/types/Nil.java b/src/main/java/com/vectron/fcl/types/Nil.java index 92626e8..7a97fdc 100644 --- a/src/main/java/com/vectron/fcl/types/Nil.java +++ b/src/main/java/com/vectron/fcl/types/Nil.java @@ -63,4 +63,9 @@ public class Nil implements Obj { public String toString() { return "nil"; } + + @Override + public Bool iterable() { + return Bool.FALSE; + } } diff --git a/src/main/java/com/vectron/fcl/types/Num.java b/src/main/java/com/vectron/fcl/types/Num.java index 38dbd5c..0bd3f7e 100644 --- a/src/main/java/com/vectron/fcl/types/Num.java +++ b/src/main/java/com/vectron/fcl/types/Num.java @@ -13,6 +13,7 @@ import static com.vectron.fcl.Fcl.STRICT; public class Num implements Obj, LogicOperand, ArithmeticOperand { public static final Num ZERO = new Num(0); public static final Num ONE = new Num(1); + public static final Num MINUS_ONE = new Num(-1); public static final Num NAN = new Num(Double.NaN); private static final DecimalFormat format; private final Number value; @@ -92,6 +93,8 @@ public class Num implements Obj, LogicOperand, ArithmeticOperand { return new Num((Double) value - (Long)other.value()); else if (value instanceof Double && other.value() instanceof Double) return new Num((Double) value - (Double) other.value()); + else if (other instanceof Lst) + return ((Lst) other).mul(Num.MINUS_ONE).add(this); else if (STRICT) throw new TypeMismatched("-", this, other); return Num.NAN; @@ -126,22 +129,25 @@ public class Num implements Obj, LogicOperand, ArithmeticOperand { return new Num((Double) value / (Long)other.value()); else if (value instanceof Double && other.value() instanceof Double) return new Num((Double) value / (Double) other.value()); + else if (other instanceof Lst) + return ((ArithmeticOperand) ((Lst) other).pow(Num.MINUS_ONE)).mul(this); else if (STRICT) throw new TypeMismatched("/", this, other); return Num.NAN; } - public Num power(Num exponent) { - if (value instanceof Long && exponent.value instanceof Long) - return new Num(Math.pow(((Long) value).doubleValue(), ((Long) exponent.value).doubleValue())); - else if (value instanceof Long && exponent.value instanceof Double) - return new Num(Math.pow(((Long) value).doubleValue(), exponent.doubleValue())); - else if (value instanceof Double && exponent.value instanceof Long) - return new Num(Math.pow((Double)value, ((Long) exponent.value).doubleValue())); - else if (value instanceof Double && exponent.value instanceof Double) - return new Num(Math.pow((Double)value, exponent.doubleValue())); - else if (STRICT) - throw new TypeMismatched("POW", this, exponent); + @Override + public Obj pow(Obj other) { + if (other instanceof Num) { + return new Num(Math.pow(doubleValue(), other.doubleValue())); + } else if (other instanceof Lst) { + Lst result = Lst.empty(); + for (Obj each : ((Lst) other).value()) + result.append(this.pow(each)); + return result; + } else if (STRICT) { + throw new TypeMismatched("pow", this, other); + } return Num.NAN; } @@ -286,4 +292,9 @@ public class Num implements Obj, LogicOperand, ArithmeticOperand { return !((Double) value).isNaN() && !((Double) value).isInfinite(); return true; } + + @Override + public Bool iterable() { + return Bool.FALSE; + } } diff --git a/src/main/java/com/vectron/fcl/types/Obj.java b/src/main/java/com/vectron/fcl/types/Obj.java index 75d7691..de89ad0 100644 --- a/src/main/java/com/vectron/fcl/types/Obj.java +++ b/src/main/java/com/vectron/fcl/types/Obj.java @@ -9,4 +9,5 @@ public interface Obj extends Comparable { Str asStr(); Object value(); Object unwrap(); + Bool iterable(); } \ No newline at end of file diff --git a/src/main/java/com/vectron/fcl/types/Primitive.java b/src/main/java/com/vectron/fcl/types/Primitive.java index 143ebd0..cad4c84 100644 --- a/src/main/java/com/vectron/fcl/types/Primitive.java +++ b/src/main/java/com/vectron/fcl/types/Primitive.java @@ -104,4 +104,9 @@ public class Primitive implements Word { ? name.compareTo(((Primitive) other).name) : -1; } + + @Override + public Bool iterable() { + return Bool.FALSE; + } } diff --git a/src/main/java/com/vectron/fcl/types/Quot.java b/src/main/java/com/vectron/fcl/types/Quot.java index 0ad452b..aead607 100644 --- a/src/main/java/com/vectron/fcl/types/Quot.java +++ b/src/main/java/com/vectron/fcl/types/Quot.java @@ -75,4 +75,9 @@ public class Quot implements Obj { public String toString() { return "Quotation: " + address + ", " + stackFrame; } + + @Override + public Bool iterable() { + return Bool.FALSE; + } } diff --git a/src/main/java/com/vectron/fcl/types/Range.java b/src/main/java/com/vectron/fcl/types/Range.java index 3f0a380..8e80b52 100644 --- a/src/main/java/com/vectron/fcl/types/Range.java +++ b/src/main/java/com/vectron/fcl/types/Range.java @@ -58,6 +58,11 @@ public class Range implements Obj { return new Str(toString()); } + @Override + public Bool iterable() { + return Bool.TRUE; + } + public Iterator iterator() { if (iterator == null) iterator = new RangeIterator(); diff --git a/src/main/java/com/vectron/fcl/types/Str.java b/src/main/java/com/vectron/fcl/types/Str.java index db054d4..74f1107 100644 --- a/src/main/java/com/vectron/fcl/types/Str.java +++ b/src/main/java/com/vectron/fcl/types/Str.java @@ -108,6 +108,11 @@ public class Str implements Obj, ArithmeticOperand { return new Str(new StringBuilder(value).reverse().toString()); } + @Override + public Bool iterable() { + return Bool.TRUE; + } + public Iterator iterator() { return new Iterator() { private int index = 0; @@ -118,7 +123,7 @@ public class Str implements Obj, ArithmeticOperand { @Override public Str next() { - return new Str(Character.toString(value.charAt(index++))); + return new Chr(value.charAt(index++)); } }; } @@ -151,6 +156,8 @@ public class Str implements Obj, ArithmeticOperand { return new Str(String.format(value, a)); } + public Str flatten() { return this; } + @Override public Obj add(Obj other) { throw new TypeMismatched("+", this, other); @@ -177,4 +184,9 @@ public class Str implements Obj, ArithmeticOperand { public Obj div(Obj other) { throw new TypeMismatched("+", this, other); } + + @Override + public Obj pow(Obj other) { + throw new TypeMismatched("pow", this, other); + } } diff --git a/src/main/java/com/vectron/fcl/types/Symbol.java b/src/main/java/com/vectron/fcl/types/Symbol.java index 3e2604b..3f38a8d 100644 --- a/src/main/java/com/vectron/fcl/types/Symbol.java +++ b/src/main/java/com/vectron/fcl/types/Symbol.java @@ -60,4 +60,9 @@ public class Symbol implements Obj { ? symbol.compareTo(((Symbol) other).symbol) : -1; } + + @Override + public Bool iterable() { + return Bool.FALSE; + } } diff --git a/src/main/res/raw/collections.forth b/src/main/res/raw/collections.forth index bf4dd38..80c5cfb 100644 --- a/src/main/res/raw/collections.forth +++ b/src/main/res/raw/collections.forth @@ -14,6 +14,8 @@ : jvmValue ( p -- o ) :value jvm-call-method ; : reverse ( l -- l ) :reverse jvm-call-method ; : format ( l s -- s ) :format/t jvm-call-method ; +: iterator? ( o -- b ) :iterable jvm-call-method ; +: flatten ( l -- l ) dup :flatten jvm-has-method if :flatten jvm-call-method then ; : each ( c q -- ) -> q iter -> it @@ -55,7 +57,7 @@ loop result ; -: peel ( l -- .. ) -> lst lst { } each ; +: peel ( l -- .. ) -> lst lst iterator? if lst { } each else lst then ; : peel# ( m -- .. ) -> m m { dup 1st swap 2nd } each ; : >list* ( .. -- l ) diff --git a/src/main/res/raw/locals.forth b/src/main/res/raw/locals.forth index 9ee32d4..d7262c7 100644 --- a/src/main/res/raw/locals.forth +++ b/src/main/res/raw/locals.forth @@ -15,7 +15,6 @@ var: #loc ( number of local variables per word, used in compile time ) var: psp ( top of the parameter stack, each allocation adds max#loc to this ) var: qpsp ( parameter stack pointer used by quotations ) -var: frame.allocated ( compile time variable for checking if a frame was already allocated ) var: q.count ( compile time counter for quotations, nested into each other ) var: ldp @@ -29,7 +28,6 @@ max#loc look-word-size * allot val: scratch ( scratch area for compiling temporary lookup words ) 0 q.count ! -false frame.allocated ! : full.check ( -- ) psp @ ps.size >= if 'pstack overflow' abort then ; : empty.check ( -- ) psp @ 0 <= if 'pstack underflow' abort then ; @@ -70,11 +68,7 @@ false frame.allocated ! : local ( n -- ) check# - frame.allocated @ not if ( is this the first local? ) - true frame.allocated ! - ['] frame.alloc , ( alloc new stack frame for max#loc ) - scratch ldp ! - then + #loc @ 0 = if scratch ldp ! then (frame.top) ['] lit , #loc @ , ( local index ) ['] - , ['] ! , ( move local to from data stack to the stack frame ) @@ -94,13 +88,12 @@ false frame.allocated ! : -> immediate 1 local ; : => immediate 0 local ; -: unwind frame.allocated @ if ['] frame.drop , then ; - -: exit immediate unwind exit.prim @ , ; +: exit immediate ['] frame.drop , exit.prim @ , ; +: old; immediate exit.prim @ , nil , interpret reveal ; : ; immediate override ( runtime ) - unwind + ['] frame.drop , exit.prim @ , nil , ( compile time ) @@ -109,6 +102,7 @@ false frame.allocated ! jvm-null names i + ! loop 0 #loc ! - false frame.allocated ! interpret reveal ; + +: : override : ['] frame.alloc , old; \ No newline at end of file diff --git a/src/main/res/raw/misc.forth b/src/main/res/raw/misc.forth index 74fef66..c8784ad 100644 --- a/src/main/res/raw/misc.forth +++ b/src/main/res/raw/misc.forth @@ -1,5 +1,5 @@ : hist ( c -- m ) - dup 'iterator' jvm-has-method not if + dup iterator? not if drop #[ ]# exit then -> tbl { @@ -19,8 +19,6 @@ : match: immediate ` lastword set-predicate ; -: round* { round } map* ; - : npv ( cashflow rate -- n ) -> rate 0 => year { rate year @ dis year inc } map sum ; @@ -60,4 +58,8 @@ var: juggler.steps 5 juggler.steps ! : udp-send-byte ( host port byte -- n ) :com.vectron.forthcalc.support.Udp/sendByte/Nis jvm-call-static ; : udp-send-str ( host port str -- n ) :com.vectron.forthcalc.support.Udp/sendStr/sis jvm-call-static ; -: udp-send-lst ( host port lst -- n ) :com.vectron.forthcalc.support.Udp/sendLst/Tis jvm-call-static ; \ No newline at end of file +: udp-send-lst ( host port lst -- n ) :com.vectron.forthcalc.support.Udp/sendLst/Tis jvm-call-static ; + +: round ( n -- n ) dup iterator? if { round } map else round1 then ; +: sqrt ( n -- n ) dup iterator? if { sqrt } map else sqrt1 then ; +: round* { round } map* ; \ No newline at end of file diff --git a/src/main/res/raw/ops.forth b/src/main/res/raw/ops.forth index c1ccab5..081791f 100644 --- a/src/main/res/raw/ops.forth +++ b/src/main/res/raw/ops.forth @@ -40,8 +40,8 @@ : tanh ( n -- n ) :java.lang.Math/tanh/d jvm-call-static ; ( math ) : e ( n -- n ) :java.lang.Math/E jvm-static-var ; -: round ( n -- n ) :java.lang.Math/round/d jvm-call-static ; -: sqrt ( n -- n ) :java.lang.Math/sqrt/d jvm-call-static ; +: round1 ( n -- n ) :java.lang.Math/round/d jvm-call-static ; +: sqrt1 ( n -- n ) :java.lang.Math/sqrt/d jvm-call-static ; : 10log ( n -- n ) :java.lang.Math/log10/d jvm-call-static ; : nlog ( n n -- n ) swap 10log swap 10log / ; : 2log ( n -- n ) 2.0 nlog ; @@ -50,7 +50,7 @@ dup 1 <= if drop 1 else - round dup 1 do i * loop + round1 dup 1 do i * loop then ; : avg* ( .. -- n ) depth dup 1 < if drop else >r sum* r> / then ; : rnd ( -- n ) :com.vectron.fcl.interop.JvmInterOp/random jvm-call-static ; diff --git a/src/main/res/raw/quotations.forth b/src/main/res/raw/quotations.forth index c241a63..f3d2ce2 100644 --- a/src/main/res/raw/quotations.forth +++ b/src/main/res/raw/quotations.forth @@ -11,10 +11,6 @@ : { immediate q.count inc - frame.allocated @ not if ( We need to have a PSP up front for , because quotations might have its own locals ) - ['] frame.alloc , ( But at this point it might not be available yet unless the enclosing function has locals before the quotations ) - true frame.allocated ! - then ['] lit , here 6 + , ( beginning of the quotation ) (psp) ['] , ( make a quotation object from address + psp ) diff --git a/src/test/java/com/vectron/fcl/FclTest.java b/src/test/java/com/vectron/fcl/FclTest.java index 23bfe4e..cdc7ff9 100644 --- a/src/test/java/com/vectron/fcl/FclTest.java +++ b/src/test/java/com/vectron/fcl/FclTest.java @@ -819,6 +819,18 @@ public class FclTest { assertEquals(0, evalPop("m clear m size").intValue()); } + @Test + public void testMaps2() throws Exception { + assertEquals("[ [ 1 3 ] ]", evalPop("#[ 0.8 3.3 ]# round").toString()); + assertEquals("[ [ 1.0 3.0 ] ]", evalPop("#[ 1 9 ]# sqrt").toString()); + try { + evalPop("#[ 'a' 1 ]# round"); + fail("expected type mismatch"); + } catch (TypeMismatched expected) { + resetForth(); + } + } + @Test public void testList() { assertEquals(0, evalPop(" size").intValue()); @@ -994,23 +1006,38 @@ public class FclTest { } @Test - public void testListArithmetic() { - try { - assertEquals("[ 3 6 9 ]", evalPop("[ 1 2 3 ] [ 1 2 3 ] +").toString()); - fail(); - } catch (TypeMismatched e) { } - try { - assertEquals("[ 3 6 9 ]", evalPop("[ 1 2 3 ] [ 1 2 3 ] -").toString()); - fail(); - } catch (TypeMismatched e) { } - try { - assertEquals("[ 3 6 9 ]", evalPop("[ 1 2 3 ] [ 1 2 3 ] *").toString()); - fail(); - } catch (TypeMismatched e) { } - try { - assertEquals("[ 3 6 9 ]", evalPop("[ 1 2 3 ] [ 1 2 3 ] /").toString()); - fail(); - } catch (TypeMismatched e) { } + public void testListArithmetic() throws Exception { + assertEquals("[ 5 7 9 ]", evalPop("[ 1 2 3 ] [ 4 5 6 ] +").toString()); + assertEquals("[ -3 1 0 ]", evalPop("[ 1 2 3 ] [ 4 1 3 ] -").toString()); + assertEquals("[ 4 10 18 ]", evalPop("[ 1 2 3 ] [ 4 5 6 ] *").toString()); + assertEquals("[ 4.0 2.5 2.0 ]", evalPop("[ 4 5 6 ] [ 1 2 3 ] /").toString()); + + assertEquals("[ 5 7 3 ]", evalPop("[ 1 2 3 ] [ 4 5 ] +").toString()); + assertEquals("[ -3 1 3 ]", evalPop("[ 1 2 3 ] [ 4 1 ] -").toString()); + assertEquals("[ 4 10 3 ]", evalPop("[ 1 2 3 ] [ 4 5 ] *").toString()); + assertEquals("[ 4.0 2.5 6.0 ]", evalPop("[ 4 5 6 ] [ 1 2 ] /").toString()); + + assertEquals("[ 5 7 6 ]", evalPop("[ 1 2 ] [ 4 5 6 ] +").toString()); + assertEquals("[ -3 1 -3 ]", evalPop("[ 1 2 ] [ 4 1 3 ] -").toString()); + assertEquals("[ 4 10 6 ]", evalPop("[ 1 2 ] [ 4 5 6 ] *").toString()); + assertEquals("[ 4.0 2.5 0.0 ]", evalPop("[ 4 5 ] [ 1 2 3 ] /").toString()); + + assertEquals("[ 5 7 [ 11 5 ] ]", evalPop("[ 4 5 [ 7 ] ] [ 1 2 [ 4 5 ] ] +").toString()); + + assertEquals("[ 4 5 [ 6 7 ] ]", evalPop("[ 1 2 [ 3 4 ] ] 3 +").toString()); + assertEquals("[ 0 2 [ 5 3 ] ]", evalPop("[ 2 4 [ 7 5 ] ] 2 -").toString()); + assertEquals("[ 3 6 [ 9 12 ] ]", evalPop("[ 1 2 [ 3 4 ] ] 3 *").toString()); + assertEquals("[ 1.0 2.0 [ 3.0 4.0 ] ]", evalPop("[ 2 4 [ 6 8 ] ] 2 /").toString()); + + assertEquals("[ 2.0 4.0 3.0 ]", evalPop("[ 4 16 9 ] sqrt").toString()); + assertEquals("[ 1 6 3 ]", evalPop("[ 1.3 5.6 3.2 ] round").toString()); + + assertEquals("[ 2.0 4.0 [ 3.0 ] ]", evalPop("[ 4 16 [ 9 ] ] sqrt").toString()); + assertEquals("[ 1 [ 6 ] 3 ]", evalPop("[ 1.3 [ 5.6 ] 3.2 ] round").toString()); + + assertEquals("[ 1 2 3 ]", evalPop("[ 1 2 3 ] flatten").toString()); + assertEquals("[ 1 2 3 ]", evalPop("[ 1 [ 2 ] 3 ] flatten").toString()); + assertEquals("[ 4 16 9 10 3 3 1 ]", evalPop("[ 4 16 [ 9 [ 10 ] [ 3 ] ] [ 3 1 ] ] flatten").toString()); assertEquals("[ 3 6 9 ]", evalPop("3 [ 1 2 3 ] *").toString()); assertEquals("[ 3 6 9 ]", evalPop("[ 1 2 3 ] 3 *").toString()); @@ -1018,20 +1045,46 @@ public class FclTest { assertEquals("[ 4 5 6 ]", evalPop("3 [ 1 2 3 ] +").toString()); assertEquals("[ 4 5 6 ]", evalPop("[ 1 2 3 ] 3 +").toString()); assertEquals("[ 1 2 3 ]", evalPop("[ 4 5 6 ] 3 -").toString()); + + assertEquals("[ -1 -2 -3 ]", evalPop("3 [ 4 5 6 ] -").toString()); + assertEquals("[ 2 1 0 ]", evalPop("3 [ 1 2 3 ] -").toString()); + + assertEquals("[ 5.0 2.0 10.0 ]", evalPop("10 [ 2 5 1 ] /").toString()); + + assertEquals("[ 1.0 2.0 4.0 8.0 ]", evalPop("2 [ 0 1 2 3 ] pow").toString()); + assertEquals("[ 1.0 4.0 9.0 ]", evalPop("[ 1 2 3 ] 2 pow").toString()); + assertEquals("[ 25.0 27.0 16.0 ]", evalPop("[ 5 3 2 ] [ 2 3 4 ] pow").toString()); + try { - assertEquals("[ 2 1 0 ]", evalPop("3 [ 1 2 3 ] -").toString()); - fail(); - } catch (TypeMismatched e) { } + evalPop("[ 'a' ] sqrt"); + fail("expected type mismatch"); + } catch (TypeMismatched expected) { + resetForth(); + } try { - assertEquals("[ 5 2 10 ]", evalPop("10 [ 2 5 1 ] /").toString()); - fail(); - } catch (TypeMismatched e) { } + evalPop("[ 'a' ] round"); + fail("expected type mismatch"); + } catch (TypeMismatched expected) { + resetForth(); + } } @Test - public void testStrArithmetic() { + public void testStrArithmetic() throws Exception { assertEquals("'ababab'", evalPop("3 'ab' *").toString()); assertEquals("'ababab'", evalPop("'ab' 3 *").toString()); + try { + evalPop("'ab' sqrt"); + fail("expected type mismatch"); + } catch (TypeMismatched expected) { + resetForth(); + } + try { + evalPop("'ab' round"); + fail("expected type mismatch"); + } catch (TypeMismatched expected) { + resetForth(); + } } @Test @@ -1051,6 +1104,11 @@ public class FclTest { @Test public void testQuotations() { assertEquals(2, evalPop(": tst 1 { 1+ } yield ; tst ").intValue()); + assertEquals(2, evalPop(": tst 1 true if { 1+ } yield then ; tst ").intValue()); + assertEquals(2, evalPop(": tst 1 true if { 1+ } yield else 1 0 / then ; tst ").intValue()); + assertEquals(3, evalPop(": tst 1 false if { 0 / } yield else 2 + then ; tst ").intValue()); + assertEquals(42, evalPop(": tst true if 42 -> x x else 43 then ; tst").intValue()); + assertEquals(43, evalPop(": tst false if 42 -> x x else 43 then ; tst").intValue()); assertEquals(asList(101l, 100l), evalGetStack(": tst 100 { 1+ } keep ; tst")); assertEquals(asList(11l, 100l), evalGetStack(": tst 10 100 { 1+ } dip ; tst")); assertEquals(asList(11l, 9l), evalGetStack(": tst 10 { 1+ } { 1- } bi ; tst"));