library/platform/native/parser.factor

   1 ! :folding=indent:collapseFolds=1:
   2
   3 ! $Id$
   4 !
   5 ! Copyright (C) 2004 Slava Pestov.
   6 !
   7 ! Redistribution and use in source and binary forms, with or without
   8 ! modification, are permitted provided that the following conditions are met:
   9 !
  10 ! 1. Redistributions of source code must retain the above copyright notice,
  11 !    this list of conditions and the following disclaimer.
  12 !
  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.
  16 !
  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.
  27
  28 IN: parser
  29 USE: arithmetic
  30 USE: combinators
  31 USE: errors
  32 USE: kernel
  33 USE: lists
  34 USE: logic
  35 USE: namespaces
  36 USE: stack
  37 USE: strings
  38 USE: words
  39 USE: vocabularies
  40 USE: unparser
  41
  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
  47 !
  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.
  51
  52 : parsing? ( word -- ? )
  53     dup word? [
  54         "parsing" swap word-property
  55     ] [
  56         drop f
  57     ] ifte ;
  58
  59 : parsing ( -- )
  60     "cross-compiling" get [
  61         t "parsing" word set-word-property
  62     ] unless ; parsing
  63
  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@ ;
  69
  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 ;
  74
  75 : ch-dispatch? ( -- ? )
  76     #! Hard-coded for now. Make this customizable later.
  77     #! A 'dispatch' is a character that is treated as its
  78     #! own word, eg:
  79     #!
  80     #! "hello world"
  81     #!
  82     #! Will call the parsing word ".
  83     ch "\"" str-contains? ;
  84
  85 : (scan) ( -- start end )
  86     skip-blank "pos" get
  87     end? [
  88         dup
  89     ] [
  90         ch-dispatch? [ advance ] [ skip-word ] ifte "pos" get
  91     ] ifte ;
  92
  93 : scan ( -- str )
  94     (scan) 2dup = [ 2drop f ] [ "line" get substring ] ifte ;
  95
  96 : parse-word ( str -- obj )
  97     dup "use" get search dup [
  98         nip
  99     ] [
 100         drop str>fixnum
 101     ] ifte ;
 102
 103 : parsed| ( obj -- )
 104     #! Some ugly ugly code to handle [ a | b ] expressions.
 105     >r nreverse dup last* r> swap set-cdr swons ;
 106
 107 : expect-] ( -- )
 108     scan "]" = not [ "Expected ]" throw ] when ;
 109
 110 : parsed ( obj -- )
 111     over "|" = [ nip parsed| expect-] ] [ swons ] ifte ;
 112
 113 : number, ( num -- )
 114     str>fixnum parsed ;
 115
 116 : word, ( str -- )
 117     [
 118         parse-word dup parsing? [ execute ] [ parsed ] ifte
 119     ] when* ;
 120
 121 : (parse) <parsing [ end? not ] [ scan word, ] while parsing> ;
 122
 123 : parse ( str -- code )
 124     #! Parse the string into a parse tree that can be executed.
 125     f swap (parse) nreverse ;
 126
 127 : eval ( "X" -- X )
 128     parse call ;
 129
 130 ! Used by parsing words
 131 : ch-search ( ch -- index )
 132     "pos" get "line" get rot index-of* ;
 133
 134 : (until) ( index -- str )
 135     "pos" get swap dup succ "pos" set "line" get substring ;
 136
 137 : until ( ch -- str )
 138     ch-search (until) ;
 139
 140 : until-eol ( -- str )
 141     "line" get str-length (until) ;
 142
 143 : next-ch ( -- ch )
 144     end? [ "Unexpected EOF" throw ] [ ch advance ] ifte ;