strings.parser: remove parse-short-string, everyone should parse-string.
parent
42c56a2de1
commit
4d83867cb4
|
@ -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! ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 } ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue