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

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

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

今回は、前回のものを一捻りして、与える式をより普通の数式に近い表現で与えられるようにするというお題です。

適当に、2引数であることを決め打ちにして、中間記法→前置記法変換を書いてみました。

conjunct-not-exprという表現が英語として正しいのかどうかは謎です…。

(let (A B) '(t nil)
  (table/b (A B)
   ;; 式
   A *and (A *or not B)))
;=> ====
;   t: t => t
;   t: nil => t
;   nil: t => nil
;   nil: nil => nil

(mac table/b ((a b) . expr)
  `(do (prn "\n====")
       (each (,a ,b) (perm (list ,a ,b))
         (prf "~ : ~  => ~ \n" ,a ,b ,(to-prefix expr)))))

(def to-prefix (expr)
  ((afn (expr)
     (if atom.expr expr
         ;; not X ...
         (and (acons expr) (is 'no car.expr)) 
         (if (acons cadr.expr)
             `(no ,(self cadr.expr))
             expr)
         ;; X ...
         (atom car.expr) 
         (let (a pred b) expr
           `(,pred ,a ,self.b))
         ;; (X ...) ...
         'else
         (let (a pred b) expr
           `(,pred ,self.a ,self.b))))
   (conjunct-not-expr expr)))

;; notを先に結合させるための関数
(def conjunct-not-expr (expr)
  (if no.expr ()
      ;; not X ...
      (is 'not car.expr) 
      `((no ,(if (atom cadr.expr)
                  cadr.expr
                  (conjunct-not-expr cadr.expr)))
        ,@(conjunct-not-expr cddr.expr))
      ;; X ...
      (atom car.expr)
      (cons car.expr (conjunct-not-expr cdr.expr))
      ;; (X ...) ...
      'else 
      (cons (conjunct-not-expr car.expr)
            (conjunct-not-expr cadr.expr))))