Miroirs/fcl
1
0
Fork 0
mirror of https://github.com/zeroflag/fcl.git synced 2025-01-11 20:01:10 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

local fix, range accepts doubles, plot wip

Browse source
This commit is contained in:
zeroflag 2021-07-04 19:31:25 +02:00
parent 7dcf22c803
commit 36449eff35
11 changed files with 191 additions and 56 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
src/main/java/com/vectron/fcl/Dictionary.java
View file

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

55
src/main/java/com/vectron/fcl/Fcl.java
View file

@ -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 {

3
src/main/java/com/vectron/fcl/interop/MethodSpec.java
View file

@ -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:

11
src/main/java/com/vectron/fcl/types/Primitive.java
View file

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

24
src/main/java/com/vectron/fcl/types/Range.java
View file

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

2
src/main/java/com/vectron/fcl/types/Word.java
View file

@ -5,4 +5,6 @@ public interface Word extends Obj {
String name();
void visible(boolean isVisible);
boolean visible();
boolean immediate();
void immediate(boolean isImmediate);
}

2
src/main/res/raw/collections.forth
View file

@ -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 ;

37
src/main/res/raw/locals.forth
View file

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

42
src/main/res/raw/misc.forth
View file

@ -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

28
src/main/res/raw/quotations.forth
View file

@ -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> ;

24
src/test/java/com/vectron/fcl/FclTest.java
View file

@ -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