steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

lexer: change line-text to always be a string.

db4
John Benediktsson 2014-05-19 14:31:08 -07:00
parent a9d1e320d2
commit a0c5e492dd
1 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
core/lexer/lexer.factor
View File

@ -1,14 +1,14 @@
! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff. ! Copyright (C) 2008, 2010 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators continuations io kernel USING: accessors arrays combinators continuations io kernel
math math.parser namespaces sequences source-files.errors math math.parser namespaces sequences sequences.private
strings vectors ; source-files.errors strings vectors ;
IN: lexer IN: lexer
TUPLE: lexer TUPLE: lexer
{ text array } { text array }
{ line fixnum } { line fixnum }
{ line-text maybe{ string } } { line-text string }
{ line-length fixnum } { line-length fixnum }
{ column fixnum } { column fixnum }
{ parsing-words vector } ; { parsing-words vector } ;
@ -16,7 +16,7 @@ TUPLE: lexer
TUPLE: lexer-parsing-word word line line-text column ; TUPLE: lexer-parsing-word word line line-text column ;
: next-line ( lexer -- ) : next-line ( lexer -- )
dup [ line>> ] [ text>> ] bi ?nth dup [ line>> ] [ text>> ] bi ?nth "" or
[ >>line-text ] [ length >>line-length ] bi [ >>line-text ] [ length >>line-length ] bi
[ 1 + ] change-line [ 1 + ] change-line
0 >>column 0 >>column
@ -49,15 +49,14 @@ ERROR: unexpected want got ;
: skip ( i seq ? -- n ) : skip ( i seq ? -- n )
over length [ over length [
[ swap forbid-tab CHAR: \s eq? xor ] curry find-from drop [ swap forbid-tab CHAR: \s eq? xor ] curry find-from drop
] dip or ; ] dip or ; inline
: change-lexer-column ( lexer quot -- ) : change-lexer-column ( lexer quot -- )
[ [ column>> ] [ line-text>> ] bi ] prepose keep [ [ column>> ] [ line-text>> ] bi ] prepose keep column<< ; inline
column<< ; inline
GENERIC: skip-blank ( lexer -- ) GENERIC: skip-blank ( lexer -- )
M: lexer skip-blank ( lexer -- ) M: lexer skip-blank
[ t skip ] change-lexer-column ; [ t skip ] change-lexer-column ;
GENERIC: skip-word ( lexer -- ) GENERIC: skip-word ( lexer -- )
@ -68,11 +67,16 @@ GENERIC: skip-word ( lexer -- )
nth CHAR: " eq? ; inline nth CHAR: " eq? ; inline
: shebang? ( column text -- ? ) : shebang? ( column text -- ? )
swap zero? [ "#!" head? ] [ drop f ] if ; inline swap zero? [
dup length 1 > [
dup first-unsafe CHAR: # =
[ second-unsafe CHAR: ! = ] [ drop f ] if
] [ drop f ] if
] [ drop f ] if ; inline
PRIVATE> PRIVATE>
M: lexer skip-word ( lexer -- ) M: lexer skip-word
[ [
{ {
{ [ 2dup quote? ] [ drop 1 + ] } { [ 2dup quote? ] [ drop 1 + ] }
@ -82,10 +86,10 @@ M: lexer skip-word ( lexer -- )
] change-lexer-column ; ] change-lexer-column ;
: still-parsing? ( lexer -- ? ) : still-parsing? ( lexer -- ? )
[ line>> ] [ text>> length ] bi <= ; [ line>> ] [ text>> length ] bi <= ; inline
: still-parsing-line? ( lexer -- ? ) : still-parsing-line? ( lexer -- ? )
[ column>> ] [ line-length>> ] bi < ; [ column>> ] [ line-length>> ] bi < ; inline
: (parse-token) ( lexer -- str ) : (parse-token) ( lexer -- str )
{ {
@ -142,8 +146,8 @@ M: lexer-error error-line [ error>> error-line ] [ line>> ] bi or ;
: simple-lexer-dump ( error -- ) : simple-lexer-dump ( error -- )
[ line>> number>string ": " append ] [ line>> number>string ": " append ]
[ line-text>> "" or ] [ line-text>> ]
[ column>> 0 or ] tri [ column>> ] tri
pick length + CHAR: \s <string> pick length + CHAR: \s <string>
[ write ] [ print ] [ write "^" print ] tri* ; [ write ] [ print ] [ write "^" print ] tri* ;
@ -153,7 +157,7 @@ M: lexer-error error-line [ error>> error-line ] [ line>> ] bi or ;
over line>> number>string length over line>> number>string length
CHAR: \s pad-head CHAR: \s pad-head
": " append write ": " append write
] [ line-text>> "" or print ] bi ] [ line-text>> print ] bi
simple-lexer-dump ; simple-lexer-dump ;
: parsing-word-lexer-dump ( error parsing-word -- ) : parsing-word-lexer-dump ( error parsing-word -- )