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

roman: aesthetics.

char-rename
John Benediktsson 2017-01-25 09:48:15 -08:00
parent 85e6dc6369
commit b93aa90486
1 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
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 combinators.smart effects USING: accessors combinators.smart effects.parser fry
effects.parser fry generalizations grouping kernel lexer macros generalizations grouping kernel lexer macros math math.order
math math.order math.vectors namespaces parser quotations parser quotations sequences splitting.monotonic strings unicode
sequences sequences.private splitting.monotonic stack-checker words ;
strings unicode words ;
IN: roman IN: roman
<PRIVATE <PRIVATE
@ -23,14 +22,14 @@ ERROR: roman-range-error n ;
: roman-digit-index ( ch -- n ) : roman-digit-index ( ch -- n )
1string roman-digits index ; inline 1string roman-digits index ; inline
: roman>= ( ch1 ch2 -- ? ) : roman-digit>= ( ch1 ch2 -- ? )
[ roman-digit-index ] bi@ >= ; [ roman-digit-index ] bi@ >= ;
: roman>n ( ch -- n ) : roman-digit-value ( ch -- n )
roman-digit-index roman-values nth ; roman-digit-index roman-values nth ;
: (roman>) ( seq -- n ) : roman-value ( seq -- n )
[ [ roman>n ] map ] [ all-eq? ] bi [ [ roman-digit-value ] map ] [ all-eq? ] bi
[ sum ] [ first2 swap - ] if ; [ sum ] [ first2 swap - ] if ;
PRIVATE> PRIVATE>
@ -44,7 +43,8 @@ PRIVATE>
: >ROMAN ( n -- str ) >roman >upper ; : >ROMAN ( n -- str ) >roman >upper ;
: roman> ( str -- n ) : roman> ( str -- n )
>lower [ roman>= ] monotonic-split [ (roman>) ] map-sum ; >lower [ roman-digit>= ] monotonic-split
[ roman-value ] map-sum ;
<PRIVATE <PRIVATE