Last Dutch Forth meeting we discussed a challenge in
recognizing Roman numbers. It inspired me
to add a Roman prefix similar to the prefix like
$ for hex. (It was not actually solving the challenge.)
It show off the power of the PREFIX word.
Remark:
A word marked PREFIX is found in the dictionary also
if it is immediately followed by another word.
0r (zero-r) M C CM are all prefixes. Making them also IMMEDIATE
made the Roman denotation work also in compilation
mode. It suffices to add POSTPONE LITERAL to the
denotation prefix, (that does nothing in interpret mode).
This is ciforth specific code.

--------------------------------------------------
\ $Id: paas.frt,v 1.4 2025/06/02 12:23:48 albert Exp $
\ Copyright (2012): Albert van der Horst {by GNU Public License}

\ Make an interpreter of Roman numerals.
\ 0rMCMXLVIII is like 0X7FFF000

\ The idea is to have a Roman thingy M C also CM IV
\ that add a constant 1000 100 or 900 4 to what is
\ already on the stack.
\ It is dangerous to let loose a PREFIX D , for
\ example DROP is no longer understood, so the
\ Roman thingies are tucked away in a ROMAN wordlist.

\ ERROR 1001 : The components of a Roman numeral
\ must be in descending order.
\ This detects error 1001, but this is not the subject.
: !ERR ; : ?ERR? ;

NAMESPACE ROMANS
: 0r !ERR 0 NAME ROMANS EVALUATE PREVIOUS POSTPONE LITERAL ;
PREFIX IMMEDIATE
: rdigit CREATE , PREFIX IMMEDIATE DOES> @ ?ERR? + ;
\ Define Roman thingies starting with number the ten times smaller
: _row BEGIN DUP rdigit 10 / DUP 0= UNTIL DROP ;

ROMANS DEFINITIONS
1000 _row M C X I
900 _row CM XC IX
500 _row D L V
400 _row CD XL IV
PREVIOUS DEFINITIONS

\ ------ testing : using REGRESS -------------
WANT REGRESS

REGRESS "I was born in " TYPE 0rMCMXLVIII DUP . S: 1948
REGRESS : rtest 0rMCMXLVIII ; rtest S: 1948
\ must throw but doesn't.
REGRESS 0rMIM S: 2001


---------------------- paaserr.frt -------------------------------
if you insist on ironcladding, add error 1001 ,
the equivalent of the following code.

--------------------------------------------------
VARIABLE largest
: !ERR -1 1 RSHIFT largest ! ;
: ?ERR? DUP largest @ > IF PREVIOUS 1001 THROW THEN DUP largest ! ; --------------------------------------------------
--
Temu exploits Christians: (Disclaimer, only 10 apostles)
Last Supper Acrylic Suncatcher - 15Cm Round Stained Glass- Style Wall
Art For Home, Office And Garden Decor - Perfect For Windows, Bars,
And Gifts For Friends Family And Colleagues.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

albert@spenarnc.xs4all.nl writes:

Last Dutch Forth meeting we discussed a challenge in
recognizing Roman numbers.

IIRC Ulrich Hoffman gave a presentation on a kind of Latin Forth with
Roman numerals at EuroForth 2023 (in Rome). Unfortunatly, most of the
video recordings were unusable (bad sound), and there is not other
record from this presentation.

It show off the power of the PREFIX word.
Remark:
A word marked PREFIX is found in the dictionary also
if it is immediately followed by another word.
0r (zero-r) M C CM are all prefixes. Making them also IMMEDIATE
made the Roman denotation work also in compilation
mode. It suffices to add POSTPONE LITERAL to the
denotation prefix, (that does nothing in interpret mode).
This is ciforth specific code.

--------------------------------------------------
\ $Id: paas.frt,v 1.4 2025/06/02 12:23:48 albert Exp $
\ Copyright (2012): Albert van der Horst {by GNU Public License}

\ Make an interpreter of Roman numerals.
\ 0rMCMXLVIII is like 0X7FFF000

