#lang scheme

(define tabla-unidades
  (list
   (cons "" 0)
   (cons "I" 1)
   (cons "II" 2)
   (cons "III" 3)
   (cons "IV" 4)
   (cons "V" 5)
   (cons "VI" 6)
   (cons "VII" 7)
   (cons "VIII" 8)
   (cons "IX" 9)))

(define tabla-decenas
  (list
   (cons "" 0)
   (cons "X" 10)
   (cons "XX" 20)
   (cons "XXX" 30)
   (cons "XL" 40)
   (cons "L" 50)
   (cons "LX" 60)
   (cons "LXX" 70)
   (cons "LXXX" 80)
   (cons "XC" 90)))

(define tabla-centenas
  (list
   (cons "" 0)
   (cons "C" 100)
   (cons "CC" 200)
   (cons "CCC" 300)
   (cons "CD" 400)
   (cons "D" 500)
   (cons "DC" 600)
   (cons "DCC" 700)
   (cons "DCCC" 800)
   (cons "CM" 900)))

;;;;La partes. Un punto = miles de lo siguiente
(define partes.romano
  (lambda (s)
    (define partes.romano
      (lambda (s temp salida)
        (if (string=? s "")
            (if (null? salida)
                temp
                (if (string=? temp "")
                    (reverse salida)
                    (reverse (cons temp salida))))
            (if (char=? (string-ref s 0) #\.)
                (partes.romano
                 (substring s 1 (string-length s))
                 ""
                 (cons temp salida))
                (partes.romano
                 (substring s 1 (string-length s))
                 (string-append temp (make-string 1 (string-ref s 0)))
                 salida)) ) ))
    (partes.romano s "" '()) ))

;;;;Análisis de centenas, decenas, unidades
(define corresponde
  (lambda (s tabla)
    (define aux
      (lambda (s tabla)
        (if (null? tabla)
            #f
            (if (string=? s (caar tabla))
                (car tabla)
                (aux s (cdr tabla)))) ))
    (aux s tabla) ))

(define por-bloques
  (lambda (s)
    (define tablas (list tabla-centenas tabla-decenas tabla-unidades))
    (define salida '())
    (define aux
      (lambda (s tablas)
        (if (null? tablas)
            salida
            (let ((item (bloque s 4 (car tablas))))
              (set! salida (cons (cdar item) salida));(cons (car item) salida)
              (aux (cdr item) (cdr tablas)) )) ))
    (aux s tablas) ))

(define bloque
  (lambda (s long tabla)
    (let* ((item (substring s 0 (if (>= (string-length s) long) long (string-length s))))
           (resto (if (>= (string-length s) long) (substring s long (string-length s)) ""))
           (correspondencia (corresponde item tabla))
           )
      (if (zero? long)
          (cons correspondencia resto);0;#f
          (if correspondencia
              (cons correspondencia resto)
              (bloque s (sub1 long) tabla)))) ))
;;; La suma final
(define calculo
  (lambda (lista n)
    (if (null? lista)
        0
        (+
         (* n
            (apply + (car lista)))
         (calculo (cdr lista) (* n 1000)) ) ) ))
;;; El intérprete
(define romano->decimal
  (lambda (r)
    (define partes (partes.romano r))
    (define aux
      (lambda (lista salida)
        (if (null? lista)
            salida
            (aux (cdr lista) (cons
                              (por-bloques (car lista));(apply + (por-bloques (car lista)))
                              salida))) ))
;    (printf "~s ~n" r)
    (calculo (aux partes '()) 1) 
    ))

;(romano->decimal "XXXIV.DCCLXXXVI")

(provide romano->decimal)