Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2008-03-25

Common LispでL-99 (P47 真偽値表 その2)

| 18:40 | Common LispでL-99 (P47 真偽値表 その2) - わだばLisperになる を含むブックマーク はてなブックマーク - Common LispでL-99 (P47 真偽値表 その2) - わだばLisperになる

Common Lispで挑戦していたときには、中間記法に直すのが面倒臭くて、解答を作ってなかったことに気付いたので、Common Lisp版も作成。

いまいちtableの引数の扱いが不明。この辺は、PrologとLispの違いという感じもしたり、しなかったり。

(table/b ((A t) (B nil))
  A and (A or not B))
;=> T : T => T
;   T : NIL => T
;   NIL : T => NIL
;   NIL : NIL => NIL

(defmacro TABLE/B ((a b) &body expr)
  `(LET (,a ,b)
     (DOLIST (X (PERM (LIST ,(car a) ,(car b))))
       (DESTRUCTURING-BIND (A B) x
         (FORMAT T "~A : ~A => ~A~%" a b ,(to-prefix expr))))))

(defun TO-PREFIX (expr)
  (labels ((frob (expr)
             (cond ((atom expr) expr)
                   ((and (consp expr) (eq 'not (car expr))) 
                    (if (consp (cadr expr))
                        `(not ,(frob (cadr expr)))
                        expr))
                   ((atom (car expr))
                    (destructuring-bind (a pred b) expr
                      `(,pred ,a ,(frob b))))
                   ('T (destructuring-bind (a pred b) expr
                         `(,pred ,(frob a) ,(frob b)))))))
    (frob (conjunct-not-expr expr))))

(defun CONJUNCT-NOT-EXPR (expr)
  (cond ((null expr) () )
        ((eq 'not (car expr))
         `((not ,(if (atom (cadr expr))
                     (cadr expr)
                     (CONJUNCT-NOT-EXPR (cadr expr))))
           ,@(CONJUNCT-NOT-EXPR (cddr expr))))
        ((atom (car expr))
         (cons (car expr) (CONJUNCT-NOT-EXPR (cdr expr))))
        ('T (cons (CONJUNCT-NOT-EXPR (car expr))
                  (CONJUNCT-NOT-EXPR (cdr expr))))))
;