modern: Add error checking for enough tokens.
modern.slices had a bug in find-from* where it was taking the length of a quotation instead of the original string.modern-harvey2
parent
083d08878a
commit
5e1295f89e
|
@ -138,12 +138,16 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
|
||||||
[ ")" sequence= ]
|
[ ")" sequence= ]
|
||||||
} 1|| ;
|
} 1|| ;
|
||||||
|
|
||||||
|
ERROR: expected-length-tokens n string length seq ;
|
||||||
|
: ensure-no-false ( n string seq -- n string seq )
|
||||||
|
dup [ length 0 > ] all? [ [ length ] keep expected-length-tokens ] unless ;
|
||||||
|
|
||||||
ERROR: token-expected n string obj ;
|
ERROR: token-expected n string obj ;
|
||||||
ERROR: unexpected-terminator n string slice ;
|
ERROR: unexpected-terminator n string slice ;
|
||||||
: read-lowercase-colon ( n string slice -- n' string lowercase-colon )
|
: read-lowercase-colon ( n string slice -- n' string lowercase-colon )
|
||||||
dup [ char: \: = ] count-tail
|
dup [ char: \: = ] count-tail
|
||||||
'[
|
'[
|
||||||
_ [ lex-factor ] replicate dup [ token-expected ] unless
|
_ [ lex-factor ] replicate ensure-no-false dup [ token-expected ] unless
|
||||||
dup terminator? [ unexpected-terminator ] when
|
dup terminator? [ unexpected-terminator ] when
|
||||||
] dip swap 2array ;
|
] dip swap 2array ;
|
||||||
|
|
||||||
|
@ -214,6 +218,7 @@ ERROR: no-backslash-payload n string slice ;
|
||||||
dup [ char: \\ = ] count-tail
|
dup [ char: \\ = ] count-tail
|
||||||
'[
|
'[
|
||||||
_ [ skip-blank-from slice-til-whitespace drop ] replicate
|
_ [ skip-blank-from slice-til-whitespace drop ] replicate
|
||||||
|
ensure-no-false
|
||||||
dup [ no-backslash-payload ] unless
|
dup [ no-backslash-payload ] unless
|
||||||
] dip swap 2array
|
] dip swap 2array
|
||||||
] when ;
|
] when ;
|
||||||
|
|
|
@ -63,7 +63,7 @@ ERROR: unexpected-end n string ;
|
||||||
next-char-from 2nip ;
|
next-char-from 2nip ;
|
||||||
|
|
||||||
: find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt ? )
|
: find-from* ( ... n seq quot: ( ... elt -- ... ? ) -- ... i elt ? )
|
||||||
[ find-from ] keep
|
[ find-from ] 2keep drop
|
||||||
pick [ drop t ] [ length -rot nip f ] if ; inline
|
pick [ drop t ] [ length -rot nip f ] if ; inline
|
||||||
|
|
||||||
: skip-blank-from ( n string -- n' string )
|
: skip-blank-from ( n string -- n' string )
|
||||||
|
|
Loading…
Reference in New Issue