steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

modern: fix some words.

locals-and-roots
Doug Coleman 2016-06-13 09:38:17 -07:00
parent f92b8ce9b5
commit 890b1e3e34
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
core/modern/modern.factor
View File

@ -120,17 +120,17 @@ M: array collapse-decorators
: whitespace/f? ( ch -- ? ) : whitespace/f? ( ch -- ? )
{ char: \s char: \r char: \n f } member? ; inline { char: \s char: \r char: \n f } member? ; inline
: trailing-upper-after-colon ( string -- ? ) : scoped-colon-name ( string -- string' )
dup [ length 2 - ] keep [ char: \: = ] find-last-from [ 1 + tail ] [ 2drop f ] if ; dup [ length 2 - ] keep [ char: \: = ] find-last-from [ 1 + tail ] [ drop ] if ;
: trailing-upper-after-less-than ( string -- ? ) : scoped-less-than-name ( string -- string' )
dup [ length 2 - ] keep [ char: < = ] find-last-from [ 1 + tail ] [ 2drop f ] if ; dup [ length 2 - ] keep [ char: < = ] find-last-from [ 1 + tail ] [ drop ] if ;
: scoped-upper? ( string -- ? ) : scoped-upper? ( string -- ? )
dup ":" tail? [ dup ":" tail? [
dup length 1 > [ dup length 1 > [
[ [ length 2 - ] keep [ char: \: = ] find-last-from ] keep [ [ length 2 - ] keep [ char: \: = ] find-last-from ] keep
swap [ swap tail strict-upper? ] [ 2drop f ] if swap [ swap tail strict-upper? ] [ nip strict-upper? ] if
] [ ] [
drop t drop t
] if ] if
@ -313,7 +313,7 @@ MACRO:: read-matched ( ch -- quot: ( n string tag -- n' string slice' ) )
: read-upper-colon ( n string string' -- n string obj ) : read-upper-colon ( n string string' -- n string obj )
dup [ trailing-upper-after-colon [ but-last ";" append ";" 2array ] [ ";" 1array ] if* lex-until-top ] dip dup [ scoped-colon-name [ but-last ";" append ";" 2array ] [ ";" 1array ] if* lex-until-top ] dip
1 cut-slice* uppercase-colon-literal make-matched-literal ; 1 cut-slice* uppercase-colon-literal make-matched-literal ;
: read-lower-colon ( n string string' -- n string obj ) : read-lower-colon ( n string string' -- n string obj )
@ -326,7 +326,7 @@ B
merge-slice-til-whitespace { merge-slice-til-whitespace {
{ [ dup length 1 = ] [ read-upper-colon ] } { [ dup length 1 = ] [ read-upper-colon ] }
{ [ dup { [ ":" head? ] [ ":" tail? ] } 1&& ] [ make-tag-literal ] } { [ dup { [ ":" head? ] [ ":" tail? ] } 1&& ] [ make-tag-literal ] }
{ [ dup ":" tail? ] [ dup scoped-upper? [ read-upper-colon ] [ read-lower-colon ] if ] } { [ dup ":" tail? ] [ B dup scoped-upper? [ read-upper-colon ] [ read-lower-colon ] if ] }
{ [ dup ":" head? ] [ make-tag-literal ] } ! :foo( ... ) { [ dup ":" head? ] [ make-tag-literal ] } ! :foo( ... )
[ make-tag-literal ] [ make-tag-literal ]
} cond ; } cond ;
@ -334,7 +334,7 @@ B
: read-upper-less-than ( n string slice -- n string less-than ) : read-upper-less-than ( n string slice -- n string less-than )
dup [ trailing-upper-after-less-than [ but-last ">" append 1array ] [ ">" 1array ] if* lex-until-top ] dip dup [ scoped-less-than-name [ but-last ">" append 1array ] [ ">" 1array ] if* lex-until-top ] dip
1 cut-slice* less-than-literal make-matched-literal ; 1 cut-slice* less-than-literal make-matched-literal ;
: read-less-than ( n string slice -- n string less-than ) : read-less-than ( n string slice -- n string less-than )