diff --git a/src/main/java/com/vectron/fcl/Dictionary.java b/src/main/java/com/vectron/fcl/Dictionary.java index 9a14171..9b0020a 100644 --- a/src/main/java/com/vectron/fcl/Dictionary.java +++ b/src/main/java/com/vectron/fcl/Dictionary.java @@ -3,17 +3,14 @@ package com.vectron.fcl; import com.vectron.fcl.types.Word; import java.util.ArrayList; -import java.util.Arrays; import java.util.HashSet; import java.util.List; import java.util.Set; public class Dictionary { private final List dict = new ArrayList<>(); - private final Set immediate = new HashSet<>(); public Dictionary() { - immediate.addAll(Arrays.asList(";", "immediate", "override")); } public void add(Word word) { @@ -35,14 +32,6 @@ public class Dictionary { dict.remove(exiting); } - public boolean isImmediate(String name) { - return immediate.contains(name); - } - - public void makeImmediate(Word word) { - immediate.add(word.name()); - } - public Set wordList() { Set result = new HashSet<>(); for (Word word : dict) { @@ -50,4 +39,8 @@ public class Dictionary { } return result; } + + public Word lastWord() { + return dict.get(dict.size() -1); + } } diff --git a/src/main/java/com/vectron/fcl/Fcl.java b/src/main/java/com/vectron/fcl/Fcl.java index f69fdb9..b4a967c 100644 --- a/src/main/java/com/vectron/fcl/Fcl.java +++ b/src/main/java/com/vectron/fcl/Fcl.java @@ -34,7 +34,6 @@ public class Fcl { private final JvmInterOp interOp; private final FclStack stack; private final Transcript transcript; - private Word lastWord; private Reader reader; private Mode mode = Mode.INTERPRET; private final Object[] heap; @@ -47,6 +46,7 @@ public class Fcl { private final int address; private final String name; private boolean visible = true; + private boolean immediate = false; public ColonDef(int address, String name) { this.address = address; @@ -75,6 +75,16 @@ public class Fcl { return visible; } + @Override + public boolean immediate() { + return immediate; + } + + @Override + public void immediate(boolean isImmediate) { + immediate = isImmediate; + } + @Override public String toString() { return "xt_" + name + " (" + address + ")"; @@ -150,6 +160,16 @@ public class Fcl { return visible; } + @Override + public boolean immediate() { + return false; + } + + @Override + public void immediate(boolean isImmediate) { + throw new Aborted("Cannot make immediate val"); + } + @Override public void enter() { stack.push(new Num(address)); @@ -234,6 +254,16 @@ public class Fcl { return visible; } + @Override + public boolean immediate() { + return false; + } + + @Override + public void immediate(boolean isImmediate) { + throw new Aborted("Cannot make immediate val"); + } + @Override public void enter() { stack.push(value); @@ -366,7 +396,7 @@ public class Fcl { addPrimitive("@", () -> stack.push((Obj) heap[stack.pop().intValue()])); addPrimitive("[']", () -> stack.push((Word)heap[ip++])); addPrimitive("`", () -> { Word word = dict.at(word()); stack.push(word == null ? Nil.INSTANCE : word); }); - addPrimitive("immediate", () -> dict.makeImmediate(lastWord)); + addPrimitive("immediate", () -> dict.lastWord().immediate(true), true); addPrimitive(".", () -> show(stack.pop())); addPrimitive("jvm-call-static", interOp::jvmCallStatic); addPrimitive("jvm-call-method", interOp::jvmCallMethod); @@ -378,8 +408,8 @@ public class Fcl { addPrimitive("rev*", this::reverse); addPrimitive("key", () -> stack.push(new Num(key()))); addPrimitive("word", () -> stack.push(new Str(word()))); - addPrimitive("override", () -> lastWord.visible(false)); - addPrimitive("reveal", () -> lastWord.visible(true)); + addPrimitive("override", () -> dict.lastWord().visible(false), true); + addPrimitive("reveal", () -> dict.lastWord().visible(true)); addPrimitive("delword", () -> dict.remove((String)stack.pop().value())); addPrimitive("jmp#f", () -> ip += stack.pop().boolValue() ? 1 : ((Num) heap[ip]).longValue()); addPrimitive("jmp", () -> ip += ((Num) heap[ip]).longValue()); @@ -404,16 +434,15 @@ public class Fcl { addPrimitive("create", () -> dict.add(new ColonDef(dp, (String)stack.pop().value()))); addPrimitive("dasm", this::disassemble); addPrimitive(":", () -> { - lastWord = new ColonDef(dp, word()); - dict.add(lastWord); + dict.add(new ColonDef(dp, word())); mode = Mode.COMPILE; }); addPrimitive(";", () -> { heap[dp++] = dict.at(EXIT); heap[dp++] = Nil.INSTANCE; mode = Mode.INTERPRET; - lastWord.visible(true); - }); + dict.lastWord().visible(true); + }, true); } private LogicOperand lOp(Obj obj) { @@ -469,7 +498,13 @@ public class Fcl { } private void addPrimitive(String name, Runnable code) { - dict.add(new Primitive(name, code)); + addPrimitive(name, code, false); + } + + private void addPrimitive(String name, Runnable code, boolean immediate) { + Primitive word = new Primitive(name, code); + word.immediate(immediate); + dict.add(word); } public void eval(String source) { @@ -545,7 +580,7 @@ public class Fcl { break; case COMPILE: if (word != null) { - if (dict.isImmediate(name)) { + if (word.immediate()) { trace("exec " + word.name()); word.enter(); } else { diff --git a/src/main/java/com/vectron/fcl/interop/MethodSpec.java b/src/main/java/com/vectron/fcl/interop/MethodSpec.java index f47645b..94abd98 100644 --- a/src/main/java/com/vectron/fcl/interop/MethodSpec.java +++ b/src/main/java/com/vectron/fcl/interop/MethodSpec.java @@ -117,6 +117,8 @@ class MethodSpec { params.add((String)value.value()); else if (clazz == Dic.class) params.add((Dic)value); + else if (clazz == Num.class) + params.add((Num)value); else if (clazz == Map.class) params.add((Map)value.value()); else if (clazz == List.class) @@ -135,6 +137,7 @@ class MethodSpec { case 's': return String.class; case 'm': return Map.class; case 't': return List.class; + case 'N': return Num.class; case 'O': return Obj.class; case 'M': return Dic.class; default: diff --git a/src/main/java/com/vectron/fcl/types/Primitive.java b/src/main/java/com/vectron/fcl/types/Primitive.java index 357cdbb..41ef5b7 100644 --- a/src/main/java/com/vectron/fcl/types/Primitive.java +++ b/src/main/java/com/vectron/fcl/types/Primitive.java @@ -8,6 +8,7 @@ public class Primitive implements Word { private final Runnable code; private final String name; private boolean visible = true; + private boolean immediate; public Primitive(String name, Runnable code) { this.code = code; @@ -24,6 +25,16 @@ public class Primitive implements Word { return visible; } + @Override + public boolean immediate() { + return immediate; + } + + @Override + public void immediate(boolean isImmediate) { + immediate = isImmediate; + } + @Override public void enter() { code.run(); diff --git a/src/main/java/com/vectron/fcl/types/Range.java b/src/main/java/com/vectron/fcl/types/Range.java index 9ff4138..af94936 100644 --- a/src/main/java/com/vectron/fcl/types/Range.java +++ b/src/main/java/com/vectron/fcl/types/Range.java @@ -9,17 +9,17 @@ import static com.vectron.fcl.Fcl.STRICT; public class Range implements Obj { private RangeIterator iterator; - private final int from; - private final int to; - private final int by; - private int current; + private final Num from; + private final Num to; + private final Num by; + private Num current; - public static Range create(int by, int to, int from) { + public static Range create(Num by, Num to, Num from) { return new Range(from, to, by); } - private Range(int from, int to, int by) { - if (by == 0) + private Range(Num from, Num to, Num by) { + if (by.doubleValue() == 0) throw new InterOpFailed("Invalid increment for range: " + by); this.from = from; this.to = to; @@ -66,7 +66,7 @@ public class Range implements Obj { @Override public String toString() { - return by == 1 + return by.doubleValue() == 1 ? String.format("%d..%d (%d)", from, to, current) : String.format("%d...%d (%d) by %d", from, to, current, by); } @@ -89,13 +89,15 @@ public class Range implements Obj { public class RangeIterator implements Iterator { @Override public boolean hasNext() { - return by > 0 ? current <= to : current >= to; + return by.doubleValue() > 0 + ? current.doubleValue() <= to.doubleValue() + : current.doubleValue() >= to.doubleValue(); } @Override public Obj next() { - Num result = new Num(current); - current += by; + Num result = current; + current = (Num)current.add(by); return result; } } diff --git a/src/main/java/com/vectron/fcl/types/Word.java b/src/main/java/com/vectron/fcl/types/Word.java index 4c388c1..ffa414c 100644 --- a/src/main/java/com/vectron/fcl/types/Word.java +++ b/src/main/java/com/vectron/fcl/types/Word.java @@ -5,4 +5,6 @@ public interface Word extends Obj { String name(); void visible(boolean isVisible); boolean visible(); + boolean immediate(); + void immediate(boolean isImmediate); } diff --git a/src/main/res/raw/collections.forth b/src/main/res/raw/collections.forth index 38a125d..2c2f040 100644 --- a/src/main/res/raw/collections.forth +++ b/src/main/res/raw/collections.forth @@ -86,7 +86,7 @@ : keys ( d -- l ) :keys jvm-call-method ; : values ( d -- l ) :values jvm-call-method ; -: ... ( lower upper -- lst ) :com.vectron.fcl.types.Range/create/iii jvm-call-static ; +: ... ( lower upper step -- lst ) :com.vectron.fcl.types.Range/create/NNN jvm-call-static ; : .. ( lower upper -- lst ) 1 ... ; : times ( q n -- ) -> n -> q n 0 do q yield loop ; diff --git a/src/main/res/raw/locals.forth b/src/main/res/raw/locals.forth index cccc6a7..110151c 100644 --- a/src/main/res/raw/locals.forth +++ b/src/main/res/raw/locals.forth @@ -14,20 +14,23 @@ 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: sfp ( pointer to the current stack frame, can be different from psp, in case of quotations ) +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 ) 8 val: max#loc ( maximum number of local variables per word ) 1024 val: ps.size ( max pstack size ) ps.size allot val: pstack ( parameter stack for storing the locals ) max#loc allot val: names ( names of the local variables ) +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 ; -: frame.top ( -- a ) pstack sfp @ + ; +: frame.top ( -- a ) pstack psp @ + ; +: frame.top.q ( -- a ) pstack qpsp @ + ; ( for quotations we use the psp of the enclosing word ) : check# ( -- ) #loc @ max#loc >= if 'Too many local variables' abort then ; : >names ( s -- ) @@ -38,14 +41,27 @@ false frame.allocated ! : frame.alloc ( -- ) psp @ max#loc + psp ! ( we don't know how many #loc-s needed until ;, lets allocate max#loc ) - psp @ sfp ! full.check ; : frame.drop ( -- ) empty.check max#loc 0 do jvm-null frame.top i - ! loop ( null out everything so that jvm gc can collect ) - psp @ max#loc - psp ! ( drop the stack frame ) - psp @ sfp ! ; + psp @ max#loc - psp ! ; ( drop the stack frame ) + +: (frame.top) + q.count @ 0 > if + ['] frame.top.q , + else + ['] frame.top , + then ; + +: lookup ( type index -- ) + (frame.top) + ['] lit , ( index ) , + ['] - , + 1 = if ['] @ , then ; + +: postpone: ` , ; immediate : local ( n -- ) check# @@ -53,16 +69,15 @@ false frame.allocated ! true frame.allocated ! ['] frame.alloc , ( alloc new stack frame for max#loc ) then - ['] frame.top , ( get the current stack frame address ) + (frame.top) ['] lit , #loc @ , ( local index ) ['] - , ['] ! , ( move local to from data stack to the stack frame ) - ['] jmp , (dummy) ( bypass the lookup word ) + ['] jmp , (dummy) ( bypass the lookup word ) word dup >names ( store lookup word name ) - create ( compile lookup word ) - ['] frame.top , ( current stack frame ) - ['] lit , #loc @ , ( local within the frame ) - ['] - , - swap 1 = if ['] @ , then ( depending on =>/-> we either fetch or keep the address ) + create postpone: immediate ( compile immediate lookup word ) + ['] lit , swap , ( type 1=val 0=var ) + ['] lit , #loc @ , ( local index within the frame ) + ['] lookup , ['] exit , #loc inc resolve ; diff --git a/src/main/res/raw/misc.forth b/src/main/res/raw/misc.forth index 8892cd9..36459b8 100644 --- a/src/main/res/raw/misc.forth +++ b/src/main/res/raw/misc.forth @@ -18,5 +18,47 @@ : tone ( hz ms -- ) swap :com.vectron.forthcalc.support.Tone/play/di jvm-call-static ; : torch ( n -- ) :com.vectron.forthcalc.support.Torch/toggle/O jvm-call-static ; +( TODO: wip ) + : draw-circle ( x y r -- ) :com.vectron.forthcalc.CanvasView/drawCircle/ddd jvm-call-static ; -: draw-rect ( left top right bottom -- ) :com.vectron.forthcalc.CanvasView/drawRect/dddd jvm-call-static ; \ No newline at end of file +: draw-rect ( left top right bottom -- ) :com.vectron.forthcalc.CanvasView/drawRect/dddd jvm-call-static ; +: draw-point ( x y -- ) :com.vectron.forthcalc.CanvasView/drawPoint/dd jvm-call-static ; +: draw-line ( x1 y1 x2 y2 -- ) :com.vectron.forthcalc.CanvasView/drawLine/dddd jvm-call-static ; + +: width :com.vectron.forthcalc.CanvasView/width jvm-call-static ; +: height :com.vectron.forthcalc.CanvasView/height jvm-call-static ; + +: width 320 ; +: height 200 ; + +var: xmin -10 xmin ! +var: ymin -10 ymin ! +var: xmax 10 xmax ! +var: ymax 10 ymax ! + +: xstep ( -- n ) xmax @ xmin @ - 100 / ; + +: translate -> y -> x + x width 2 / * xmax @ / width 2 / + + height y height 2 / * ymax @ / height 2 / + - ; + +: draw-axis + 0 height 2 / width height 2 / draw-line + width 2 / 0 width 2 / height draw-line ; + +: plotq ( q -- ) -> q + draw-axis + nil => px + nil => py + xmin @ xmax @ xstep ... { -> x + x q yield -> y + px @ nil != if + px @ py @ + x y translate + draw-line + then + x y translate py ! px ! + } each ; + + +\ { dup dup dup * * swap 2 * - } plotq diff --git a/src/main/res/raw/quotations.forth b/src/main/res/raw/quotations.forth index 8528197..c241a63 100644 --- a/src/main/res/raw/quotations.forth +++ b/src/main/res/raw/quotations.forth @@ -1,28 +1,36 @@ -: ( adr sfp -- c ) :com.vectron.fcl.types.Quot/create/ii jvm-call-static ; +: ( adr psp -- c ) :com.vectron.fcl.types.Quot/create/ii jvm-call-static ; : qt.adr ( q -- a ) :address jvm-call-method ; -: qt.sfp ( q -- a ) :stackFrame jvm-call-method ; +: qt.psp ( q -- a ) :stackFrame jvm-call-method ; + +: (psp) + q.count @ 1 > if + ['] qpsp , ['] @ , ( nested quotation use its q.psp ) + else + ['] psp , ['] @ , ( non nested quotation use the psp of the enclosing word ) + then ; : { 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 ) - ['] sfp , ['] @ , ( current stack frame ) - ['] , ( make a quotation object from address + sfp ) - ['] jmp , (dummy) ( bypass inline code ) -; + (psp) + ['] , ( make a quotation object from address + psp ) + ['] jmp , (dummy) ; ( bypass inline code ) : } immediate ['] exit.prim @ , - resolve ; + resolve + q.count dec ; : yield ( q -- ? ) - sfp @ >r + qpsp @ >r dup - qt.sfp sfp ! + qt.psp qpsp ! qt.adr exec - r> sfp ! ; + r> qpsp ! ; : dip ( a xt -- a ) swap >r yield r> ; : keep ( a xt -- xt.a a ) over >r yield r> ; diff --git a/src/test/java/com/vectron/fcl/FclTest.java b/src/test/java/com/vectron/fcl/FclTest.java index b2cd7dd..ab6cf87 100644 --- a/src/test/java/com/vectron/fcl/FclTest.java +++ b/src/test/java/com/vectron/fcl/FclTest.java @@ -1035,6 +1035,30 @@ public class FclTest { ";\n" ); assertEquals(41, evalPop("40 tst").intValue()); + eval(": tst\n" + + " => a\n" + + "{ 3 -> b a @ 3 + a ! } yield a @\n" + + ";\n" + ); + assertEquals(43, evalPop("40 tst").intValue()); + + eval(": tst\n" + + " -> q\n" + + "nil => a\n" + + "nil => b\n" + + "1 10 1 ... { -> x x q yield -> y x y b ! a ! } each ;\n" + + " : tst2 { dup * } tst ; tst2 \n" + ); + + assertEquals(1, evalPop(": wl 0 -> wx ;\n" + + ": qt-calls-word-with-local\n" + + " 1 -> x 0 => y\n" + + " { wl 1 y ! } 10 times y @ ; qt-calls-word-with-local\n").intValue()); + + assertEquals(1, evalPop(": wl2 1 -> a { 2 -> b } ; : wl1 0 -> wx wl2 ;\n" + + ": qt-calls-word-with-local\n" + + " 1 -> x 0 => y\n" + + " { wl 1 y ! } 10 times y @ ; qt-calls-word-with-local\n").intValue()); } @Test