Miroirs/planckforth
1
0
Fork 0
mirror of https://github.com/nineties/planckforth synced 2024-12-27 21:58:35 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add cons, car and cdr

Browse source
This commit is contained in:
Koichi Nakamura 2021-12-04 17:22:12 +09:00
parent 02462832e1
commit a4e5968359
2 changed files with 36 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
lib/core.fs
View file

@ -1,13 +1,6 @@
\ planckforth - \ planckforth -
\ Copyright (C) 2021 nineties \ Copyright (C) 2021 nineties
defined? roll [unless]
: roll ( wn ... w1 n -- w1 wn ... w2 )
dup 0<= if drop else swap >r 1- recurse r> swap then
;
[then]
\ Ignore test codes. lib/tester.fs will redefine this when \ Ignore test codes. lib/tester.fs will redefine this when
\ running tests. \ running tests.
: T{ : T{
@ -22,3 +15,29 @@ s" Invalid argument" exception constant INVALID-ARGUMENT
: check-argument ( f -- ) : check-argument ( f -- )
unless INVALID-ARGUMENT throw then unless INVALID-ARGUMENT throw then
; ;
defined? roll [unless]
: roll ( wn ... w1 n -- w1 wn ... w2 )
dup 0<= if drop else swap >r 1- recurse r> swap then
;
[then]
private{
( === Cons Cell === )
struct
cell% field first
cell% field second
end-struct cons-cell%
: cons ( a b -- cons )
cons-cell% %allocate throw
tuck second !
tuck first !
; export
: car first @ ; export
: cdr second @ ; export
}private

10
test/core.fs
View file

@ -1003,4 +1003,14 @@ T{ gdx -> 123 234 }T
cr ." End of Core word set tests" cr cr ." End of Core word set tests" cr
\ ------------------------------------------------------------------------
testing cons, car and cdr
0 1 cons constant cons0
T{ cons0 car -> 0 }T
T{ cons0 cdr -> 1 }T
cons0 free