1.  
  2. (defun fbf-fun (fbf)
  3. (or (negazione fbf)
  4. (cong fbf)
  5. (disg fbf)
  6. (implicazione fbf)
  7. (universale fbf)
  8. (existenciale fbf)
  9. (predicato fbf)))
  10.  
  11. (defun negazione (fbf)
  12. (and (eq (first fbf) 'not)
  13. (fbf-fun (second fbf))
  14. (= (length fbf) 2)))
  15.  
  16. (defun cong (fbf)
  17. (and (eq (first fbf) 'and )
  18. (reduce (lambda (x y) (and x y))
  19. (mapcar #'fbf-fun (rest fbf)))))
  20.  
  21. (defun disg (fbf)
  22. (and (eq (first fbf) 'or)
  23. (reduce (lambda (x y) (and x y))
  24. (mapcar #'fbf-fun (rest fbf)))))
  25.  
  26. (defun implicazione (fbf)
  27. (and (eq (first fbf) '==>)
  28. (fbf-fun (second fbf))
  29. (fbf-fun (third fbf))
  30. (= 3 (length fbf))))
  31.  
  32. (defun universale (fbf)
  33. (and (eq (first fbf) 'forall)
  34. (variabile (second fbf))
  35. (fbf-fun (third fbf))
  36. (= 3 (length fbf))))
  37.  
  38.  
  39. (defun existenciale (fbf)
  40. (and (eq (first fbf) 'exist)
  41. (variabile (second fbf))
  42. (fbf-fun (third fbf))
  43. (= 3 (length fbf))))
  44.  
  45. (defun costante (fbf)
  46. (or (numberp fbf)
  47. (alpha-char-p (char (string 'fbf) 0))))
  48.  
  49. (defun variabile (fbf)
  50. (and (symbolp fbf)
  51. (char= #\? (char (symbol-name fbf) 0))))
  52.  
  53. (defun funzione (fbf)
  54. (and (symbolp (first fbf))
  55. (or (reduce (lambda (x y) (and x y))
  56. (mapcar #'termine (rest fbf)))
  57. (null (rest fbf)))))
  58.  
  59. (defun termine (fbf)
  60. (or (costante fbf)
  61. (variabile fbf)
  62. (funzione fbf)))
  63.  
  64. (defun predicato (fbf)
  65. (or (and (symbolp fbf)
  66. (alpha-char-p (char (string 'fbf) 0)))
  67. (and (symbolp (first fbf))
  68. (or (reduce (lambda (x y) (and x y))
  69. (mapcar #'termine (rest fbf)))
  70. (null (rest fbf))))))