2004-07-22 19:48:50 -04:00
|
|
|
! :folding=indent:collapseFolds=1:
|
|
|
|
|
|
|
|
! $Id$
|
|
|
|
!
|
|
|
|
! Copyright (C) 2004 Slava Pestov.
|
|
|
|
!
|
|
|
|
! Redistribution and use in source and binary forms, with or without
|
|
|
|
! modification, are permitted provided that the following conditions are met:
|
|
|
|
!
|
|
|
|
! 1. Redistributions of source code must retain the above copyright notice,
|
|
|
|
! this list of conditions and the following disclaimer.
|
|
|
|
!
|
|
|
|
! 2. Redistributions in binary form must reproduce the above copyright notice,
|
|
|
|
! this list of conditions and the following disclaimer in the documentation
|
|
|
|
! and/or other materials provided with the distribution.
|
|
|
|
!
|
|
|
|
! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
|
|
|
|
! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
|
|
|
|
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
|
|
|
! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
|
|
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
|
|
|
! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
|
|
|
|
! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
|
|
|
|
! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
|
|
|
|
! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
|
|
|
! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
|
2004-12-15 16:57:29 -05:00
|
|
|
! Bootstrapping trick; see doc/bootstrap.txt.
|
|
|
|
IN: !syntax
|
|
|
|
USE: syntax
|
2004-08-03 02:08:11 -04:00
|
|
|
|
2004-07-22 19:48:50 -04:00
|
|
|
USE: errors
|
2004-11-11 16:45:55 -05:00
|
|
|
USE: hashtables
|
2004-07-22 19:48:50 -04:00
|
|
|
USE: kernel
|
|
|
|
USE: lists
|
2004-08-26 22:21:17 -04:00
|
|
|
USE: math
|
2004-07-22 19:48:50 -04:00
|
|
|
USE: namespaces
|
2004-12-15 16:57:29 -05:00
|
|
|
USE: parser
|
2004-07-22 19:48:50 -04:00
|
|
|
USE: strings
|
|
|
|
USE: words
|
2004-07-31 14:58:16 -04:00
|
|
|
USE: vectors
|
2004-07-22 19:48:50 -04:00
|
|
|
USE: unparser
|
|
|
|
|
2004-12-15 16:57:29 -05:00
|
|
|
: parsing ( -- )
|
|
|
|
#! Mark the most recently defined word to execute at parse
|
|
|
|
#! time, rather than run time. The word can use 'scan' to
|
|
|
|
#! read ahead in the input stream.
|
|
|
|
word t "parsing" set-word-property ; parsing
|
2004-10-10 14:28:56 -04:00
|
|
|
|
2004-11-20 16:57:01 -05:00
|
|
|
: inline ( -- )
|
|
|
|
#! Mark the last word to be inlined.
|
|
|
|
word t "inline" set-word-property ; parsing
|
|
|
|
|
2004-08-29 01:50:34 -04:00
|
|
|
! The variable "in-definition" is set inside a : ... ;.
|
|
|
|
! ( and #! then add "stack-effect" and "documentation"
|
|
|
|
! properties to the current word if it is set.
|
|
|
|
|
2005-01-14 12:01:48 -05:00
|
|
|
! Booleans
|
2005-01-13 19:49:47 -05:00
|
|
|
: t t swons ; parsing
|
|
|
|
: f f swons ; parsing
|
2004-07-22 19:48:50 -04:00
|
|
|
|
|
|
|
! Lists
|
2004-10-23 01:15:06 -04:00
|
|
|
: [ f ; parsing
|
2005-01-13 19:49:47 -05:00
|
|
|
: ] reverse swons ; parsing
|
2004-07-22 19:48:50 -04:00
|
|
|
|
2005-01-13 19:49:47 -05:00
|
|
|
! Conses (whose cdr might not be a list)
|
|
|
|
: [[ f ; parsing
|
|
|
|
: ]] 2unlist swons swons ; parsing
|
2004-07-22 19:48:50 -04:00
|
|
|
|
2004-07-31 14:58:16 -04:00
|
|
|
! Vectors
|
|
|
|
: { f ; parsing
|
2005-01-13 19:49:47 -05:00
|
|
|
: } reverse list>vector swons ; parsing
|
2004-07-31 14:58:16 -04:00
|
|
|
|
2004-11-11 16:45:55 -05:00
|
|
|
! Hashtables
|
|
|
|
: {{ f ; parsing
|
2005-01-13 19:49:47 -05:00
|
|
|
: }} alist>hash swons ; parsing
|
2004-11-11 16:45:55 -05:00
|
|
|
|
2005-01-14 12:01:48 -05:00
|
|
|
! Complex numbers
|
|
|
|
: #{ f ; parsing
|
|
|
|
: }# 2unlist swap rect> swons ; parsing
|
|
|
|
|
2004-08-03 02:08:11 -04:00
|
|
|
! Do not execute parsing word
|
2005-01-13 19:49:47 -05:00
|
|
|
: POSTPONE: ( -- ) scan-word swons ; parsing
|
2004-08-03 02:08:11 -04:00
|
|
|
|
2004-07-22 19:48:50 -04:00
|
|
|
: :
|
|
|
|
#! Begin a word definition. Word name follows.
|
2004-12-11 18:18:43 -05:00
|
|
|
CREATE [ define-compound ] [ ] "in-definition" on ; parsing
|
2004-07-22 19:48:50 -04:00
|
|
|
|
|
|
|
: ;
|
|
|
|
#! End a word definition.
|
2004-12-11 18:18:43 -05:00
|
|
|
"in-definition" off reverse swap call ; parsing
|
2004-07-22 19:48:50 -04:00
|
|
|
|
2004-09-28 00:24:36 -04:00
|
|
|
! Symbols
|
2004-11-28 19:07:24 -05:00
|
|
|
: SYMBOL:
|
|
|
|
#! A symbol is a word that pushes itself when executed.
|
|
|
|
CREATE define-symbol ; parsing
|
2004-09-28 00:24:36 -04:00
|
|
|
|
2004-10-01 22:02:54 -04:00
|
|
|
: \
|
|
|
|
#! Parsed as a piece of code that pushes a word on the stack
|
|
|
|
#! \ foo ==> [ foo ] car
|
2005-01-13 19:49:47 -05:00
|
|
|
scan-word unit swons \ car swons ; parsing
|
2004-10-01 22:02:54 -04:00
|
|
|
|
2004-07-22 19:48:50 -04:00
|
|
|
! Vocabularies
|
2004-11-28 19:07:24 -05:00
|
|
|
: DEFER:
|
|
|
|
#! Create a word with no definition. Used for mutually
|
|
|
|
#! recursive words.
|
|
|
|
CREATE drop ; parsing
|
2005-01-14 12:01:48 -05:00
|
|
|
|
2004-11-26 22:23:57 -05:00
|
|
|
: FORGET: scan-word forget ; parsing
|
|
|
|
|
2004-11-28 19:07:24 -05:00
|
|
|
: USE:
|
|
|
|
#! Add vocabulary to search path.
|
|
|
|
scan "use" cons@ ; parsing
|
2005-01-14 12:01:48 -05:00
|
|
|
|
2004-11-28 19:07:24 -05:00
|
|
|
: IN:
|
|
|
|
#! Set vocabulary for new definitions.
|
|
|
|
scan dup "use" cons@ "in" set ; parsing
|
2004-07-22 19:48:50 -04:00
|
|
|
|
2004-08-20 18:48:08 -04:00
|
|
|
! Char literal
|
2005-01-13 19:49:47 -05:00
|
|
|
: CHAR: ( -- ) next-word-ch parse-ch swons ; parsing
|
2004-08-20 18:48:08 -04:00
|
|
|
|
|
|
|
! String literal
|
2004-07-22 19:48:50 -04:00
|
|
|
: parse-string ( -- )
|
|
|
|
next-ch dup CHAR: " = [
|
|
|
|
drop
|
|
|
|
] [
|
2004-11-11 15:15:43 -05:00
|
|
|
parse-ch , parse-string
|
2004-07-22 19:48:50 -04:00
|
|
|
] ifte ;
|
|
|
|
|
|
|
|
: "
|
|
|
|
#! Note the ugly hack to carry the new value of 'pos' from
|
2004-11-11 15:15:43 -05:00
|
|
|
#! the make-string scope up to the original scope.
|
|
|
|
[ parse-string "col" get ] make-string
|
2005-01-13 19:49:47 -05:00
|
|
|
swap "col" set swons ; parsing
|
|
|
|
|
2004-07-22 19:48:50 -04:00
|
|
|
! Comments
|
2004-11-25 21:08:09 -05:00
|
|
|
: (
|
|
|
|
#! Stack comment.
|
|
|
|
")" until parsed-stack-effect ; parsing
|
2004-08-29 01:50:34 -04:00
|
|
|
|
2004-11-25 21:08:09 -05:00
|
|
|
: !
|
|
|
|
#! EOL comment.
|
|
|
|
until-eol drop ; parsing
|
2004-08-29 01:50:34 -04:00
|
|
|
|
2004-11-25 21:08:09 -05:00
|
|
|
: #!
|
|
|
|
#! Documentation comment.
|
|
|
|
until-eol parsed-documentation ; parsing
|
2004-08-03 02:08:11 -04:00
|
|
|
|
2004-07-22 19:48:50 -04:00
|
|
|
! Reading numbers in other bases
|
|
|
|
|
2005-01-13 19:49:47 -05:00
|
|
|
: (BASE) ( base -- )
|
2004-07-22 19:48:50 -04:00
|
|
|
#! Read a number in a specific base.
|
2005-01-13 19:49:47 -05:00
|
|
|
scan swap base> swons ;
|
2004-07-22 19:48:50 -04:00
|
|
|
|
2005-01-13 19:49:47 -05:00
|
|
|
: HEX: 16 (BASE) ; parsing
|
|
|
|
: DEC: 10 (BASE) ; parsing
|
|
|
|
: OCT: 8 (BASE) ; parsing
|
|
|
|
: BIN: 2 (BASE) ; parsing
|