multiline: pass the lexer around instead of using namespaces all the time.

db4
John Benediktsson 2014-05-19 21:26:59 -07:00
parent afdec2de61
commit 786793e145
1 changed files with 44 additions and 39 deletions

View File

@ -1,25 +1,25 @@
! Copyright (C) 2007 Daniel Ehrenberg ! Copyright (C) 2007 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: namespaces make parser lexer kernel sequences words USING: accessors combinators kernel lexer locals make math
quotations math accessors locals ; namespaces parser quotations sequences words ;
IN: multiline IN: multiline
ERROR: bad-heredoc identifier ; ERROR: bad-heredoc identifier ;
<PRIVATE <PRIVATE
: rest-of-line ( -- seq ) : rest-of-line ( lexer -- seq )
lexer get [ line-text>> ] [ column>> ] bi tail ; [ line-text>> ] [ column>> ] bi tail ;
: next-line-text ( -- str ) : next-line-text ( lexer -- str )
lexer get [ next-line ] [ line-text>> ] bi ; [ next-line ] [ line-text>> ] bi ;
: (parse-here) ( -- ) : (parse-here) ( lexer -- )
next-line-text [ dup next-line-text [
dup ";" = dup ";" =
[ drop lexer get next-line ] [ drop next-line ]
[ % "\n" % (parse-here) ] if [ % CHAR: \n , (parse-here) ] if
] [ ";" throw-unexpected-eof ] if* ; ] [ drop ";" throw-unexpected-eof ] if* ;
PRIVATE> PRIVATE>
@ -27,7 +27,8 @@ ERROR: text-found-before-eol string ;
: parse-here ( -- str ) : parse-here ( -- str )
[ [
rest-of-line dup [ drop ] [ text-found-before-eol ] if-empty lexer get
dup rest-of-line [ text-found-before-eol ] unless-empty
(parse-here) (parse-here)
] "" make but-last ; ] "" make but-last ;
@ -41,59 +42,63 @@ SYNTAX: STRING:
: lexer-eof? ( lexer -- ? ) : lexer-eof? ( lexer -- ? )
[ line>> ] [ text>> length ] bi <= ; [ line>> ] [ text>> length ] bi <= ;
:: (scan-multiline-string) ( i end -- j ) :: (scan-multiline-string) ( i end lexer -- j )
lexer get line-text>> :> text lexer line-text>> :> text
lexer get lexer-eof? [ lexer lexer-eof? [
end text i start* [| j | end text i start* [| j |
i j text subseq % j end length + i j text subseq % j end length +
] [ ] [
text i short tail % CHAR: \n , text i short tail % CHAR: \n ,
lexer get next-line lexer next-line
0 end (scan-multiline-string) 0 end lexer (scan-multiline-string)
] if* ] if*
] [ end throw-unexpected-eof ] if ; ] [ end throw-unexpected-eof ] if ;
:: (parse-multiline-string) ( end-text skip-n-chars -- str ) :: (parse-multiline-string) ( end-text lexer skip-n-chars -- str )
[ [
lexer get lexer
[ skip-n-chars + end-text (scan-multiline-string) ] [ skip-n-chars + end-text lexer (scan-multiline-string) ]
change-column drop change-column drop
] "" make ; ] "" make ;
:: advance-same-line ( text -- ) : advance-same-line ( lexer text -- )
lexer get [ text length + ] change-column drop ; length [ + ] curry change-column drop ;
:: (parse-til-line-begins) ( begin-text -- ) :: (parse-til-line-begins) ( begin-text lexer -- )
lexer get still-parsing? [ lexer still-parsing? [
lexer get line-text>> begin-text sequence= [ lexer line-text>> begin-text sequence= [
begin-text advance-same-line lexer begin-text advance-same-line
] [ ] [
lexer get line-text>> % "\n" % lexer line-text>> % CHAR: \n ,
lexer get next-line lexer next-line
begin-text (parse-til-line-begins) begin-text lexer (parse-til-line-begins)
] if ] if
] [ ] [
begin-text bad-heredoc begin-text bad-heredoc
] if ; ] if ;
: parse-til-line-begins ( begin-text -- seq ) : parse-til-line-begins ( begin-text lexer -- seq )
[ (parse-til-line-begins) ] "" make ; [ (parse-til-line-begins) ] "" make ;
PRIVATE> PRIVATE>
: parse-multiline-string ( end-text -- str ) : parse-multiline-string ( end-text -- str )
1 (parse-multiline-string) ; lexer get 1 (parse-multiline-string) ;
SYNTAX: /* "*/" parse-multiline-string drop ; SYNTAX: /* "*/" parse-multiline-string drop ;
SYNTAX: HEREDOC: SYNTAX: HEREDOC:
lexer get skip-blank lexer get {
rest-of-line [ skip-blank ]
lexer get next-line [ rest-of-line ]
parse-til-line-begins suffix! ; [ next-line ]
[ parse-til-line-begins ]
} cleave suffix! ;
SYNTAX: DELIMITED: SYNTAX: DELIMITED:
lexer get skip-blank lexer get {
rest-of-line [ skip-blank ]
lexer get next-line [ rest-of-line ]
0 (parse-multiline-string) suffix! ; [ next-line ]
[ 0 (parse-multiline-string) ]
} cleave suffix! ;