From 801366df9854f52bec059ffd73d380e668c1c024 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 18 Jun 2009 17:32:10 -0500 Subject: [PATCH] minor cleanup --- basis/roman/roman.factor | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/basis/roman/roman.factor b/basis/roman/roman.factor index 92202da8ca..817b6637d6 100644 --- a/basis/roman/roman.factor +++ b/basis/roman/roman.factor @@ -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 = ( 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 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 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 ; << + SYNTAX: ROMAN-OP: scan-word [ name>> "roman" prepend create-in ] keep 1quotation '[ _ binary-roman-op ] dup infer [ in>> ] [ out>> ] bi [ "string" ] bi@ define-declared ; + >> ROMAN-OP: +