From edb78de4a7ec3ca5ec7e8daa821bfe3e4e155f15 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 21 Oct 2008 20:30:26 -0500
Subject: [PATCH] add parsing word to roman
---
extra/roman/roman-docs.factor | 3 +++
extra/roman/roman-tests.factor | 2 ++
extra/roman/roman.factor | 8 +++++++-
3 files changed, 12 insertions(+), 1 deletion(-)
diff --git a/extra/roman/roman-docs.factor b/extra/roman/roman-docs.factor
index a62e92ce08..87551635f1 100644
--- a/extra/roman/roman-docs.factor
+++ b/extra/roman/roman-docs.factor
@@ -43,3 +43,6 @@ HELP: roman/mod
{ $values { "str1" "a string" } { "str2" "a string" } { "str3" "a string" } { "str4" "a string" } }
{ $description "Computes the quotient and remainder of two Roman numerals." }
{ $see-also roman* roman/i /mod } ;
+
+HELP: ROMAN:
+{ $description "A parsing word that reads the next token and converts it to an integer." } ;
diff --git a/extra/roman/roman-tests.factor b/extra/roman/roman-tests.factor
index a15dcef354..82084e0b1f 100644
--- a/extra/roman/roman-tests.factor
+++ b/extra/roman/roman-tests.factor
@@ -36,3 +36,5 @@ USING: arrays kernel math roman roman.private sequences tools.test ;
[ "i" ] [ "iii" "ii" roman/i ] unit-test
[ "i" "ii" ] [ "v" "iii" roman/mod ] unit-test
[ "iii" "iii" roman- ] must-fail
+
+[ 30 ] [ ROMAN: xxx ] unit-test
diff --git a/extra/roman/roman.factor b/extra/roman/roman.factor
index dcadb865f9..5ffdf67753 100644
--- a/extra/roman/roman.factor
+++ b/extra/roman/roman.factor
@@ -2,10 +2,11 @@
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs kernel math math.order math.vectors
namespaces make quotations sequences sequences.lib
-sequences.private strings unicode.case ;
+sequences.private strings unicode.case lexer parser ;
IN: roman
<PRIVATE
+
: roman-digits ( -- seq )
{ "m" "cm" "d" "cd" "c" "xc" "l" "xl" "x" "ix" "v" "iv" "i" } ;
@@ -34,6 +35,7 @@ ERROR: roman-range-error n ;
] [
first2 swap -
] if ;
+
PRIVATE>
: >roman ( n -- str )
@@ -49,11 +51,13 @@ PRIVATE>
] map sum ;
<PRIVATE
+
: 2roman> ( str1 str2 -- m n )
[ roman> ] bi@ ;
: binary-roman-op ( str1 str2 quot -- str3 )
>r 2roman> r> call >roman ; inline
+
PRIVATE>
: roman+ ( str1 str2 -- str3 )
@@ -70,3 +74,5 @@ PRIVATE>
: roman/mod ( str1 str2 -- str3 str4 )
[ /mod ] binary-roman-op >r >roman r> ;
+
+: ROMAN: scan roman> parsed ; parsing