strings.parser: using type declarations.
parent
529ade12df
commit
f79665805c
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
|
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays assocs combinators kernel lexer
|
USING: accessors arrays assocs combinators kernel kernel.private
|
||||||
math math.parser namespaces sbufs sequences splitting strings ;
|
lexer math math.parser namespaces sbufs sequences splitting
|
||||||
|
strings ;
|
||||||
IN: strings.parser
|
IN: strings.parser
|
||||||
|
|
||||||
ERROR: bad-escape char ;
|
ERROR: bad-escape char ;
|
||||||
|
@ -48,13 +49,14 @@ name>char-hook [
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: (unescape-string) ( accum str i/f -- accum )
|
: (unescape-string) ( accum str i/f -- accum )
|
||||||
|
{ sbuf object object } declare
|
||||||
[
|
[
|
||||||
cut-slice [ over push-all ] dip
|
cut-slice [ over push-all ] dip
|
||||||
rest-slice next-escape [ over push ] dip
|
rest-slice next-escape [ over push ] dip
|
||||||
CHAR: \\ over index (unescape-string)
|
CHAR: \\ over index (unescape-string)
|
||||||
] [
|
] [
|
||||||
over push-all
|
over push-all
|
||||||
] if* ; inline recursive
|
] if* ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
@ -66,6 +68,7 @@ PRIVATE>
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: (parse-string) ( accum str -- accum m )
|
: (parse-string) ( accum str -- accum m )
|
||||||
|
{ sbuf slice } declare
|
||||||
dup [ "\"\\" member? ] find [
|
dup [ "\"\\" member? ] find [
|
||||||
[ cut-slice [ over push-all ] dip rest-slice ] dip
|
[ cut-slice [ over push-all ] dip rest-slice ] dip
|
||||||
CHAR: " = [
|
CHAR: " = [
|
||||||
|
@ -75,7 +78,7 @@ PRIVATE>
|
||||||
] if
|
] if
|
||||||
] [
|
] [
|
||||||
"Unterminated string" throw
|
"Unterminated string" throw
|
||||||
] if* ; inline recursive
|
] if* ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
@ -88,21 +91,26 @@ PRIVATE>
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: lexer-subseq ( i lexer -- before )
|
: lexer-subseq ( i lexer -- before )
|
||||||
|
{ fixnum lexer } declare
|
||||||
[ [ column>> ] [ line-text>> ] bi swapd subseq ]
|
[ [ column>> ] [ line-text>> ] bi swapd subseq ]
|
||||||
[ column<< ] 2bi ;
|
[ column<< ] 2bi ;
|
||||||
|
|
||||||
: rest-of-line ( lexer -- seq )
|
: rest-of-line ( lexer -- seq )
|
||||||
|
{ lexer } declare
|
||||||
[ line-text>> ] [ column>> ] bi tail-slice ;
|
[ line-text>> ] [ column>> ] bi tail-slice ;
|
||||||
|
|
||||||
: current-char ( lexer -- ch/f )
|
: current-char ( lexer -- ch/f )
|
||||||
|
{ lexer } declare
|
||||||
[ column>> ] [ line-text>> ] bi ?nth ;
|
[ column>> ] [ line-text>> ] bi ?nth ;
|
||||||
|
|
||||||
: advance-char ( lexer -- )
|
: advance-char ( lexer -- )
|
||||||
|
{ lexer } declare
|
||||||
[ 1 + ] change-column drop ;
|
[ 1 + ] change-column drop ;
|
||||||
|
|
||||||
ERROR: escaped-char-expected ;
|
ERROR: escaped-char-expected ;
|
||||||
|
|
||||||
: next-char ( lexer -- ch )
|
: next-char ( lexer -- ch )
|
||||||
|
{ lexer } declare
|
||||||
dup still-parsing-line? [
|
dup still-parsing-line? [
|
||||||
[ current-char ] [ advance-char ] bi
|
[ current-char ] [ advance-char ] bi
|
||||||
] [
|
] [
|
||||||
|
@ -110,20 +118,25 @@ ERROR: escaped-char-expected ;
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: lexer-head? ( lexer string -- ? )
|
: lexer-head? ( lexer string -- ? )
|
||||||
|
{ lexer string } declare
|
||||||
[ rest-of-line ] dip head? ;
|
[ rest-of-line ] dip head? ;
|
||||||
|
|
||||||
: advance-lexer ( lexer n -- )
|
: advance-lexer ( lexer n -- )
|
||||||
[ + ] curry change-column drop ; inline
|
{ lexer fixnum } declare
|
||||||
|
[ + ] curry change-column drop ;
|
||||||
|
|
||||||
: find-next-token ( lexer ch -- i elt )
|
: find-next-token ( lexer ch -- i elt )
|
||||||
|
{ lexer fixnum } declare
|
||||||
[ [ column>> ] [ line-text>> ] bi ] dip
|
[ [ column>> ] [ line-text>> ] bi ] dip
|
||||||
CHAR: \ 2array [ member? ] curry find-from ;
|
CHAR: \ 2array [ member? ] curry find-from ;
|
||||||
|
|
||||||
: next-line% ( accum lexer -- )
|
: next-line% ( accum lexer -- )
|
||||||
|
{ sbuf lexer } declare
|
||||||
[ rest-of-line swap push-all ]
|
[ rest-of-line swap push-all ]
|
||||||
[ next-line CHAR: \n swap push ] 2bi ; inline
|
[ next-line CHAR: \n swap push ] 2bi ;
|
||||||
|
|
||||||
: take-double-quotes ( lexer -- string )
|
: take-double-quotes ( lexer -- string )
|
||||||
|
{ lexer } declare
|
||||||
dup current-char CHAR: " = [
|
dup current-char CHAR: " = [
|
||||||
dup [ column>> ] [ line-text>> ] bi
|
dup [ column>> ] [ line-text>> ] bi
|
||||||
[ CHAR: " = not ] find-from drop [
|
[ CHAR: " = not ] find-from drop [
|
||||||
|
@ -135,15 +148,17 @@ ERROR: escaped-char-expected ;
|
||||||
] [ drop f ] if ;
|
] [ drop f ] if ;
|
||||||
|
|
||||||
: end-string-parse ( accum lexer delimiter -- )
|
: end-string-parse ( accum lexer delimiter -- )
|
||||||
|
{ sbuf lexer string } declare
|
||||||
length 3 = [
|
length 3 = [
|
||||||
take-double-quotes 3 tail-slice swap push-all
|
take-double-quotes 3 tail-slice swap push-all
|
||||||
] [
|
] [
|
||||||
advance-char drop
|
advance-char drop
|
||||||
] if ; inline
|
] if ;
|
||||||
|
|
||||||
DEFER: (parse-multiline-string)
|
DEFER: (parse-multiline-string)
|
||||||
|
|
||||||
: parse-found-token ( accum lexer string i token -- )
|
: parse-found-token ( accum lexer string i token -- )
|
||||||
|
{ sbuf lexer string fixnum fixnum } declare
|
||||||
[ [ 2over ] dip swap lexer-subseq swap push-all ] dip
|
[ [ 2over ] dip swap lexer-subseq swap push-all ] dip
|
||||||
CHAR: \ = [
|
CHAR: \ = [
|
||||||
2over next-char swap push
|
2over next-char swap push
|
||||||
|
@ -156,11 +171,12 @@ DEFER: (parse-multiline-string)
|
||||||
2over next-char swap push
|
2over next-char swap push
|
||||||
(parse-multiline-string)
|
(parse-multiline-string)
|
||||||
] if
|
] if
|
||||||
] if ; inline recursive
|
] if ;
|
||||||
|
|
||||||
ERROR: trailing-characters string ;
|
ERROR: trailing-characters string ;
|
||||||
|
|
||||||
: (parse-multiline-string) ( accum lexer string -- )
|
: (parse-multiline-string) ( accum lexer string -- )
|
||||||
|
{ sbuf lexer fixnum } declare
|
||||||
over still-parsing? [
|
over still-parsing? [
|
||||||
2dup first find-next-token [
|
2dup first find-next-token [
|
||||||
parse-found-token
|
parse-found-token
|
||||||
|
@ -170,7 +186,7 @@ ERROR: trailing-characters string ;
|
||||||
] if*
|
] if*
|
||||||
] [
|
] [
|
||||||
throw-unexpected-eof
|
throw-unexpected-eof
|
||||||
] if ; inline recursive
|
] if ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue