#lang scheme
(require "BaseDatos-Lpo.rkt")
(require "Gramatica-Lpo.rkt")

(define asienta-en-bd
  (lambda (s-expr)
    (cond
      ((regla? s-expr) 
       (let*-values ([(consecuente) (second s-expr)]
                     [(nuevo-predicado) (first consecuente)]
                     [(hechos reglas) (subtabla-o-regla consecuente)]
                     [(rule) (if (null? reglas) reglas (first reglas))]
                     [(consecuente-rule) (if (null? rule) #f (second rule))]
                     )
         (if consecuente-rule
             (printf "ya existe la regla: ~a~n" rule)
             (begin
               (printf "hay que añadir la regla ~a~n" s-expr)
               (set! BD (append BD (list s-expr))) 
               BD)
             ) 
         )
       )
      ((expr-atomica? s-expr 'hecho) 
       (let*-values ([(hechos reglas) (subtabla-o-regla s-expr)])
         (if (member s-expr hechos)
             (printf "ya existe el hecho ~a~n" s-expr)
             (begin
               (printf "hay que añadir el hecho ~a~n" s-expr)
               (set! BD (cons s-expr BD))
               BD)
             ) 
         ;(values hechos reglas)
         )
       )
      (else (printf "~a no es ni un hecho ni una regla~n" s-expr))
      )   
    ))
(define regla?
  (lambda (s-expr)
    (if (eq? (first s-expr) 'regla)
        (and
         (ebf? (second s-expr))
         (ebf? (third s-expr)))
        #f)))

(define add-hecho
  (lambda (hecho edb)
    (append edb (list hecho)) ))
(define add-regla
  (lambda (regla idb)
    (append idb (list regla)) ))

(asienta-en-bd '(regla (abuelo X Z) (y (progenitor X Y) (progenitor Y Z))))
(asienta-en-bd '(padre juan luis))

