roman numeral --> integer

r2i.scm

; roman numeral --> integer
;  Compilers 2nd ed. ex. 2.3.4 (p. 60)
; https://gist.github.com/yamasushi/379df533cd0d58e8b56e2080f2fee95e

(define-module r2i
  (export roman->integer))
(select-module r2i)

;-----------------------------------------------
; roman numeral ---> integer 
;-----------------------------------------------

(define (roman->integer str) 
  (let-values ( [(n xs) ($ N $ string->list str) ] )
    ;(format #t "r2i: n=~s xs=~s~%" n xs)
    n ) )

(define (N xs) 
  (let-values      ([(n3 xs) (M3 xs)]) 
;    (format #t "n3=~s~%" n3)
    (let-values    ([(n2 xs) (M2 xs)]) 
;      (format #t "n2=~s~%" n2)
      (let-values  ([(n1 xs) (M1 xs)]) 
;        (format #t "n1=~s~%" n1)
        (let-values([(n0 xs) (M0 xs)]) 
;          (format #t "n0=~s~%" n0)
          (values
            (+ (* n3 1000) (* n2 100) (* n1 10) n0 )
            xs ))))))


(define M0 (cut M #\I #\V #\X <>) )
(define M1 (cut M #\X #\L #\C <>) )
(define M2 (cut M #\C #\D #\M <>) )
(define M3 (cut M #\M (undefined) (undefined) <>) )
(define (M I V X xs)
  ; P  -> I R {P.n = 1 + R.n } | V {P.n = 3} | X {P.n = 8 } | ε {P.n = 0}
  (define (P xs)
;    (format #t "P xs=~s~%" xs)
    (if (null? xs)
      (values 0 xs) ; ε
      (let1 hd (car xs)
        (cond
          { (eqv? hd I) 
            (let-values ( [(n xs) (R (cdr xs))] )
              (values (+ 1 n) xs ) ) }
          { (eqv? hd V) (values 3 (cdr xs)) } 
          { (eqv? hd X) (values 8 (cdr xs)) }
          { else (values 0 xs)　}　 ; ε 
        ))))
  
  ; R  -> I {R.n = 1} | ε {R.n = 0}
  (define (R xs)
;    (format #t "R xs=~s~%" xs)
    (if (null? xs)
      (values 0 xs) ; ε
      (let1 hd (car xs)
        (cond
          { (eqv? hd I) (values 1 (cdr xs))} 
          { else (values 0 xs)　}　 ; ε 
        ))))

  ; Q  -> I S {Q.n = 1 + S.n} | ε {Q.n = 0}
  (define (Q xs)
;    (format #t "Q xs=~s~%" xs)
    (if (null? xs)
      (values 0 xs) ; ε
      (let1 hd (car xs)
        (cond
          { (eqv? hd I) 
            (let-values ( [(n xs) (S (cdr xs))] )
              (values (+ 1 n) xs ) ) }
          { else (values 0 xs)　}　 ; ε 
        ))))
  
  ; S  -> I R {S.n = 1 + R.n} | ε {S.n = 0}
  (define (S xs)
;    (format #t "S xs=~s~%" xs)
    (if (null? xs)
      (values 0 xs) ; ε
      (let1 hd (car xs)
        (cond
          { (eqv? hd I) 
            (let-values ( [(n xs) (R (cdr xs))] )
              (values (+ 1 n) xs ) ) }
          { else (values 0 xs)　}　 ; ε 
        ))))
  
;  (format #t "M ~s ~s ~s xs=~s~%" I V X xs)
  ; M -> I P {M.n = 1 + P.n } | V Q {M.n = 5 + Q.n } | ε M.n = 0
  (if (null? xs)
    (values 0 xs) ; ε
    (let1 hd (car xs)
      (cond
        { (eqv? hd I) 
          (let-values ([(n xs) (P (cdr xs))]) 
;            (format #t "n=~s xs=~s~%" n xs)
            (values (+ 1 n) xs ) ) }
        { (eqv? hd V) 
          (let-values ([(n xs) (Q (cdr xs))]) 
            (values (+ 5 n) xs ) ) }
        { else (values 0 xs)　}　 ; ε 
      ))))