diff --git a/basis/roman/roman-docs.factor b/basis/roman/roman-docs.factor index 4a8197f064..bef0ab90fc 100644 --- a/basis/roman/roman-docs.factor +++ b/basis/roman/roman-docs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: help.markup help.syntax kernel math ; +USING: help.markup help.syntax kernel math strings ; IN: roman HELP: >roman @@ -39,7 +39,7 @@ HELP: roman> { >roman >ROMAN roman> } related-words HELP: roman+ -{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } } +{ $values { "string" string } { "string" string } { "string" string } } { $description "Adds two Roman numerals." } { $examples { $example "USING: io roman ;" @@ -49,7 +49,7 @@ HELP: roman+ } ; HELP: roman- -{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } } +{ $values { "string" string } { "string" string } { "string" string } } { $description "Subtracts two Roman numerals." } { $examples { $example "USING: io roman ;" @@ -61,7 +61,7 @@ HELP: roman- { roman+ roman- } related-words HELP: roman* -{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } } +{ $values { "string" string } { "string" string } { "string" string } } { $description "Multiplies two Roman numerals." } { $examples { $example "USING: io roman ;" @@ -71,7 +71,7 @@ HELP: roman* } ; HELP: roman/i -{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } } +{ $values { "string" string } { "string" string } { "string" string } } { $description "Computes the integer division of two Roman numerals." } { $examples { $example "USING: io roman ;" @@ -81,7 +81,7 @@ HELP: roman/i } ; HELP: roman/mod -{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } { "str4" "a string" } } +{ $values { "string" string } { "string" string } { "string" string } { "string" string } } { $description "Computes the quotient and remainder of two Roman numerals." } { $examples { $example "USING: kernel io roman ;" diff --git a/basis/roman/roman-tests.factor b/basis/roman/roman-tests.factor index 82084e0b1f..a510514e23 100644 --- a/basis/roman/roman-tests.factor +++ b/basis/roman/roman-tests.factor @@ -38,3 +38,9 @@ USING: arrays kernel math roman roman.private sequences tools.test ; [ "iii" "iii" roman- ] must-fail [ 30 ] [ ROMAN: xxx ] unit-test + +[ roman+ ] must-infer +[ roman- ] must-infer +[ roman* ] must-infer +[ roman/i ] must-infer +[ roman/mod ] must-infer diff --git a/basis/roman/roman.factor b/basis/roman/roman.factor index 4991d5b243..f191323992 100644 --- a/basis/roman/roman.factor +++ b/basis/roman/roman.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2007 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays assocs kernel math math.order math.vectors -namespaces make quotations sequences splitting.monotonic -sequences.private strings unicode.case lexer parser -grouping ; +USING: accessors arrays assocs fry generalizations grouping +kernel lexer macros make math math.order math.vectors +namespaces parser quotations sequences sequences.private +splitting.monotonic stack-checker strings unicode.case +words effects ; IN: roman : >roman ( n -- str ) - dup roman-range-check - [ (>roman) ] "" make ; + dup roman-range-check [ (>roman) ] "" make ; : >ROMAN ( n -- str ) >roman >upper ; : roman> ( str -- n ) - >lower [ roman<= ] monotonic-split - [ (roman>) ] sigma ; + >lower [ roman<= ] monotonic-split [ (roman>) ] sigma ; ( str1 str2 -- m n ) - [ roman> ] bi@ ; - -: binary-roman-op ( str1 str2 quot -- str3 ) - [ 2roman> ] dip call >roman ; inline +MACRO: binary-roman-op ( quot -- quot' ) + dup infer [ in>> swap ] [ out>> ] bi + '[ [ roman> ] _ napply @ [ >roman ] _ napply ] ; PRIVATE> -: roman+ ( str1 str2 -- str3 ) - [ + ] binary-roman-op ; +<< +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- ( str1 str2 -- str3 ) - [ - ] binary-roman-op ; - -: roman* ( str1 str2 -- str3 ) - [ * ] binary-roman-op ; - -: roman/i ( str1 str2 -- str3 ) - [ /i ] binary-roman-op ; - -: roman/mod ( str1 str2 -- str3 str4 ) - [ /mod ] binary-roman-op [ >roman ] dip ; +ROMAN-OP: + +ROMAN-OP: - +ROMAN-OP: * +ROMAN-OP: /i +ROMAN-OP: /mod SYNTAX: ROMAN: scan roman> parsed ;