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

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

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