 ! 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


ERROR: roman-range-error n ;

: roman-range-check ( n -- )
    dup 1 3999 between? [ drop ] [ roman-range-error ] if ;

: roman-digit-index ( ch -- n )
    1string roman-digits index ; inline

: 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

PRIVATE>

: >roman ( n -- str )
    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 ;

<PRIVATE

