Refactor math.text.english using new combinators

db4
Aaron Schaefer 2008-11-05 22:59:06 -05:00
parent 373c05ee49
commit 15257b91ac
1 changed files with 11 additions and 14 deletions

View File

@ -1,7 +1,7 @@
! Copyright (c) 2007 Aaron Schaefer. ! Copyright (c) 2007, 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: combinators.lib kernel math math.functions math.parser namespaces USING: combinators.short-circuit grouping kernel math math.parser namespaces
sequences splitting grouping combinators.short-circuit ; sequences ;
IN: math.text.english IN: math.text.english
<PRIVATE <PRIVATE
@ -52,13 +52,11 @@ SYMBOL: and-needed?
] if ; ] if ;
: 3digits>text ( n -- str ) : 3digits>text ( n -- str )
dup hundreds-place swap tens-place append ; [ hundreds-place ] [ tens-place ] bi append ;
: text-with-scale ( index seq -- str ) : text-with-scale ( index seq -- str )
dupd nth 3digits>text swap [ nth 3digits>text ] [ drop scale-numbers ] 2bi
scale-numbers [ [ " " swap 3append ] unless-empty ;
" " swap 3append
] unless-empty ;
: append-with-conjunction ( str1 str2 -- newstr ) : append-with-conjunction ( str1 str2 -- newstr )
over length zero? [ over length zero? [
@ -68,20 +66,19 @@ SYMBOL: and-needed?
and-needed? off and-needed? off
] if ; ] if ;
: (recombine) ( str index seq -- newstr seq ) : (recombine) ( str index seq -- newstr )
2dup nth zero? [ 2dup nth zero? [
nip 2drop
] [ ] [
[ text-with-scale ] keep text-with-scale append-with-conjunction
-rot append-with-conjunction swap
] if ; ] if ;
: recombine ( seq -- str ) : recombine ( seq -- str )
dup length 1 = [ dup length 1 = [
first 3digits>text first 3digits>text
] [ ] [
dup set-conjunction "" swap [ set-conjunction "" ] [ length ] [ ] tri
dup length [ swap (recombine) ] each drop [ (recombine) ] curry each
] if ; ] if ;
: (number>text) ( n -- str ) : (number>text) ( n -- str )