modern: more ws

modern-harvey3
Doug Coleman 2019-10-17 00:02:12 -05:00
parent 721d0c3ea9
commit 155171b828
3 changed files with 17 additions and 12 deletions

View File

@ -1,7 +1,7 @@
! Copyright (C) 2019 Doug Coleman. ! Copyright (C) 2019 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors ascii constructors kernel prettyprint.custom USING: accessors ascii constructors kernel prettyprint.backend
sequences ; prettyprint.custom sequences sequences.private ;
IN: modern.lexer IN: modern.lexer
ERROR: ws-expected string ; ERROR: ws-expected string ;
@ -10,10 +10,14 @@ TUPLE: ws string ;
CONSTRUCTOR: <ws> ws ( string -- ws ) CONSTRUCTOR: <ws> ws ( string -- ws )
dup string>> [ blank? not ] any? [ ws-expected ] when ; dup string>> [ blank? not ] any? [ ws-expected ] when ;
M: ws nth string>> nth ;
M: ws nth-unsafe string>> nth-unsafe ;
M: ws length string>> length ;
! Weird experiment ! Weird experiment
M: ws pprint* ! M: ws pprint*
drop ; ! drop ;
! string>> dup "\"" "\"" pprint-string ; ! string>> dup "\"" "\"" pprint-string ;
TUPLE: lexed tokens ; TUPLE: lexed tokens ;

View File

@ -1,10 +1,10 @@
! Copyright (C) 2016 Doug Coleman. ! Copyright (C) 2016 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators combinators.short-circuit USING: arrays assocs combinators combinators.short-circuit
constructors continuations io.encodings.utf8 io.files kernel make math constructors continuations io.encodings.utf8 io.files kernel
math.order modern.paths modern.slices sequences sequences.extras make math math.order modern.lexer modern.paths modern.slices
sequences.generalizations sets shuffle splitting strings sequences sequences.extras sequences.generalizations sets
syntax.modern unicode vocabs.loader ; shuffle splitting strings syntax.modern unicode vocabs.loader ;
IN: modern IN: modern
ERROR: long-opening-mismatch tag open string n ch ; ERROR: long-opening-mismatch tag open string n ch ;
@ -134,7 +134,7 @@ MACRO:: read-matched ( ch -- quot: ( string n tag -- string n' slice' ) )
2over ?nth-of char: \[ = [ 2over ?nth-of char: \[ = [
[ 1 + ] dip 1 modify-to 2over ?nth-of read-double-matched-bracket [ 1 + ] dip 1 modify-to 2over ?nth-of read-double-matched-bracket
] [ ] [
[ slice-til-eol drop <ws> ] dip swap 2array [ slice-til-eol drop ] dip swap 2array
] if ; ] if ;
: terminator? ( slice -- ? ) : terminator? ( slice -- ? )
@ -364,13 +364,13 @@ DEFER: lex-factor-top*
: read-token-or-whitespace-top ( string n slice -- string n' slice/f ) : read-token-or-whitespace-top ( string n slice -- string n' slice/f )
dup length 0 = [ dup length 0 = [
! [ 1 + ] 2dip drop lex-factor-top ! [ 1 + ] 2dip drop lex-factor-top
merge-slice-til-not-whitespace merge-slice-til-not-whitespace <ws>
] when ; ] when ;
: read-token-or-whitespace-nested ( string n slice -- string n' slice/f ) : read-token-or-whitespace-nested ( string n slice -- string n' slice/f )
dup length 0 = [ dup length 0 = [
! [ 1 + ] 2dip drop lex-factor-nested ! [ 1 + ] 2dip drop lex-factor-nested
merge-slice-til-not-whitespace merge-slice-til-not-whitespace <ws>
] when ; ] when ;
: lex-factor-fallthrough ( string n/f slice/f ch/f -- string n'/f literal ) : lex-factor-fallthrough ( string n/f slice/f ch/f -- string n'/f literal )

View File

@ -17,6 +17,7 @@ ERROR: unexpected-eof string n expected ;
] if ; inline ] if ; inline
: >strings ( seq -- str ) : >strings ( seq -- str )
! [ slice? ] deep-filter
[ dup slice? [ >string ] when ] deep-map ; [ dup slice? [ >string ] when ] deep-map ;
: matching-section-delimiter ( string -- string' ) : matching-section-delimiter ( string -- string' )