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

modern: more < > work.

locals-and-roots
Doug Coleman 2016-06-21 02:32:39 -07:00
parent dfe27752a0
commit e239b7f6f7
2 changed files with 12 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
core/modern/modern-tests.factor
View File

@ -122,4 +122,8 @@ in: modern.tests
] unit-test ] unit-test
{ 1 } { 1 }
[ "PRIVATE< OMG: PRIVATE>" string>literals length ] unit-test [ "PRIVATE< OMG: PRIVATE>" string>literals length ] unit-test
{ t } [ "=>" string>literals first tag-literal? ] unit-test
{ t } [ ">>" string>literals first tag-literal? ] unit-test
{ t } [ "<<" string>literals first tag-literal? ] unit-test

11
core/modern/modern.factor
View File

@ -115,8 +115,11 @@ M: array collapse-decorators
collapse-decorators make-compound-literals ; collapse-decorators make-compound-literals ;
! foo:bar-baz09: ! foo:bar-baz09:
: strict-upper-letter? ( ch -- ? )
{ [ char: A char: Z between? ] [ char: 0 char: 9 between? ] [ ":-#" member? ] } 1|| ;
: strict-upper? ( string -- ? ) : strict-upper? ( string -- ? )
[ { [ char: A char: Z between? ] [ char: 0 char: 9 between? ] [ ":-#" member? ] } 1|| ] all? ; [ strict-upper-letter? ] all? ;
: whitespace/f? ( ch -- ? ) : whitespace/f? ( ch -- ? )
{ char: \s char: \r char: \n f } member? ; inline { char: \s char: \r char: \n f } member? ; inline
@ -153,20 +156,20 @@ M: array collapse-decorators
[ [ char: \: = ] find-last ] keep [ [ char: \: = ] find-last ] keep
swap [ swap tail strict-upper? ] [ nip strict-upper? ] if swap [ swap tail strict-upper? ] [ nip strict-upper? ] if
] [ ] [
"<" sequence= [ char: \< = ] all? not
] if ] if
] [ ] [
drop f drop f
] if ; ] if ;
: top-level-greater-than? ( string -- ? ) : top-level-greater-than? ( string -- ? )
dup { [ ">" tail? ] [ length 1 > ] } 1&& [ dup { [ ">" tail? ] [ length 1 > ] [ first char: A char: Z between? ] } 1&& [
but-last but-last
dup length 1 > [ dup length 1 > [
[ [ char: \: = ] find-last ] keep [ [ char: \: = ] find-last ] keep
swap [ swap tail strict-upper? ] [ nip strict-upper? ] if swap [ swap tail strict-upper? ] [ nip strict-upper? ] if
] [ ] [
">" sequence= [ char: \> = ] all? not
] if ] if
] [ ] [
drop f drop f