mirror of
https://github.com/nineties/planckforth
synced 2024-12-26 21:58:42 +01:00
Add cons, car and cdr
This commit is contained in:
parent
02462832e1
commit
a4e5968359
2 changed files with 36 additions and 7 deletions
33
lib/core.fs
33
lib/core.fs
|
@ -1,13 +1,6 @@
|
|||
\ planckforth -
|
||||
\ 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
|
||||
\ running tests.
|
||||
: T{
|
||||
|
@ -22,3 +15,29 @@ s" Invalid argument" exception constant INVALID-ARGUMENT
|
|||
: check-argument ( f -- )
|
||||
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
10
test/core.fs
|
@ -1003,4 +1003,14 @@ T{ gdx -> 123 234 }T
|
|||
|
||||
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
|
||||
|
||||
|
||||
|
|
Loading…
Reference in a new issue