Re: Roman numerals , recognizer "0r".

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/