version 1.1, 2007/06/24 21:45:45
|
version 1.5, 2012/12/31 15:25:18
|
Line 1
|
Line 1
|
\ implementation of Forth 200x structures |
\ implementation of Forth 200x structures |
|
|
\ Copyright (C) 2007 Free Software Foundation, Inc. |
\ Copyright (C) 2007,2012 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
\ Gforth is free software; you can redistribute it and/or |
\ Gforth is free software; you can redistribute it and/or |
\ modify it under the terms of the GNU General Public License |
\ modify it under the terms of the GNU General Public License |
\ as published by the Free Software Foundation; either version 2 |
\ as published by the Free Software Foundation, either version 3 |
\ of the License, or (at your option) any later version. |
\ of the License, or (at your option) any later version. |
|
|
\ This program is distributed in the hope that it will be useful, |
\ This program is distributed in the hope that it will be useful, |
Line 15
|
Line 15
|
\ GNU General Public License for more details. |
\ GNU General Public License for more details. |
|
|
\ You should have received a copy of the GNU General Public License |
\ You should have received a copy of the GNU General Public License |
\ along with this program; if not, write to the Free Software |
\ along with this program. If not, see http://www.gnu.org/licenses/. |
\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA. |
|
|
|
: +field ( n1 n2 "name" -- n3 ) \ X:structures plus-field |
: standard+field ( n1 n2 "name" -- n3 ) \ X:structures plus-field |
over if |
over if |
(field) over , |
(field) over , |
else |
else |
Line 26
|
Line 25
|
then |
then |
+ ; |
+ ; |
|
|
|
Defer +field |
|
\ A number of things have field-like structure, but not |
|
\ exactly field-like behavior. Objects, locals, etc. |
|
\ Allow them to plug into +field. |
|
|
|
: standard:field ( -- ) |
|
\g set +field to standard behavior |
|
['] standard+field IS +field ; |
|
|
|
standard:field |
|
|
|
: extend-structure ( n "name" -- struct-sys n ) \ Gforth |
|
\g extend an existing structure |
|
standard:field >r 0 value lastxt >body r> ; |
|
|
: begin-structure ( "name" -- struct-sys 0 ) \ X:structures |
: begin-structure ( "name" -- struct-sys 0 ) \ X:structures |
0 value lastxt >body 0 ; |
0 extend-structure ; |
|
|
: end-structure ( struct-sys +n -- ) \ X:structures |
: end-structure ( struct-sys +n -- ) \ X:structures |
swap ! ; |
swap ! ; |