lexer: more type checking.
parent
f79665805c
commit
98abd95040
|
@ -1,6 +1,6 @@
|
|||
USING: help.markup help.syntax kernel lexer.private math
|
||||
sequences strings words quotations ;
|
||||
IN: lexer
|
||||
USING: help.markup help.syntax kernel math sequences strings
|
||||
words quotations ;
|
||||
|
||||
HELP: lexer
|
||||
{ $var-description "Stores the current " { $link lexer } " instance." }
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays combinators continuations io kernel
|
||||
math math.parser namespaces sequences sequences.private
|
||||
source-files.errors strings vectors ;
|
||||
kernel.private math math.parser namespaces sequences
|
||||
sequences.private source-files.errors strings vectors ;
|
||||
IN: lexer
|
||||
|
||||
TUPLE: lexer
|
||||
|
@ -15,7 +15,13 @@ TUPLE: lexer
|
|||
|
||||
TUPLE: lexer-parsing-word word line line-text column ;
|
||||
|
||||
ERROR: not-a-lexer obj ;
|
||||
|
||||
: check-lexer ( lexer -- lexer )
|
||||
dup lexer? [ not-a-lexer ] unless ; inline
|
||||
|
||||
: next-line ( lexer -- )
|
||||
check-lexer
|
||||
dup [ line>> ] [ text>> ] bi ?nth "" or
|
||||
[ >>line-text ] [ length >>line-length ] bi
|
||||
[ 1 + ] change-line
|
||||
|
@ -23,13 +29,13 @@ TUPLE: lexer-parsing-word word line line-text column ;
|
|||
drop ;
|
||||
|
||||
: push-parsing-word ( word -- )
|
||||
lexer get [
|
||||
lexer get check-lexer [
|
||||
[ line>> ] [ line-text>> ] [ column>> ] tri
|
||||
lexer-parsing-word boa
|
||||
] [ parsing-words>> push ] bi ;
|
||||
|
||||
: pop-parsing-word ( -- )
|
||||
lexer get parsing-words>> pop* ;
|
||||
lexer get check-lexer parsing-words>> pop* ;
|
||||
|
||||
: new-lexer ( text class -- lexer )
|
||||
new
|
||||
|
@ -46,10 +52,15 @@ ERROR: unexpected want got ;
|
|||
: forbid-tab ( c -- c )
|
||||
[ CHAR: \t eq? [ "[space]" "[tab]" unexpected ] when ] keep ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: skip ( i seq ? -- n )
|
||||
{ fixnum string boolean } declare
|
||||
over length [
|
||||
[ swap forbid-tab CHAR: \s eq? xor ] curry find-from drop
|
||||
] dip or ; inline
|
||||
] dip or ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: change-lexer-column ( lexer quot -- )
|
||||
[ [ column>> ] [ line-text>> ] bi ] prepose keep column<< ; inline
|
||||
|
@ -64,15 +75,15 @@ GENERIC: skip-word ( lexer -- )
|
|||
<PRIVATE
|
||||
|
||||
: quote? ( column text -- ? )
|
||||
nth CHAR: " eq? ; inline
|
||||
{ fixnum string } declare nth CHAR: " eq? ;
|
||||
|
||||
: shebang? ( column text -- ? )
|
||||
swap zero? [
|
||||
{ fixnum string } declare swap zero? [
|
||||
dup length 1 > [
|
||||
dup first-unsafe CHAR: # =
|
||||
[ second-unsafe CHAR: ! = ] [ drop f ] if
|
||||
] [ drop f ] if
|
||||
] [ drop f ] if ; inline
|
||||
] [ drop f ] if ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
|
@ -86,13 +97,13 @@ M: lexer skip-word
|
|||
] change-lexer-column ;
|
||||
|
||||
: still-parsing? ( lexer -- ? )
|
||||
[ line>> ] [ text>> length ] bi <= ; inline
|
||||
check-lexer [ line>> ] [ text>> length ] bi <= ;
|
||||
|
||||
: still-parsing-line? ( lexer -- ? )
|
||||
[ column>> ] [ line-length>> ] bi < ; inline
|
||||
check-lexer [ column>> ] [ line-length>> ] bi < ;
|
||||
|
||||
: (parse-token) ( lexer -- str )
|
||||
{
|
||||
check-lexer {
|
||||
[ column>> ]
|
||||
[ skip-word ]
|
||||
[ column>> ]
|
||||
|
|
Loading…
Reference in New Issue