Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

Untitled

By: a guest on Feb 12th, 2013  |  syntax: None  |  size: 2.00 KB  |  views: 26  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  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))))))