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