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

modern: re-add foo\ words for postpone\, SYNTAX\ etc.

locals-and-roots
Doug Coleman 2016-06-05 15:47:20 -07:00
parent 2807239af7
commit e89f1b3521
3 changed files with 8 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -97,3 +97,7 @@ in: modern.tests
{ 1 } [ ":foo" string>literals length ] unit-test { 1 } [ ":foo" string>literals length ] unit-test
{ 1 } [ "( :integer )" string>literals length ] unit-test { 1 } [ "( :integer )" string>literals length ] unit-test
{ 1 } [ "postpone\\ main:" string>literals length ] unit-test
{ 1 } [ "char: \\!" string>literals length ] unit-test

9
core/modern/modern.factor
View File

@ -326,18 +326,11 @@ ERROR: colon-word-must-be-all-uppercase-or-lowercase n string word ;
dup { [ "!" sequence= ] [ "#!" sequence= ] } 1|| dup { [ "!" sequence= ] [ "#!" sequence= ] } 1||
[ take-comment ] [ merge-slice-til-whitespace make-tag-literal ] if ; [ take-comment ] [ merge-slice-til-whitespace make-tag-literal ] if ;
! XXX: Allow foo\ or just \?
ERROR: backslash-expects-whitespace slice ; ERROR: backslash-expects-whitespace slice ;
: read-backslash ( n string slice -- n' string obj ) : read-backslash ( n string slice -- n' string obj )
2over peek-from blank? [ 2over peek-from blank? [
! \ foo, M\ foo ! \ foo, M\ foo
dup length 1 > [ [ skip-blank-from slice-til-whitespace drop dup ] dip 1 cut-slice* backslash-literal make-delimited-literal
! M\ foo\
merge-slice-til-whitespace make-tag-literal
] [
! \
[ skip-blank-from slice-til-whitespace drop dup ] dip 1 cut-slice* backslash-literal make-delimited-literal
] if
] [ ] [
! M\N ! M\N
merge-slice-til-whitespace make-tag-literal merge-slice-til-whitespace make-tag-literal

6
demos/project-euler/011/011.factor
View File

@ -80,10 +80,10 @@ in: project-euler.011
length iota [ 0 <repetition> ] map length iota [ 0 <repetition> ] map
] keep [ <reversed> append ] 2map ; ] keep [ <reversed> append ] 2map ;
: diagonal/ ( -- matrix ) : diagonal-one ( -- matrix )
horizontal reverse pad-front pad-back flip ; horizontal reverse pad-front pad-back flip ;
: diagonal\ ( -- matrix ) : diagonal-two ( -- matrix )
horizontal pad-front pad-back flip ; horizontal pad-front pad-back flip ;
: max-product ( matrix width -- n ) : max-product ( matrix width -- n )
@ -94,7 +94,7 @@ PRIVATE>
: euler011 ( -- answer ) : euler011 ( -- answer )
[ [
{ [ horizontal ] [ vertical ] [ diagonal/ ] [ diagonal\ ] } { [ horizontal ] [ vertical ] [ diagonal-one ] [ diagonal-two ] }
[ call( -- matrix ) 4 max-product , ] each [ call( -- matrix ) 4 max-product , ] each
] { } make supremum ; ] { } make supremum ;