mirror of
https://github.com/zeroflag/fcl.git
synced 2025-01-11 20:01:10 +01:00
local fix, range accepts doubles, plot wip
This commit is contained in:
zeroflag
parent
7dcf22c803
commit
36449eff35
11 changed files with 191 additions and 56 deletions
|
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 {
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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();
|
||||
|
|
|
|||
|
|
@ -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<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);
|
||||
current += by;
|
||||
Num result = current;
|
||||
current = (Num)current.add(by);
|
||||
return result;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -5,4 +5,6 @@ public interface Word extends Obj {
|
|||
String name();
|
||||
void visible(boolean isVisible);
|
||||
boolean visible();
|
||||
boolean immediate();
|
||||
void immediate(boolean isImmediate);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
|
|||
|
|
@ -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-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
|
||||
|
|
|
|||
|
|
@ -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 )
|
||||
['] <q> , ( make a quotation object from address + sfp )
|
||||
['] jmp , (dummy) ( bypass inline code )
|
||||
;
|
||||
(psp)
|
||||
['] <q> , ( 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> ;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue