#lang racket

(define vocabulario (list #\m #\g #\-))

(define concatenar string-append)

(define-syntax ristra?
  (syntax-rules ()
    [
     (ristra? s)
     (andmap
      (lambda (char)
        (if (member char vocabulario)
            #t
            #f))
      (string->list s))
     ]
    ))

(define-syntax ristra-bien-formada?
  (syntax-rules ()
    [
     (ristra-bien-formada? s)
     (letrec ((aux
               (lambda (lista esquema)
                 (cond 
                   ((null? lista) 
                    #t)
                   ((char=? (first lista) #\g)
                    (if (member #\g esquema)
                        (aux (rest lista) (remove #\g esquema))
                        #f) )
                   ((char=? (first lista) #\m) 
                    (if (member #\m esquema)
                        (aux (rest lista) (remove #\m esquema))
                        #f) )
                   ((char=? (first lista) #\-) 
                    (aux (rest lista) esquema))
                   (else #f)
                   )))
              )
       (aux (string->list s) (list #\- #\m #\g)) )
     ]
    ))

(define-syntax axioma?
  (syntax-rules ()
    [
     (axioma? s)
     (letrec ((g1 0)
              (g2 0)
              (g3 0)
              (aux
               (lambda (lista esquema)
                 (cond 
                   ((null? lista) 
                    (and (= g2 1) (= g3 (+ g1 g2))) )
                   ((char=? (first lista) #\g)
                    (if (member #\g esquema)
                        (aux (rest lista) (remove #\g esquema))
                        #f) )
                   ((char=? (first lista) #\m) 
                    (if (member #\m esquema)
                        (aux (rest lista) (remove #\m esquema))
                        #f) )
                   ((char=? (first lista) #\-)
                    (cond
                      ((equal? esquema (list #\- #\m #\g))
                       (set! g1 (add1 g1))
                       (aux (rest lista) esquema)
                       )
                      ((equal? esquema (list #\- #\g))
                       (set! g2 (add1 g2))
                       (aux (rest lista) esquema)
                       )
                      ((equal? esquema (list #\-))
                       (set! g3 (add1 g3))
                       (aux (rest lista) esquema)
                       )
                      )
                      )
                   (else #f)
                   )))
              )
       (aux (string->list s) (list #\- #\m #\g)) )
     ]
    ))
(define teorema?
  (lambda (s)
    (if (axioma? s) 
        #t
        (teorema? (regla->reduccion s)))
    ))

(define regla->produccion
  (lambda (s)
    (letrec ((aux
              (lambda (lista esquema)
                (printf "~a~n" (list->string lista))
                (cond
                  ((null? lista) '())
                  ((char=? (first lista) #\g)
                   (cons 
                    (first lista)
                    (cons
                     #\-
                     (aux (rest lista) (remove #\g esquema)))) )
                  ((char=? (first lista) #\m)
                   (cons
                    (first lista)
                    (cons
                     #\-
                     (aux (rest lista) (remove #\m esquema)))) )
                  (else
                   (cons
                    (first lista)
                    (aux (rest lista) esquema)))
                  )
                ))
             )
      (list->string
       (aux (string->list s) (list #\- #\m #\g)))
      )
    )
  )
(define regla->reduccion
  (lambda (s)
    (letrec ((aux
              (lambda (lista esquema)
                (printf "~a~n" (list->string lista))
                (cond
                  ((null? lista) '())
                  ((char=? (first lista) #\g)
                   (cons 
                    (first lista)
                     (aux 
                      (rest(rest lista)) (remove #\g esquema))) )
                  ((char=? (first lista) #\m)
                   (cons
                    (first lista)
                     (aux 
                      (rest(rest lista)) (remove #\m esquema))) )
                  (else
                   (cons
                    (first lista)
                    (aux (rest lista) esquema)))
                  )
                ))
             )
      (list->string
       (aux (string->list s) (list #\- #\m #\g)))
      )
    )
  )
(define-syntax make-teorema
  (syntax-rules ()
    [
     (make-teorema s)
     (if (teorema? s)
         (regla->produccion s)
         (printf "~a no es un teorema~n"))
     ]
    ))

      