\ The idea is to have a Roman thingy M C also CM IV
\ that add a constant 1000 100 or 900 4 to what is
\ already on the stack.
\ It is dangerous to let loose a PREFIX D , for
\ example DROP is no longer understood, so the
\ Roman thingies are tucked away in a ROMAN wordlist.

\ ERROR 1001 : The components of a Roman numeral
\ must be in descending order.
\ This detects error 1001, but this is not the subject.
: !ERR ; : ?ERR? ;

NAMESPACE ROMANS
: 0r !ERR 0 NAME ROMANS EVALUATE PREVIOUS POSTPONE LITERAL ;
PREFIX IMMEDIATE
: rdigit CREATE , PREFIX IMMEDIATE DOES> @ ?ERR? + ;
\ Define Roman thingies starting with number the ten times smaller
: _row BEGIN DUP rdigit 10 / DUP 0= UNTIL DROP ;

ROMANS DEFINITIONS
1000 _row M C X I
900 _row CM XC IX
500 _row D L V
400 _row CD XL IV
PREVIOUS DEFINITIONS

That's a clever use of your prefix feature. OTOH, the DROP problem
shows the limitations of that approach. Does this code reject "LLL"?
I don't see where that would come from.

Below you find a REC-ROMAN implemented in the current state of affairs
in Gforth. Here I had to walk through the string explicitly, because
there is no prefix mechanism to do it for me.

OTOH, REC-ROMAN is case-sensitive which makes it easy to avoid
conflicts: just write it as a lower-case word if you want to call a
word that happens to use the same letters as a roman numeral.
REC-ROMAN is inserted as first recognizer to be checked, otherwise
this conflict avoidance strategy would not work. There are no words
in Gforth on startup that conflict with roman numerals in the case in
which they are defined (I have not checked if there are any that would
conflict if the name was written upper-case, but at least I and L do).

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

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

true [if]
s" MCMXLVIII" roman>n? . . \ -1 1948

\ check forth-wordlist for conflicts
[: ( nt -- f ) dup name>string roman>n? nip if
dup name>string type space then
drop true
;] forth-wordlist traverse-wordlist
[then]
-----------------------------------------------------------

For ROMAN>N? I first tried an orthodox approach with data and return
stack only, and BEGIN etc., but with 4 stack items that have to be
updated possibly at every iteration that was somewhat unwieldy, and I
produced a buggy version. Then I tried this approach with the
extended CASE and locals, and I got it right on first try, despite its
bulk. I leave it to dxf to show how much better this becomes in
orthodox Forth.

- 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/

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

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/

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

anton@mips.complang.tuwien.ac.at (Anton Ertl) writes:

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 ;

[...]

For ROMAN>N? I first tried an orthodox approach with data and return
stack only, and BEGIN etc., but with 4 stack items that have to be
updated possibly at every iteration that was somewhat unwieldy, and I >produced a buggy version. Then I tried this approach with the
extended CASE and locals, and I got it right on first try, despite its
bulk. I leave it to dxf to show how much better this becomes in
orthodox Forth.

After writing .ROMAN a good way to write a close-to-orthodox ROMAN>N?
became clear to me:

: 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 * -rot
end-romandigits romandigits u+do ( n1 c-addr1 u1 )
2dup i rdigit-string string-prefix? if
i rdigit-string nip /string
rot i rdigit-value + -rot then
rdigit-size +loop
nip 0= ;

As so often, xDO ... xLOOP came to the rescue and meant that the stack
items to be managed were reduced by one. On the first attempt, I did
not go for that approach, because I wanted to keep two changing cells
on the return stack, and xDO ... xLOOP does not allow having the other
value on the return stack on entering the loop, and also restricts the
use of the return stack inside the loop. However, dealing with three
stack items on the data stack is not too bad, even though they all
change.

Compared to the extended case + locals variant, this variant is
shorter and also clearer.

Let's see if locals can still do something for us:

First, let's try the single-assignment style I usually prefer:

: 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 *
end-romandigits romandigits u+do ( c-addr1 u1 n1 )
{: u1 :}
2dup i rdigit-string string-prefix? if
i rdigit-string nip /string
u1 i rdigit-value +
else
u1 then
rdigit-size +loop
over 0= 2nip ;

Not so great. How about assigning to the local?

