Miroirs/waforth
1
0
Fork 0
mirror of https://github.com/remko/waforth synced 2024-12-27 09:59:29 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

Implement DEFER, DEFER!, DEFER@, IS, ACTION-OF

Browse source
This commit is contained in:
Remko Tronçon 2022-06-04 11:16:03 +02:00
parent f1a0f8ddb9
commit 1f5ffd1b9c
3 changed files with 395 additions and 276 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

592
src/waforth.wat
View file

File diff suppressed because it is too large Load diff

60
src/web/tests/forth2012-test-suite/coreexttest.fth
View file

@ -657,39 +657,39 @@ T{ PARSE-NAME-TEST abcde abcde
T{ PARSE-NAME-TEST abcde abcde T{ PARSE-NAME-TEST abcde abcde
-> TRUE }T \ Leading and trailing spaces -> TRUE }T \ Leading and trailing spaces
\ \ ----------------------------------------------------------------------------- \ -----------------------------------------------------------------------------
\ TESTING DEFER DEFER@ DEFER! IS ACTION-OF (Forth 2012) TESTING DEFER DEFER@ DEFER! IS ACTION-OF (Forth 2012)
\ \ Adapted from the Forth 200X RfD tests \ Adapted from the Forth 200X RfD tests
\ T{ DEFER DEFER1 -> }T T{ DEFER DEFER1 -> }T
\ T{ : MY-DEFER DEFER ; -> }T T{ : MY-DEFER DEFER ; -> }T
\ T{ : IS-DEFER1 IS DEFER1 ; -> }T T{ : IS-DEFER1 IS DEFER1 ; -> }T
\ T{ : ACTION-DEFER1 ACTION-OF DEFER1 ; -> }T T{ : ACTION-DEFER1 ACTION-OF DEFER1 ; -> }T
\ T{ : DEF! DEFER! ; -> }T T{ : DEF! DEFER! ; -> }T
\ T{ : DEF@ DEFER@ ; -> }T T{ : DEF@ DEFER@ ; -> }T
\ T{ ' * ' DEFER1 DEFER! -> }T T{ ' * ' DEFER1 DEFER! -> }T
\ T{ 2 3 DEFER1 -> 6 }T T{ 2 3 DEFER1 -> 6 }T
\ T{ ' DEFER1 DEFER@ -> ' * }T T{ ' DEFER1 DEFER@ -> ' * }T
\ T{ ' DEFER1 DEF@ -> ' * }T T{ ' DEFER1 DEF@ -> ' * }T
\ T{ ACTION-OF DEFER1 -> ' * }T T{ ACTION-OF DEFER1 -> ' * }T
\ T{ ACTION-DEFER1 -> ' * }T T{ ACTION-DEFER1 -> ' * }T
\ T{ ' + IS DEFER1 -> }T T{ ' + IS DEFER1 -> }T
\ T{ 1 2 DEFER1 -> 3 }T T{ 1 2 DEFER1 -> 3 }T
\ T{ ' DEFER1 DEFER@ -> ' + }T T{ ' DEFER1 DEFER@ -> ' + }T
\ T{ ' DEFER1 DEF@ -> ' + }T T{ ' DEFER1 DEF@ -> ' + }T
\ T{ ACTION-OF DEFER1 -> ' + }T T{ ACTION-OF DEFER1 -> ' + }T
\ T{ ACTION-DEFER1 -> ' + }T T{ ACTION-DEFER1 -> ' + }T
\ T{ ' - IS-DEFER1 -> }T T{ ' - IS-DEFER1 -> }T
\ T{ 1 2 DEFER1 -> -1 }T T{ 1 2 DEFER1 -> -1 }T
\ T{ ' DEFER1 DEFER@ -> ' - }T T{ ' DEFER1 DEFER@ -> ' - }T
\ T{ ' DEFER1 DEF@ -> ' - }T T{ ' DEFER1 DEF@ -> ' - }T
\ T{ ACTION-OF DEFER1 -> ' - }T T{ ACTION-OF DEFER1 -> ' - }T
\ T{ ACTION-DEFER1 -> ' - }T T{ ACTION-DEFER1 -> ' - }T
\ T{ MY-DEFER DEFER2 -> }T T{ MY-DEFER DEFER2 -> }T
\ T{ ' DUP IS DEFER2 -> }T T{ ' DUP IS DEFER2 -> }T
\ T{ 1 DEFER2 -> 1 1 }T T{ 1 DEFER2 -> 1 1 }T
\ ----------------------------------------------------------------------------- \ -----------------------------------------------------------------------------
TESTING HOLDS (Forth 2012) TESTING HOLDS (Forth 2012)

19
src/web/tests/suite.js
View file

@ -1578,6 +1578,25 @@ function loadTests() {
}); });
}); });
describe("DEFER", () => {
it("should work", () => {
run("DEFER DEFER1");
run("' * ' DEFER1 DEFER!");
run("2 3 DEFER1");
expect(stackValues()).to.eql([6]);
});
});
describe("IS", () => {
it("should work compiled", () => {
run("DEFER DEFER1");
run(": IS-DEFER1 IS DEFER1 ;");
run("' - IS-DEFER1");
run("1 2 DEFER1");
expect(stackValues()).to.eql([-1]);
});
});
describe("system", () => { describe("system", () => {
it("should run sieve", () => { it("should run sieve", () => {
run(sieve); run(sieve);