strings.parser: remove parse-short-string, everyone should parse-string.

locals-and-roots
John Benediktsson 2016-04-04 14:54:06 -07:00
parent 42c56a2de1
commit 4d83867cb4
5 changed files with 14 additions and 36 deletions

View File

@ -6,7 +6,7 @@ strings.parser vocabs words ;
<< "alien.arrays" require >> ! needed for bootstrap
IN: alien.syntax
SYNTAX: DLL" lexer get skip-blank parse-short-string dlopen suffix! ;
SYNTAX: DLL" lexer get skip-blank parse-string dlopen suffix! ;
SYNTAX: ALIEN: 16 scan-base <alien> suffix! ;

View File

@ -197,6 +197,6 @@ UNION: abstract-inet inet inet4 inet6 ;
M: abstract-inet >secure-addr <secure> ;
! Literal syntax
SYNTAX: URL" lexer get skip-blank parse-short-string >url suffix! ;
SYNTAX: URL" lexer get skip-blank parse-string >url suffix! ;
{ "urls" "prettyprint" } "urls.prettyprint" require-when

View File

@ -70,28 +70,6 @@ PRIVATE>
<PRIVATE
: (parse-short-string) ( accum str -- accum m )
{ sbuf slice } declare
dup [ "\"\\" member? ] find [
[ cut-slice [ append! ] dip rest-slice ] dip
CHAR: " = [
from>>
] [
next-escape [ suffix! ] dip (parse-short-string)
] if
] [
"Unterminated string" throw
] if* ;
PRIVATE>
: parse-short-string ( -- str )
SBUF" " clone lexer get [
swap tail-slice (parse-short-string) [ "" like ] dip
] change-lexer-column ;
<PRIVATE
: lexer-subseq ( i lexer -- before )
{ fixnum lexer } declare
[ [ column>> ] [ line-text>> ] bi swapd subseq ]
@ -126,7 +104,7 @@ PRIVATE>
[ column>> ] [ line-text>> ] bi
[ "\"\\" member? ] find-from ;
DEFER: (parse-full-string)
DEFER: (parse-string)
: parse-found-token ( accum lexer i elt -- )
{ sbuf lexer fixnum fixnum } declare
@ -135,12 +113,12 @@ DEFER: (parse-full-string)
dup dup [ next-char ] bi@
[ [ pick push ] bi@ ]
[ drop 2dup next-line% ] if*
(parse-full-string)
(parse-string)
] [
advance-char drop
] if ;
: (parse-full-string) ( accum lexer -- )
: (parse-string) ( accum lexer -- )
{ sbuf lexer } declare
dup still-parsing? [
dup find-next-token [
@ -148,13 +126,13 @@ DEFER: (parse-full-string)
] [
drop 2dup next-line%
CHAR: \n pick push
(parse-full-string)
(parse-string)
] if*
] [
"Unterminated string" throw
] if ;
: rewind-on-error ( quot -- )
: rewind-lexer-on-error ( quot -- )
lexer get [ line>> ] [ line-text>> ] [ column>> ] tri
[
lexer get [ column<< ] [ line-text<< ] [ line<< ] tri
@ -163,9 +141,9 @@ DEFER: (parse-full-string)
PRIVATE>
: parse-full-string ( -- str )
: parse-string ( -- str )
[
SBUF" " clone [
lexer get (parse-full-string)
lexer get (parse-string)
] keep unescape-string
] rewind-on-error ;
] rewind-lexer-on-error ;

View File

@ -88,14 +88,14 @@ IN: bootstrap.syntax
} cond suffix!
] define-core-syntax
"\"" [ parse-full-string suffix! ] define-core-syntax
"\"" [ parse-string suffix! ] define-core-syntax
"SBUF\"" [
lexer get skip-blank parse-full-string >sbuf suffix!
lexer get skip-blank parse-string >sbuf suffix!
] define-core-syntax
"P\"" [
lexer get skip-blank parse-short-string <pathname> suffix!
lexer get skip-blank parse-string <pathname> suffix!
] define-core-syntax
"[" [ parse-quotation suffix! ] define-core-syntax

View File

@ -53,7 +53,7 @@ TUPLE: exec-name < identity-tuple name ;
MEMO: exec-name ( string -- name ) name \ exec-name boa ;
SYNTAX: exec" lexer get skip-blank parse-short-string exec-name suffix! ;
SYNTAX: exec" lexer get skip-blank parse-string exec-name suffix! ;
ERROR: unbound-name { name name } ;