GREIBACH.LSP

;-------------------------------------------------------------------------
; Programa: 	Forma normal de Greibach
;
;
; Manera de ejecutarse:
;
;	(setq A1 '(( A 2 A 3 ))       )
;	(setq A2 '(( A 3 A 1 )( TB )) )
;	(setq A3 '(( A 1 A 2 )( TA )) )
;
;	(setq gram '(A1 A2 A3) )
;
;<------------------------------------------------->
;<--------Para correr el programa teclear --------->
;<--------(c:\>mulisp greibach.lsp)       --------->
;<--------(run)                           --------->
;<------------------------------------------------->
;
;
ciones)
;	A1 ---------> A2 A3
;	A2 ---------> A3 A1 | b
;	A3 ---------> A1 A2 | a
;-------------------------------------------------------------------------
;
;producciones
(setq A1 '(( A 2 A 3 ))       )
(setq A2 '(( A 3 A 1 )( TB )) )
(setq A3 '(( A 1 A 2 )( TA )) )

(setq gram '(A1 A2 A3) )
(setq b_gram '(B1 B2 B3)) ;futuras y posibles producciones

(defun run(); <-------------- OK --------------->
   (es_greibach_normal gram '(1 2 3))
   (genera_prod (car (cdr (cdr gram))) )
   (genera_greibach (cdr gram) )
   (imprime_resultado gram)
   ;(system)
)

(defun es_greibach_normal (lista aux); <-------------- OK --------------->
   (loop
     (if (null lista) (return) )
     (setq ok (normal_ok (car lista) nchoms) )
     (if (= ok 0) (chomsky (car lista) gram) )
     (setq lista (cdr lista))
     (setq aux (cdr aux))   )   )

(defun normal_ok (variable n); <-------------- OK --------------->
   (if (eq ta (car ok_lista)) (return 1) )
   (if (eq tb (car ok_lista)) (return 1) )
   (if (>= ok_lista n) (return 1) )
   (if (< ok_lista n)  (return 0) )    )

(defun chomsky (act l_gram)
   (setq gram_new (eval (nth (- (second (car (eval act))) 1) l_gram)))
   (elimina act)                 ; quita el primer elemento
   (conv_chomsky act gram_new)  )

(defun conv_chomsky (act gram_new)
   (setq resto (cdr (eval act))); ((TA))
   (setq prod_nueva '())
   (unir gram_new (car (eval act)))
   (if (eq a1 (eval act)) (setq a1 (append prod_nueva resto)) )
   (if (eq a2 (eval act)) (setq a2 (append prod_nueva resto)) )
   (if (eq a3 (eval act)) (setq a3 (append prod_nueva resto)) )
   (setq ok (normal_ok act nchoms) );***********Se queda hasta que se
   (if (= ok 0) (chomsky act gram) );******convierta a chomsky
)

(defun imprime_resultado (lista); <-------------- OK --------------->
   (print 'resultados)
   (loop
       (if (null lista) (return) )
       (print (car lista))
       (print (eval (car lista)))
       (setq lista (cdr lista))   ))

(defun elimina (act); <-------------- OK --------------->
   (setq e1 (append (list (cdr (cdr (car (eval act))))) (cdr (eval act))))
   (if (eq a1 (eval act)) (setq a1 e1))
   (if (eq a2 (eval act)) (setq a2 e1))
   (if (eq a3 (eval act)) (setq a3 e1))   )

(defun unir (gram_new e1); <-------------- OK --------------->
 (cond ((null gram_new) nil)
  (t 
    (setq prod_nueva (append prod_nueva (list (append (car gram_new) e1))))
    (unir (cdr gram_new) e1)  ) ) )

(defun genera_prod (act); <-------------- OK --------------->
   (setq b3 (list (cdr (cdr (car (eval act))))) ) ;((a1 a3 a2))
   (setq temp (cdr (cdr (car (eval act)))) )        ; (a1 a3 a2)
   (setq b_3 (list (append temp (list 'b3))) )
   (setq gram (reverse gram))
   (setq gram (append gram (list 'b3) (list 'b_3)) )
   (if (eq a1 (eval act)) (setq a1 (cdr (eval act))))
   (if (eq a2 (eval act)) (setq a2 (cdr (eval act))))
   (if (eq a3 (eval act)) (setq a3 (cdr (eval act))))
   (setq temp a3)
   (inserta temp (list 'b3)); crea el nuevo a3
   (setq a3 (append rafa a3))
)

(defun inserta (lista dato); <-------------- OK --------------->
   (setq rafa '())
   (loop 
      (if (null lista) (return))
      (setq rafa (append rafa (list (append (car lista) dato))))
      (setq lista (cdr lista))
   )
)

(defun genera_greibach (lgram)
   (cond ((null lgram) nil)
        (t (conv (car lgram) )
           (genera_greibach (cdr lgram))
        )
   )
)

(defun conv (act) ;regreso en temp
   (setq temp '())
   (setq num (car (cdr (car (eval act)))) );asignaciones obligatorias
   (setq new (cdr (cdr (car (eval act)))) )
   (insert)
   (if (eq a2 (eval act)) (setq a2 (append temp (cdr (eval act)))) )
   (if (eq a1 (eval act)) (setq a1 (append temp (cdr (eval act)))) )
   (if (eq b3 (eval act)) (setq b3 (append temp (cdr (eval act)))) )
   (if (eq b_3 (eval act)) (setq b_3 (append temp (cdr (eval act)))) )
)

   (print 'numero)
   (if (= num 1) (greibach a1) )
   (if (= num 2) (greibach a2) )
   (if (= num 3) (greibach a3) )
)

(defun greibach (prods)
   (cond ((null prods) nil)
         (t (setq temp (append temp (list (append (car prods) new))))
            (greibach (cdr prods) new)
         )
   )
)