local fix, range accepts doubles, plot wip

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<Word> dict = new ArrayList<>();
-    private final Set<String> 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<String> wordList() {
         Set<String> 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);
+    }
 }

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("override", () -> dict.lastWord().visible(false), true);
-        addPrimitive("reveal", () -> lastWord.visible(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(new ColonDef(dp, word()));
-            dict.add(lastWord);
             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 {

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:

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();

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 Num from;
-    private final int to;
+    private final Num to;
-    private final int by;
+    private final Num by;
-    private int current;
+    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) {
+    private Range(Num from, Num to, Num by) {
-        if (by == 0)
+        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<Obj> {
         @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);
+            Num result = current;
-            current += by;
+            current = (Num)current.add(by);
             return result;
         }
     }

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);
 }

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  ;

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 @ max#loc - psp ! ;                    ( drop the stack frame )
-    psp @ sfp ! ;
+
+: (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 )
     word dup >names                 ( store lookup word name )
-    create                          ( compile lookup word  )
+    create postpone: immediate      ( compile immediate lookup word  )
-        ['] frame.top ,             ( current stack frame )
+        ['] lit       ,  swap ,     ( type 1=val 0=var )
-        ['] lit       ,  #loc @  ,  ( local within the frame )
+        ['] lit       ,  #loc @  ,  ( local index within the frame )
-        ['] -         ,
+        ['] lookup    ,
-        swap 1 = if ['] @ , then    ( depending on =>/-> we either fetch or keep the address )
         ['] exit      ,
     #loc inc
     resolve ;

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 ;
+: 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

src/main/res/raw/quotations.forth

@@ -1,28 +1,36 @@
-: <q> ( adr sfp -- c ) :com.vectron.fcl.types.Quot/create/ii jvm-call-static ;
+: <q> ( 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 <q>, 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 )
+    (psp)
-    ['] <q> ,                   ( make a quotation object from address + sfp )
+    ['] <q> ,                   ( make a quotation object from address + psp )
-    ['] jmp , (dummy)           ( bypass inline code )
+    ['] 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> ;

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