intger --> roman numeral

i2r.scm

; integer --> roman numeral
;  Compilers 1st ed. ex. P2.1 (p. 81)
;  Compilers 2nd ed. ex. 2.3.3 (p. 60)
; https://gist.github.com/yamasushi/f0febd8f53c34e4c97a025d1691a4d1d

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

(define num-table #(
  #("I" "II" "III" "IV" "V" "VI" "VII" "VIII" "IX") ;    1 ~    9  
  #("X" "XX" "XXX" "XL" "L" "LX" "LXX" "LXXX" "XC") ;   10 ~   90   
  #("C" "CC" "CCC" "CD" "D" "DC" "DCC" "DCCC" "CM") ;  100 ~  900
  #("M" "MM" "MMM" ) ; 1000 ~ 3000
  ))

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

; N -> N D | D

; N -> D R1 { N.s = n->roman(R1.k , D.d ) + R1.s }
; R -> D R1 { R.k = R1.k +　1 , R.s = n->roman(R1.k , D.d ) + R1.s }
; R -> ε { R.k = 0 , R.s= "" }

(define (integer->roman num)
  (let-values ([(rn xs)  ($ N $ string->list $ format "~d" num )])
    ;(format #t "i2r: rn=~s xs=~s~%" rn xs)
    rn
  ))

(define (n->roman t n)
  (if (< 0 n)
    (~ (~ num-table t ) (- n 1) ) 
    "" ) )


(define (N xs)
  ;(format #t "N xs=~s~%" xs)
  (if (null? xs)
    (error "N: xs=" xs)
    (if (#[0-9](car xs))
      (let-values( [ (d xs) (match-digit xs) ])
        (let-values( [ (k s xs) (R xs) ] )
          (values (string-append (n->roman k d) s) xs ) ) )
      (error "N:xs=" xs) ) ) )

(define (R xs)
  ;(format #t "R xs=~s~%" xs)
  (if (null? xs)
    (values 0 "" xs) ; ε
    (if (#[0-9](car xs))
      (let-values( [ (d xs) (match-digit xs) ])
        (let-values( [ (k s xs) (R xs) ] )
          (values (+ 1 k) (string-append (n->roman k d) s) xs ) ) )
      (values 0 "" xs) ; ε 
    ) ) )

(define (match-digit xs)
  ;(format #t "match-digit xs=~s~%" xs)
  (cond 
    {(#[0-9](car xs)) (values (digit->integer (car xs) ) (cdr xs)) }
    {else (error "match-digit xs=" xs)} ) )