: 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 * {: n1 :}
end-romandigits romandigits u+do ( c-addr1 u1 )
2dup i rdigit-string string-prefix? if
i rdigit-string nip /string
i rdigit-value +to n1 then
rdigit-size +loop
nip n1 swap 0= ;

That looks best to me, although purists may disagree. A look at the
code between if...then is also interesting:

rot...-rot local
i 1->2 i 1->2
mov r15,[r14] mov r15,[r14]
lit+ 2->2 lit+ 2->2
#8 #8
sub rbx,$40 sub rbx,$40
add r15,-$08[rbx] add r15,-$08[rbx]
2@ 2->3 2@ 2->3
mov r9,[r15] mov r9,[r15]
mov r15,$08[r15] mov r15,$08[r15]
nip 3->2 nip 3->2
mov r15,r9 mov r15,r9
/string 2->2 /string 2->2
add r10,$08 add r10,$08
mov r9,r15 mov r9,r15
mov r15,r13 mov r15,r13
mov r13,[r10] mov r13,[r10]
add r13,r9 add r13,r9
sub r15,r9 sub r15,r9
rot 2->3 i 2->2
mov r9,$08[r10] mov [r10],r13
add r10,$08 sub r10,$08
i 3->2 mov r13,r15
mov [r10],r13 mov r15,[r14]
sub r10,$10 @ 2->2
mov r13,r9 mov r15,[r15]
mov $08[r10],r15 lit 2->3
mov r15,[r14] #0
@ 2->2 mov r9,$30[rbx]
mov r15,[r15] +!localn 3->1
+ 2->1 add $00[rbp][r9],r15
add r13,r15 add rbx,$40
-rot 1->1
mov rdx,$10[r10]
mov rax,$08[r10]
mov $10[r10],r13
mov $08[r10],rdx
mov r13,rax
add rbx,$40

VFX might produce better code for the rot...-rot variant, though, but
the code uses some Gforth-specific features. Let's just try some
fragment for equivalent code:

: foo ?do if i 8 + 2@ nip /string rot i @ + -rot then 24 +loop ;
: bar {: n1 :} ?do if i 8 + 2@ nip /string i @ +to n1 then 24 +loop n1 ;

The following only shows the code between the IF and the THEN.

VFX64 lxf
foo (rot -rot) bar (local) foo (rot -rot) bar (local)
MOV RDX, R14 MOV RDX, R14 mov eax , [esp] mov eax , [esp]
ADD RDX, # 08 ADD RDX, # 08 add eax , [esp+4h] add eax , [esp+4h]
MOV RCX, RDX MOV RCX, RDX add eax , # 8h add eax , # 8h
MOV RCX, 0 [RDX] MOV RCX, 0 [RDX] mov ecx , [eax] mov ecx , [eax]
SUB RBX, RCX SUB RBX, RCX mov eax , [eax+4h] mov eax , [eax+4h]
ADD RCX, [RBP] ADD RCX, [RBP] sub ebx , ecx sub ebx , ecx
MOV RDX, R14 MOV RDX, R14 add ecx , [ebp] add ecx , [ebp]
MOV RAX, 0 [RDX] MOV RAX, 0 [RDX] mov eax , [esp] mov eax , [esp]
ADD RAX, [RBP+08] ADD [RDI+10], RAX add eax , [esp+4h] add eax , [esp+4h]
MOV [RBP], RCX MOV [RBP], RCX mov eax , [eax] mov eax , [eax]
MOV [RBP+08], RAX add eax , [ebp+4h] add eax , [esp+8h]
mov [ebp] , ecx mov [esp+8h] , eax
mov [ebp+4h] , eax mov [ebp] , ecx
mov eax , [esp]

The overall code for BAR is quite a bit longer on both VFX64 and lxf,
though.

- 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/

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

In article <2025Jun8.183524@mips.complang.tuwien.ac.at>,
Anton Ertl <anton@mips.complang.tuwien.ac.at> wrote:
<SNIP>

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:

The use of Roman numerals prefix 0r has the same advantages as using
the prefix $.
Remember ciforth recognizes A as introducing a hex number A01 .
I could put the introducing Roman recognizers in the ONLY wordlist,
and the result would be that Roman numerals are directly recognized.

