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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-06-18 19:30:52 -05:00
parent a99f8f5741 03b8e1b756
commit 2ba5a20f3e
2 changed files with 19 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
basis/roman/roman.factor
View File

@ -1,10 +1,9 @@
! Copyright (C) 2007 Doug Coleman. ! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs fry generalizations grouping USING: accessors arrays assocs effects fry generalizations
kernel lexer macros make math math.order math.vectors grouping kernel lexer macros math math.order math.vectors
namespaces parser quotations sequences sequences.private namespaces parser quotations sequences sequences.private
splitting.monotonic stack-checker strings unicode.case splitting.monotonic stack-checker strings unicode.case words ;
words effects ;
IN: roman IN: roman
<PRIVATE <PRIVATE
@ -17,23 +16,18 @@ CONSTANT: roman-values
ERROR: roman-range-error n ; ERROR: roman-range-error n ;
: roman-range-check ( n -- ) : roman-range-check ( n -- n )
dup 1 3999 between? [ drop ] [ roman-range-error ] if ; dup 1 3999 between? [ roman-range-error ] unless ;
: roman-digit-index ( ch -- n ) : roman-digit-index ( ch -- n )
1string roman-digits index ; inline 1string roman-digits index ; inline
: roman<= ( ch1 ch2 -- ? ) : roman>= ( ch1 ch2 -- ? )
[ roman-digit-index ] bi@ >= ; [ roman-digit-index ] bi@ >= ;
: roman>n ( ch -- n ) : roman>n ( ch -- n )
roman-digit-index roman-values nth ; roman-digit-index roman-values nth ;
: (>roman) ( n -- )
roman-values roman-digits [
[ /mod swap ] dip <repetition> concat %
] 2each drop ;
: (roman>) ( seq -- n ) : (roman>) ( seq -- n )
[ [ roman>n ] map ] [ all-eq? ] bi [ [ roman>n ] map ] [ all-eq? ] bi
[ sum ] [ first2 swap - ] if ; [ sum ] [ first2 swap - ] if ;
@ -41,12 +35,15 @@ ERROR: roman-range-error n ;
PRIVATE> PRIVATE>
: >roman ( n -- str ) : >roman ( n -- str )
dup roman-range-check [ (>roman) ] "" make ; roman-range-check
roman-values roman-digits [
[ /mod swap ] dip <repetition> concat
] 2map "" concat-as nip ;
: >ROMAN ( n -- str ) >roman >upper ; : >ROMAN ( n -- str ) >roman >upper ;
: roman> ( str -- n ) : roman> ( str -- n )
>lower [ roman<= ] monotonic-split [ (roman>) ] sigma ; >lower [ roman>= ] monotonic-split [ (roman>) ] sigma ;
<PRIVATE <PRIVATE
@ -57,11 +54,13 @@ MACRO: binary-roman-op ( quot -- quot' )
PRIVATE> PRIVATE>
<< <<
SYNTAX: ROMAN-OP: SYNTAX: ROMAN-OP:
scan-word [ name>> "roman" prepend create-in ] keep scan-word [ name>> "roman" prepend create-in ] keep
1quotation '[ _ binary-roman-op ] 1quotation '[ _ binary-roman-op ]
dup infer [ in>> ] [ out>> ] bi dup infer [ in>> ] [ out>> ] bi
[ "string" <repetition> ] bi@ <effect> define-declared ; [ "string" <repetition> ] bi@ <effect> define-declared ;
>> >>
ROMAN-OP: + ROMAN-OP: +

12
core/sets/sets-docs.factor
View File

@ -168,8 +168,8 @@ HELP: sequence>assoc
{ "assoc" assoc } { "assoc" assoc }
} }
{ $examples { $examples
{ $example "! Count the number of times the elements of two sequences appear." { $example "! Iterate over a sequence and increment the count at each element"
"USING: prettyprint sets ;" "USING: assocs prettyprint sets ;"
"\"aaabc\" [ inc-at ] H{ } sequence>assoc ." "\"aaabc\" [ inc-at ] H{ } sequence>assoc ."
"H{ { 97 3 } { 98 1 } { 99 1 } }" "H{ { 97 3 } { 98 1 } { 99 1 } }"
} }
@ -182,8 +182,8 @@ HELP: sequence>assoc*
{ "assoc" assoc } { "assoc" assoc }
} }
{ $examples { $examples
{ $example "! Count the number of times the elements of two sequences appear." { $example "! Iterate over a sequence and add the counts to an existing assoc"
"USING: prettyprint sets ;" "USING: assocs prettyprint sets kernel ;"
"H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ inc-at ] sequence>assoc* ." "H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ inc-at ] sequence>assoc* ."
"H{ { 97 5 } { 98 2 } { 99 1 } }" "H{ { 97 5 } { 98 2 } { 99 1 } }"
} }
@ -196,8 +196,8 @@ HELP: sequence>hashtable
{ "hashtable" hashtable } { "hashtable" hashtable }
} }
{ $examples { $examples
{ $example "! Count the number of times the elements of two sequences appear." { $example "! Count the number of times an element occurs in a sequence"
"USING: prettyprint sets ;" "USING: assocs prettyprint sets ;"
"\"aaabc\" [ inc-at ] sequence>hashtable ." "\"aaabc\" [ inc-at ] sequence>hashtable ."
"H{ { 97 3 } { 98 1 } { 99 1 } }" "H{ { 97 3 } { 98 1 } { 99 1 } }"
} }