1 ! :folding=indent:collapseFolds=1:
5 ! Copyright (C) 2004 Slava Pestov.
7 ! Redistribution and use in source and binary forms, with or without
8 ! modification, are permitted provided that the following conditions are met:
10 ! 1. Redistributions of source code must retain the above copyright notice,
11 ! this list of conditions and the following disclaimer.
13 ! 2. Redistributions in binary form must reproduce the above copyright notice,
14 ! this list of conditions and the following disclaimer in the documentation
15 ! and/or other materials provided with the distribution.
17 ! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
18 ! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
19 ! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
20 ! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
21 ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
22 ! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
23 ! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
24 ! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
25 ! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
26 ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
42 ! The parser uses a number of variables:
43 ! line - the line being parsed
44 ! pos - position in the line
45 ! use - list of vocabularies
46 ! in - vocabulary for new words
48 ! When a token is scanned, it is searched for in the 'use' list
49 ! of vocabularies. If it is a parsing word, it is executed
50 ! immediately. Otherwise it is appended to the parse tree.
52 : parsing? ( word -- ? )
54 "parsing" swap word-property
60 "cross-compiling" get [
61 t "parsing" word set-word-property
64 : <parsing "line" set 0 "pos" set ;
65 : parsing> "line" off "pos" off ;
66 : end? ( -- ? ) "pos" get "line" get str-length >= ;
67 : ch ( -- ch ) "pos" get "line" get str-nth ;
68 : advance ( -- ) "pos" succ@ ;
70 : ch-blank? ( -- ? ) end? [ f ] [ ch blank? ] ifte ;
71 : skip-blank ( -- ) [ ch-blank? ] [ advance ] while ;
72 : ch-word? ( -- ? ) end? [ f ] [ ch blank? not ] ifte ;
73 : skip-word ( -- ) [ ch-word? ] [ advance ] while ;
75 : ch-dispatch? ( -- ? )
76 #! Hard-coded for now. Make this customizable later.
77 #! A 'dispatch' is a character that is treated as its
82 #! Will call the parsing word ".
83 ch "\"" str-contains? ;
85 : (scan) ( -- start end )
90 ch-dispatch? [ advance ] [ skip-word ] ifte "pos" get
94 (scan) 2dup = [ 2drop f ] [ "line" get substring ] ifte ;
96 : parse-word ( str -- obj )
97 dup "use" get search dup [
104 #! Some ugly ugly code to handle [ a | b ] expressions.
105 >r nreverse dup last* r> swap set-cdr swons ;
109 "Expected " swap cat2 throw
115 over "|" = [ nip parsed| "]" expect ] [ swons ] ifte ;
122 parse-word dup parsing? [ execute ] [ parsed ] ifte
125 : (parse) <parsing [ end? not ] [ scan word, ] while parsing> ;
127 : parse ( str -- code )
128 #! Parse the string into a parse tree that can be executed.
129 f swap (parse) nreverse ;
134 ! Used by parsing words
135 : ch-search ( ch -- index )
136 "pos" get "line" get rot index-of* ;
138 : (until) ( index -- str )
139 "pos" get swap dup succ "pos" set "line" get substring ;
141 : until ( ch -- str )
144 : until-eol ( -- str )
145 "line" get str-length (until) ;
148 end? [ "Unexpected EOF" throw ] [ ch advance ] ifte ;