This is how numbers are handled in ciforth (7 sits in the minimum search
order) The parse pointer has to backed up one character to include 7.
: 7 -1 PP +! (NUMBER) POSTPONE SDLITERAL ; IMMEDIATE PREFIX
: A -1 PP +! (NUMBER) POSTPONE SDLITERAL ; IMMEDIATE PREFIX
I could easily add the following in the minimum search order, replacing
the 0r prefix :
: M -1 PP +! (ROMAN-NUMBER) POSTPONE SDLITERAL ; IMMEDIATE PREFIX
(this is the ONLY wordlist). And the same for C X I D L V .
However this creates a conflict between CC (200) and HEX CC or HEX D000FFFF .

P.S.
If you want to reject DD VV LL it suffices to add
: DD 1001 THROW ;
etc. to the ROMAN vocabulary.
This testifies to the advantage of leaving interpreting to the Forth interpreter.

- anton

Groetjes Albert
--
Temu exploits Christians: (Disclaimer, only 10 apostles)
Last Supper Acrylic Suncatcher - 15Cm Round Stained Glass- Style Wall
Art For Home, Office And Garden Decor - Perfect For Windows, Bars,
And Gifts For Friends Family And Colleagues.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

In article <a281de112697213c8d16ce5eee1d08dbff2fb293@i2pn2.org>,
dxf <dxforth@gmail.com> wrote:

On 9/06/2025 2:23 am, LIT wrote:

I prefer ITC - the processors nowadays are so fast,
that DTC/STC aren't as much advantageous, as they
used to be — and I'm frequently tinkering with that
old fig-Forth I once found on forth.org pages. It's
fun. :)

AFAICS ITC presents no impediment to finding a credible solution
for FigForth's lack of a credible CREATE.

Remember ciforth is actually fig.forth 5.5.1.

<BUILDS DOES> is nearly as powerful as CREATE DOES>
I merely made vocabularies and <BUILDS DOES> iso standard .

I also introduced PREFIX.
(PREFIX is actually a two line addition to a properly designed Forth.)

I made more improvements but the above should be sufficient to reproduce the example
in fig-Forth.

Groetjes Albert
--
Temu exploits Christians: (Disclaimer, only 10 apostles)
Last Supper Acrylic Suncatcher - 15Cm Round Stained Glass- Style Wall
Art For Home, Office And Garden Decor - Perfect For Windows, Bars,
And Gifts For Friends Family And Colleagues.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

In article <nnd$250ea32f$3fb998ef@49b34810590db67a>,
<albert@spenarnc.xs4all.nl> wrote:

In article <a281de112697213c8d16ce5eee1d08dbff2fb293@i2pn2.org>,
dxf <dxforth@gmail.com> wrote:

On 9/06/2025 2:23 am, LIT wrote:

I prefer ITC - the processors nowadays are so fast,
that DTC/STC aren't as much advantageous, as they
used to be — and I'm frequently tinkering with that
old fig-Forth I once found on forth.org pages. It's
fun. :)

AFAICS ITC presents no impediment to finding a credible solution
for FigForth's lack of a credible CREATE.

Remember ciforth is actually fig.forth 5.5.1.

<BUILDS DOES> is nearly as powerful as CREATE DOES>
I merely made vocabularies and <BUILDS DOES> iso standard .

I also introduced PREFIX.
(PREFIX is actually a two line addition to a properly designed Forth.)

I made more improvements but the above should be sufficient to reproduce
the example
in fig-Forth.

For what it is worth I tried the example in mina (msdos ciforth) that
has not been updated to version 5. DOSBOX in ubuntu/

It works as long as you replace NAMESPACE with VOCABULARY and
NAME with "BL PARSE" .

That is a 2005 program!

Groetjes Albert

--
Temu exploits Christians: (Disclaimer, only 10 apostles)
Last Supper Acrylic Suncatcher - 15Cm Round Stained Glass- Style Wall
Art For Home, Office And Garden Decor - Perfect For Windows, Bars,
And Gifts For Friends Family And Colleagues.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)