Path: news.eternal-september.org!eternal-september.org!.POSTED!not-for-mail
From: anton@mips.complang.tuwien.ac.at (Anton Ertl)
Newsgroups: comp.lang.forth
Subject: Re: Roman numerals , recognizer "0r".
Date: Mon, 09 Jun 2025 06:23:38 GMT
Organization: Institut fuer Computersprachen, Technische Universitaet Wien
Lines: 86
Message-ID: <2025Jun9.082338@mips.complang.tuwien.ac.at>
References: <nnd$3b511631$511bab64@a22533c0c24c276e> <2025Jun8.183524@mips.complang.tuwien.ac.at>
Injection-Date: Mon, 09 Jun 2025 08:26:54 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="88b7cf884859348a0d5a911e81ab3948";
	logging-data="416628"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX19S91Fx0+puHYH66ZQ8GH+/"
Cancel-Lock: sha1:b4KLiH5g9a5jS3w/4N7OlICOfnM=
X-newsreader: xrn 10.11

anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:
>Because conflicts can be avoided, there is no need to use a prefix
>like your Or, so I do not use that.  Here are some examples:
>
>MCMXLVIII .          \ 1948
>mcmxlviii .          \ error: undefined word
>MIM                  \ error: undefined word
>L .                  \ 50
>LLL                  \ error: undefined word
>MCMXLVIII LXXVII + . \ 2025

I gave now also added .ROMAN, so now I can do:

MCMXLVIII LXXVII + .roman \ MMXXV

>And here's the code:
>------------------------------------------------------------------
>0
>  value:  rdigit-value
>  2value: rdigit-string
>constant rdigit-size
>
>
>: romandigit ( u "romandigit" -- )
>    , parse-name save-mem 2, ;
>
>create romandigits
>\ this table contains variants with 4 repetitions, you can comment
>\ them out if desired
> 900 romandigit CM
> 500 romandigit D
> 400 romandigit CD
> 400 romandigit CCCC
> 300 romandigit CCC
> 200 romandigit CC
> 100 romandigit C
>  90 romandigit XC
>  50 romandigit L
>  40 romandigit XL
>  40 romandigit XXXX
>  30 romandigit XXX
>  20 romandigit XX
>  10 romandigit X
>   9 romandigit IX
>   5 romandigit V
>   4 romandigit IV
>   4 romandigit IIII
>   3 romandigit III
>   2 romandigit II
>   1 romandigit I
>here constant end-romandigits
>
>: roman>n? ( c-addr u -- n f )
>\ if c-addr u contains a roman numeral, f is true and n is the value,
>\ otherwise f is false.
>    dup >r 'M' skip r> over - 1000 *
>    romandigits case {: d: str1 n1 rd1 :}
>        rd1 end-romandigits = ?of n1 str1 nip 0= endof
>        str1 rd1 rdigit-string string-prefix? ?of
>            str1 rd1 rdigit-string nip /string
>            n1 rd1 rdigit-value +
>            rd1 rdigit-size + contof
>        str1 n1 rd1 rdigit-size + next-case ;
>
>: rec-roman ( c-addr u -- n translate-num | 0 )
>    roman>n? if ['] translate-num else drop 0 then ;
>
>' rec-roman action-of forth-recognize >stack

: .roman ( u -- )
    begin
        dup 1000 u>= while
            'M' emit 1000 - repeat
    end-romandigits romandigits u+do
        dup i rdigit-value u>= if
            i rdigit-string type i rdigit-value - then
    rdigit-size +loop
    drop ;

- anton
-- 
M. Anton Ertl  http://www.complang.tuwien.ac.at/anton/home.html
comp.lang.forth FAQs: http://www.complang.tuwien.ac.at/forth/faq/toc.html
     New standard: https://forth-standard.org/
EuroForth 2023 proceedings: http://www.euroforth.org/ef23/papers/
EuroForth 2024 proceedings: http://www.euroforth.org/ef24/papers/