#:g1: frontpage

 

いつのまにやらArc公開十周年

Posted 2018-04-15 19:31:36 GMT

すっかり忘れてしまっていましたが、「百年の言語」を体現するarcが公開されたのは、十年前の2008-01-29のことでした。
本当は、今年の01-29に何か書こうと思っていましたが、それさえ忘れて早二ヶ月半……。

arcのソースコードが公開されたのは2008年でしたが、arcで構築されたサイトのHacker Newsは、2007年から稼動しています。
また、名前と構想が発表されたのは、2001年のことなので、かれこれ十八年ともいえなくもないです。

最近のarc

arcの近況を眺めてみましたが、オフィシャルなリリースは、2009-08の3.1から9年間動きなしです。
Hacker Newsを動かしていたのはarcでしたが、2014年にpg氏がY Combinatorの日常業務から引退し、今ではまだarcで動いているのかは良く分からないようです。

軒並動きはないのかと思いましたが、arcのコミュニティが開発しているAnarkiの方は最近も更新があるようです。
Racketに#lang anarkiを作成するなど、なかなか面白そう。

早速、試してみましたが、Racketがインストールされた環境であれば、

raco pkg install anarki

とするだけで導入されます。

あとは、こんな感じで記述しRacketから使えます。 (無理にarcっぽさを出してみました。)

#lang anarki

;;; fib.rkt

(:provide fib)

(def fib (n) (if (< n 2) n (+ (fib:- n 2) (fib:- n 1))))

;; Racket
(require "fib.rtk")

(fib 40) ;→ 102334155

むすび

もっと色々書こうと思いましたが、昔の文献を読んでいたらお腹一杯になって満足しました。

参考

このブログのarc関係の記事


HTML generated by 3bmd in LispWorks 7.0.0

strings.arcの紹介

Posted 2014-05-14 15:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の135日目です。

strings.arcとはなにか

 strings.arcは、arcに標準で添付されてくる文字列ライブラリです。

パッケージ情報

パッケージ名strings.arc

インストール方法

 http://ycombinator.com/arc/arc3.1.tarからダウンロードしてきてarcをセットアップすれば標準でインストールされています。

試してみる

 とりあえず、全部眺めていってみましょう。

tokens

 所謂splitです。区切りの文字も指定できます。

(tokens "foo bar baz")
;=>  ("foo" "bar" "baz")

(tokens "foo.bar.baz" #\.) ;=> ("foo" "bar" "baz")

halve

 一回だけsplitするというもの。便利なんでしょうか。

(halve "foo bar baz" )
;=>  ("foo" " bar baz")

(halve "foo.bar.baz" #\.) ;=> ("foo" ".bar.baz")

positions

 区切りの位置を返すもの。pg氏はこういう関数を多用するプログラミングスタイルな気はします。

(positions #\. "foo.bar.baz")
;=>  (3 7)
lines

 改行でsplitするもの

(lines "1
2
3
4")
;=>  ("1" "2" "3" "4")

(lines "1\n2\n3\n4")
;=> ("1" "2" "3" "4")
slices

 tokensと何が違うんだろうなという感じです。

(slices "foo.bar.baz" #\.)
;=>  ("foo" "bar" "baz")

(slices "foo.bar.baz" ~alphadig) ;=> ("foo" "bar" "baz")

urlencode

 UTF-8に対応してる的なことがソースに書いてありますが、ご覧の通り日本語ではまずいことになっています。

(urlencode  "おはよう日本" )
;=>  "%304A%306F%3088%3046%65E5%672C"
urldecode

 urlencodeの逆

(urldecode "%304a%306f%3088%3046%65e5%672c")
;=> ...........
litmatch

 目的の文字列で開始されているかどうかを判定

(litmatch "lahalito" "loktofeito lahalito sopic")
;=>  nil

(litmatch "lahalito" "loktofeito lahalito sopic" 11)
;=>  t
endmatch

 指定した文字列で終わっているかを判定

(endmatch "sopic" "loktofeito lahalito sopic")
;=>  t
posmatch

 指定した文字列がマッチしている開始位置を返すもの

(posmatch "sopic" "loktofeito lahalito sopic")
;=>  20
headmatch

 litmatchと同じ。違いが気になります。

(headmatch "sopic" "loktofeito lahalito sopic")
;=>  nil

(headmatch "sopic" "loktofeito lahalito sopic" 20)
;=>  t
begins

 headmatchに同じ。こういう関数が好きなのでしょうか。

(begins "foo.bar.baz" "foo")
;=>  t
subst

 oldをnewで置換します。引数は、new old targetという順

(subst "badi" "litokan" "litokan litokan litokan")
;=>  "badi badi badi"
multisubst

 複数のoldをnewで置換します。置換を指示するリストでは何故かold newという順

(multisubst '(("litokan" "badi") ("mogref" "haman"))
                "litokan mogref litokan mogref litokan")
;=>  "badi haman badi haman badi"
findsubseq

 指定の文字列が含まれているかどうかを判定

(findsubseq "lorto" "montinobadilatumapiclortokalki")
;=>  20
blank

 空白文字かどうかを判定

(blank "")
;=>  t

(map blank '("" "\n" "\r" "\t"))
;=> (t t t t)
nonblank

 blankの逆

(map nonblank '("" "\n" "\r" "\t"))
;=> (nil nil nil nil)
trim

 文字列をトリミング。トリミングする文字と位置を指定可能

(trim "   fooo  " 'both)
;=>  "fooo"

(trim "   fooo  " 'front)
;=>  "fooo  "

(trim "   fooo  " 'end)
;=>  "   fooo"

(trim "_____fooo__" 'both #\_)
;=>  "fooo"
num

 数値を文字列に変換。表示する小数点以下の桁数を指定可能。

(num 1234)
;=>  "1,234"

(num 1234 2 t)
;=>  "1,234.00"
pluralize

 文字列を複数形に。あまり期待してはいけません。

(pluralize 1 "arc" )
;=>  "arc"

(pluralize 2 "arc" )
;=>  "arcs"

(pluralize 2 "ox")
;=>  "oxs"
plural

 数値と対象を複数形/単数形で返すもの

(plural 2 "arc")
;=>  "2 arcs"

(plural 1 "arc")
;=>  "1 arc"

関連

まとめ

 今回は、strings.arcを紹介してみました。
なかなかpg氏っぽくて興味深いのではないかと思います。
ちなみに、pg氏は最近arcにまた力を入れ始めそうなので期待したいところです。

ArcのcomposeをCLでがんばる

Posted 2012-08-24 17:21:00 GMT

Common Lispのリーダーマクロは大体の事はできますが、「∘」にリーダーマクロを設定することで

car∘cdr 
(compose car cdr)
に展開するようなことはできません。readが一つ前の式を保存するような機能があれば、簡単にできそうではありますが、残念ながらそういう機能はCommon Lispにはありません。
しかし、foo.bar.bazのようなメソッドチェーン的な表現を(foo (bar (baz)))としたいという需要は結構あるようで、どうやったらできるのかというのは、割とFAQな気がします。
読み取り以外にも色々組み合わせて苦肉の策を練るか、構文を若干妥協することになりますが、私個人としては、まあ、∘foo∘bar位なら妥協しても良いかなというところで、
(defun compose-reader (stream char)
  (declare (ignore char))
  `(arc:compose
    ,@(loop :for fctn := (read-preserving-whitespace stream t nil t)
             :then (progn (read-char stream t nil t)
                          (read-preserving-whitespace stream t nil t))
             :collect `#',fctn
             :while (eql (peek-char nil stream nil nil t) #\∘))))

(set-macro-character #\∘ #'compose-reader)

(mapcar ∘list∘(lambda (x) (* 2 x)) '(1 2 3 4)) ;=> ((2) (4) (6) (8))

位が落とし所かなと思ったりしています。

苦肉の策

苦肉の策としては、()に付いているリーダーマクロを変更したり、internを改造したり、with-〜で囲まれたところは有効になる、等々考えられますが、Ron Garret氏がRe: Anonymous packages (comp.lang.lisp)で紹介している、アルファベット全部にリーダーマクロを付けるという方法を思い出したので試しに作ってみました
(let ((r (copy-readtable nil)))
  (defun read-symbol (stream)
    (let* ((*readtable* r)
           (obj (read-preserving-whitespace stream)) )
      (typecase obj
        (symbol (let ((symname (ppcre:split #\∘ (symbol-name obj))))
                  (if (cdr symname)
                      (values (mapcar (lambda (s) `#',(intern s)) symname) t)
                      obj )))
        (otherwise obj) ))))

(defun compose-reader-macro-reader (stream char) (unread-char char stream) (multiple-value-bind (expr win) (read-symbol stream) (if win (let ((args (gensym))) `(lambda (&rest ,args) (declare (dynamic-extent ,args)) (apply (arc:compose ,@expr) ,args) )) expr )))

(map nil (lambda (c) (cl:set-macro-character c #'compose-reader-macro-reader t)) "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_")

動作

(car∘car∘list∘list car∘cdr)
;=>  #<FUNCTION (COMMON-LISP:LAMBDA (COMMON-LISP:&REST #:G10378)) {10131BC51B}>

マクロ展開

((LAMBDA (&REST #:G10398)
   (DECLARE (DYNAMIC-EXTENT #:G10398))
   (APPLY (ARC:COMPOSE #'CAR #'LIST #'LIST) #:G10398))
 (LAMBDA (&REST #:G10399)
   (DECLARE (DYNAMIC-EXTENT #:G10399))
   (APPLY (ARC:COMPOSE #'CAR #'CDR) #:G10399)))
できなくもないですが、アルファベットにリーダーマクロを付けるというのが、やっぱり気持ち悪いです。
Arcのリーダーを眺めてみましたが、読み取った文字列をcompose(:)の文字で分解したりしている様なので、動きとしては、割とこっちに近かったりはするみたいです。

ちなみに、Franz Lispでは、中置のリーダーマクロが書けたようですが、

(defun plusop (x)
  (cond ((null x) (tconc nil '+))
        (t (lconc nil (list 'plus (caar x) (read))))))

(setsyntax '+ 'vinfix-macro 'plusop)

(a + b) ;=> (plus a b)

Common Lispも、これ位手軽に書けたら良かったですね

ArcでL-99 (P59 左右で高さのバランスのとれた二分木)

Posted 2008-05-17 20:09:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
ここでいう左右で高さのバランスのとれた二分木とは、左右の木た高さの差が±1までの二分木とのこと。
本来バックトラックで解くところですが、全通り生成しております。
そして、hbal-treeで条件を満した木を選り分けているのですが、最初から条件を満した木を生成してしまっているため、意味のないことになっております…。

;(each x (firstn 5 (hbal-tree 3)) (prn x))
;>>>
;(x (x (x nil nil) (x nil nil)) (x (x nil nil) (x nil nil)))
;(x (x (x nil nil) nil) (x (x nil nil) (x nil nil)))
;(x (x nil (x nil nil)) (x (x nil nil) (x nil nil)))
;(x (x (x nil nil) (x nil nil)) (x (x nil nil) nil))
;(x (x (x nil nil) nil) (x (x nil nil) nil))

(def hbal-tree (h) (keep hbal-tree-p gen-tree-h.h))

(def gen-tree-h (h) (case h 0 '(()) 1 '((x () ())) (with (h-1 (gen-tree-h (- h 1)) h-2 (gen-tree-h (- h 2))) (map (fn (tree) `(x ,@tree)) `(,@(comb2 h-1 h-1) ,@(comb2 h-1 h-2) ,@(comb2 h-2 h-1))))))

(def hbal-tree-p (tree) (let (_ left right) tree (>= 1 (abs (- tree-height.left tree-height.right))))

(def tree-height (tree) (let (_ left right) tree (if tree (+ 1 (max tree-height.left tree-height.right)) 0)))


ArcでL-99 (P58 線対称な二分木を探す)

Posted 2008-05-11 09:02:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前に作成したcbal-treeとsymmetric?を組み合わせて作成。
また、57ノードの時に線対称な二分木は幾つかという問いもあり。
57ノードの場合、cbal-treeで作成する木が多くてコンスが多くなりすぎるためか、CLだと、2、3秒のところが、Arcだと、解答に11分位かかってしまいます。
keepは、CLでは、remove-if-notに相当します。

(each tr sym-cbal-trees.5
  prn.tr)
;>>> (x (x (x nil nil) nil) (x nil (x nil nil)))
;>>> (x (x nil (x nil nil)) (x (x nil nil) nil))

;(len:sym-cbal-trees 57) ;=> 256

(def sym-cbal-trees (n) (keep symmetric? cbal-tree.n))

ArcでL-99 (P57 二分探索木の作成)

Posted 2008-05-03 01:51:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
久々のArc。今回のお題は、数値のリストを二分探索木的に配置しましょう、というもの。
また、その結果を前回作成した、symmetric?で確認してみよう、とのことです。

(construct '(3 2 5 7 1))
;=> (3 (2 (1 nil nil) nil) (5 nil (7 nil nil)))

;; symmetric?で確認 (symmetric? (construct '(5 3 18 1 4 12 21))) ;=> t

(symmetric? (construct '(3 2 5 7 1))) ;=> nil

(def add-leaf (leaf tree) (with ((root left right) tree node `(,leaf () () )) (if (<= leaf root) (if no.left `(,root ,node ,right) `(,root ,(add-leaf leaf left) ,right)) (if no.right `(,root ,left ,node) `(,root ,left ,(add-leaf leaf right))))))

(def construct (lst) (reduce (fn (lst leaf) (add-leaf leaf lst)) (let (head . tail) lst (cons `(,head () () ) tail))))


ArcでL-99 (P56 二分木が線対称な構成かを調べる)

Posted 2008-04-19 09:59:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
バックトラックをどうしようか、と考えていたら全然進めなくなったので、それは置いておいて、まずは普通にリスト操作で解いて後で考えることにしました。
後ではやらない可能性もありますが…(笑)
mirrorという補助関数を定義して解いてみよう、ということなので、反転して同じ構成かを比較しろ、ということなのかと思い、そういう風に書いてみました。
個々の葉の要素が同じかではなく、構成が同じかどうか、ということなので、skeltonという構成をコピーする関数を定義して比較しています。

(symmetric? '(x nil (x (x (x nil nil) (x nil nil))
                       (x nil (x nil nil)))))
;=> nil

(symmetric? '(x (x (x (x nil nil) (x nil nil)) (x nil (x nil nil))) (x (x (x nil nil) nil) (x (x nil nil) (x nil nil))))) ;=> t

(def mirror (tree) (if no.tree () (let (rt l r) tree `(,rt ,mirror.r ,mirror.l))))

(def skelton (tree) (if no.tree () (let (rt l r) tree `(x ,(skelton l) ,(skelton r)))))

(def symmetric? (tree) (let skel (skelton tree) (iso skel (mirror skel))))

Arcでletrec、内部define

Posted 2008-04-05 18:32:00 GMT

ArcにはSchemeのletrecや、CLのlabelsに相当する構文がないのだけれど、

(def fact (n)
  (let f1 ()
    (= f1
       (fn (c acc)
         (if (is 0 c)
             acc
             (f1 (- c 1) (* c acc)))))
    (f1 n 1)))
のように書くことになるのだろうか。
同様に内部defineは、
(def fact (n)
  (let f1 ()
    (def f1 (c acc)
      (if (is 0 c)
          acc
          (f1 (- c 1) (* c acc))))
    (f1 n 1)))
のように書くことになるのだろうか。
どっちにしろ、letでローカル束縛を作れば、大域定義になるのを防げる。

ArcでL-99 (P55 左右のバランスがとれた二分木)

Posted 2008-04-04 15:54:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、左右のバランスがとれた二分木を生成するのがお題ですが、元がPrologの問題ということもあってバックトラックを使用して解くように、ということになっています。
バランスが取れていることの定義ですが、各々の部分木ごとにノード数が同じか、1つ違うだけ、とのこと。
ここは、Scheme風のバックトラックを使うかどうか迷いましたが、分からなくなったので前にCLで作ったものを移植しました(;´Д`)…。
これは、バックトラックではなくて、力技で全部の組み合わせのリストを生成します。
しかし、バックトラックを使って解けるようにならないと、この先かなり苦戦すると思うので、ここはちょっと保留して、Scheme風のバックトラックでどう書けるのか、考えてみた方が良いのかもしれない…。

細々

+0と、0.0が同じものであると判定する方法が分からなかったので、(iso 0 0.0) -> nil、==というものを作って比較しています。
+Arcのreduceは初期値を設定できないので、redという初期値を設定できるreduceをでっちあげました。

(each p (cbal-tree 6)
  (prn p))
;=>
;(x (x (x nil nil) (x nil nil)) (x nil (x nil nil)))
;(x (x (x nil nil) (x nil nil)) (x (x nil nil) nil))
;(x (x nil (x nil nil)) (x (x nil nil) (x nil nil)))
;(x (x (x nil nil) nil) (x (x nil nil) (x nil nil)))
;nil

(def cbal-tree (n) (if (is 0 n) '(()) (>= 1 n) '((x () () )) 'else (red (fn (res x) (let tree `(x ,@x) (if cbal-tree-p.tree `(,tree ,@res) res))) () ;init (let half (/ (- n 1) 2) (if nofraction.half ;; balance (comb2 cbal-tree.half cbal-tree.half) ;; unbalance (with (g (+ 1 trunc.half) ;greater l trunc.half) ;less `(,@(comb2 cbal-tree.l cbal-tree.g) ,@(comb2 cbal-tree.g cbal-tree.l))))))))

(def nofraction (num) (== 0 (- num (trunc num))))

(def cbal-tree-p (tree) (let (ro l r) tree (>= 1 (abs (- count-leaf.l count-leaf.r)))))

(def count-leaf (tree) (iflet (ro l r) tree (+ 1 count-leaf.l count-leaf.r)) 0)

(def comb2 (xs ys) (mappend (fn (y) (map (fn (x) `(,x ,y)) xs)) ys))

(def red (f init lst) (reduce f (cons init lst)))

(def == (x y) (and (>= x y) (<= x y)))

ArcでL-99 (P54a 二分木かどうかを判定)

Posted 2008-04-02 12:21:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回から二分木篇に突入です。番号はどういう訳かいきなり54a。
ここでの二分木とは、(x nil nil)という風に定義し、(根 葉 葉)というリストで表現されるとのことです。
木は根と葉から成り、根はアトム、葉は木から成ります。
それで今回のお題は、二分木になっているかを判定する関数を書けとのこと。

(atree '(1 2 3)) ;=> nil
(atree '(x nil nil)) ;=> t
(atree '(x (x nil nil) (x nil (x nil nil)))) ;=> t
(atree '(x (x nil nil) (x nil (x nil nil x)))) ;=> nil

(def atree (tree) (if atom.tree no.tree 'else (and (is 3 len.tree) (let (root left right) tree (and atom.root root atree.left atree.right)))))

ArcでL-99 (P50 ハフマン符号化)

Posted 2008-03-31 11:35:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
算術と符号化篇の最後である、今回のお題は、ハフマン符号化です。
出現頻度の高いものには、より短い符号を与えることにより圧縮を実現する符号化のようで、LHAや、JPEG等の圧縮で用いられているそうです。

(huffman-table '(a b c d e f g g g g g e))
;=> ((g "1") (f "011") (c "0101") (d "0100") (a "0011") (b "0010") (e "000"))

;; ---- (def freq (lst) (let h (table) (each item lst (if (h item) (++ (h item)) (= (h item) 1))) (tablist h)))

;(freq '(a b c d e f g g g g g e)) ;=> ((a 1) (d 1) (b 1) (e 2) (c 1) (f 1) (g 5))

(def huffman-tree (lst) ((afn (lst) (if single.lst caar.lst 'else (let ((ai an) (bi bn) . rest) (sort (fn ((_ a) (_ b)) (< a b)) lst) (self `(((,ai ,bi) ,(+ an bn)) ,@rest))))) freq.lst))

;(huffman-tree '(a b c d e f g g g g g e)) ;=> (g ((f (b c)) ((a d) e)))

;;動作状況 ;-> ((a d) 2), (b 1), (c 1), (f 1), (e 2), (g 5) ;-> ((b c) 2), (f 1), ((a d) 2), (e 2), (g 5) ;-> ((f (b c)) 3), ((a d) 2), (e 2), (g 5) ;-> (((a d) e) 4), ((f (b c)) 3), (g 5) ;-> (((f (b c)) ((a d) e)) 7), (g 5) ;-> ((g ((f (b c)) ((a d) e))) 12) ;=> (g ((f (b c)) ((a d) e)))

(def huffman-code-tree (lst) ((afn (tree (o code "")) (if (no alist.tree) `(,tree ,code) no.tree () 'else `(,(self car.tree (+ code "1")) ,(self cadr.tree (+ code "0"))))) (huffman-tree lst)))

;(huffman-code-tree '(a b c d e f g g g g g e)) ;=> ((g "1") (((f "011") ((c "0101") (d "0100"))) (((a "0011") (b "0010")) (e "000"))))

(def huffman-table (lst) (pair:flat:huffman-code-tree lst))

-符号化と復号化を試してみる。
"% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs"
という75文字の文字列の場合、下記のenhuffmanでは、326ビットになります。
元の文字列が1文字あたり6ビット(64種類の文字が可能)だとすると、450ビットなので、元より100ビット位圧縮されている、という解釈で良いんでしょうか?(´▽`*)…。

(withs (lst (coerce "% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs" 'cons)
        tab (huffman-table lst))
  (let code (enhuffman lst tab)
    (prn "\nencode:\n" (string lst) " => " code)
    (prn "\ndecode:\n" code " => " (string (dehuffman code tab)))
    nil))
;==>>
;encode:
;% huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs => 10001000000111010010010001001110110100110101011011000101101100010000101101010000101000101111000010000101000101101010100011000011111100001000010010010001001110110100110000100111001010001111100011001101100000111111100000101001001101000110000111111000001001101111101110010011110011010011101001000110011011000001111111000011000101
;
;decode:
;10001000000111010010010001001110110100110101011011000101101100010000101101010000101000101111000010000101000101101010100011000011111100001000010010010001001110110100110000100111001010001111100011001101100000111111100000101001001101000110000111111000001001101111101110010011110011010011101001000110011011000001111111000011000101 => % huffman(Fs,Hs) :- Hs is the Huffman code table for the frequency table Fs
;nil

; ---- (def exch-key/val (lst) (map (fn ((a b)) (list b a)) lst))

;(exch-key/val (huffman-table '(a b c d e f g g g g g e))) ;=> (("1" g) ("011" f) ("0101" c) ("0100" d) ("0011" a) ("0010" b) ("000" e))

(def enhuffman (lst tab) (let h (listtab tab) (apply + (map [h _] lst))))

;(let lst '(a b c d e f g g g g g e) ; (let tab (huffman-table lst) ; (enhuffman lst tab))) ;=> "001100100101010000001111111000"

(def dehuffman (code tab) (with (h (listtab (exch-key/val tab)) res () cur "") (each c code (zap + cur (string c)) (awhen (h cur) (push it res) (= cur ""))) rev.res))

;(let lst '(a b c d e f g g g g g e) ; (let tab (huffman-table lst) ; (let code "001100100101010000001111111000" ; (dehuffman code tab)))) ;=> (a d b c e f g g g g g e)


ArcでL-99 (P49 グレイ・コード)

Posted 2008-03-29 04:19:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
グレイ・コードとは、一度に1ビットしか変化しないような二進符号のことだそうです。
去年Common Lispで解答を作成したときには、2進数を右シフトしてXORを取るという方法で解答しましたが、メモ化してみるという課題もあるので、今回は再帰で。
メモ化で効率はどう変化するかということですが、Arcには、defmemoというメモ化してくれるマクロがあるので安直にそれを利用。
キャッシュが効くと速くなります。

(gray 4)
;=> ("0000" "0001" "0011" "0010" "0110" "0111" "0101" "0100"
     "1100" "1101" "1111" "1110" "1010" "1011" "1001" "1000")

(def gray (n) (if (is 1 n) '("0" "1") (let g (gray (- n 1)) (+ (map [+ "0" _] g) (map [+ "1" _] rev.g)))))

;; メモ化版 (defmemo graym (n) (if (is 1 n) '("0" "1") (let g (graym (- n 1)) (+ (map [+ "0" _] g) (map [+ "1" _] rev.g)))))

ArcでL-99 (P48 真偽値表 その3)

Posted 2008-03-26 11:31:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
Common Lispで作成したものを移植。
大したことはしていないのに、なんだか長〜くなりました。

(table/c (A B C)
A *and (B *or C) *equ A *and B *or A *and C)
;=> nil, nil, nil => t
; nil, nil, t => t
; nil, t, nil => t
; nil, t, t => t
; t, nil, nil => t
; t, nil, t => t
; t, t, nil => t
; t, t, t => t

(set *operator-precedence-list* '(*and *nand *or *nor *impl *equ *xor))

(mac table/c (args . expr) (let argl (len args) `(each ,args (make-truth-table ,argl) (prall (list ,@args)) (pr " => " ,(to-prefix/c expr *operator-precedence-list*) "\n"))))

(def nth-truth (size num (o true t) (o false nil)) ((afn (cnt acc) (if (is 0 cnt) rev.acc (let cnt (- cnt 1) (self cnt (cons (if (odd:trunc (/ num (expt 2 cnt))) true false) acc))))) size () ))

(def make-truth-table (size (o true t) (o false nil)) ((afn (cnt acc) (if (is cnt (expt 2 size)) rev.acc (self (+ cnt 1) (cons (nth-truth size cnt true false) acc)))) 0 () ))

;; 前回定義のconjunct-not-exprが必要 (def to-prefix/c (expr precedence) ((afn (expr) (if atom.expr expr ;; (and acons.expr (is 'no car.expr)) (if (acons cadr.expr) `(no ,(self cadr.expr)) expr) ;; (atom car.expr) (let (a pred b) expr `(,pred ,a ,self.b)) ;; 'else (let (a pred b) expr `(,pred ,self.a ,self.b)))) (car:set-operator-predence conjunct-not-expr.expr precedence)))

(def conjunct-infix-expr (pred expr) (if atom.expr expr ;; (is pred cadr.expr) (let (a pred b . rest) expr `((,(conjunct-infix-expr pred a) ,pred ,(conjunct-infix-expr pred b)) ,@(conjunct-infix-expr pred rest))) ;; (atom car.expr) (cons car.expr (conjunct-infix-expr pred cdr.expr)) ;; (is 3 (len car.expr)) (cons car.expr (conjunct-infix-expr pred cdr.expr)) ;; 'else (cons (conjunct-infix-expr pred car.expr) (conjunct-infix-expr pred cdr.expr))))

(def set-operator-predence (expr precedence) ((afn (lst res) (if no.lst res (self cdr.lst (conjunct-infix-expr car.lst res)))) precedence expr)) ;


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

Posted 2008-03-25 05:38:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、前回のものを一捻りして、与える式をより普通の数式に近い表現で与えられるようにするというお題です。
適当に、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))))


Arcのマクロ

Posted 2008-03-25 05:11:00 GMT

(mac foo (a b)
  `(prf "#,a #,b"))

で、
(foo x y)
;=> (prf "#x #y")

となることを期待してしまうが、残念ながら今のところ
(prf "#,a #,b")

となる。
便利なので、展開されると良いなと思ったり。

ArcでL-99 (P46 真偽値表)

Posted 2008-03-24 00:25:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前回で、算術篇は終わり、今回から論理と符号篇です。ということで、番号が飛んでP46から。
これまでの問題を細かく分けると、43問あるので2問足りてない感じです。
今回のお題は、2引数のand、or、nand、nor、xor、impl、equを定義を定義し、真偽値表を出力するプログラムで結果を表示させるというものです。
implがなんだか良く分かりませんでしたが、検索してみると、IMPLY B (AならばB)のことのようなので、それらしいものを作ってみましたが、これで良いのか自信がありません。

(table t nil *impl)
;=> ====
;   t : t => t
;   t : nil => nil
;   nil : t => t
;   nil : nil => t
;   nil

(def *nand (a b) (no:and a b)) (def *nor (a b) (no:or a b)) (set *and ~*nand) (set *or ~*nor) (def *equ (a b) (*or (*and a b) (*and no.a no.b))) (set *xor ~*equ) (def *impl (a b) (*or no.a b))

(def perm (lst) ((afn (u res) (if no.u res (self cdr.u `(,@res ,@(map [list car.u _] lst))))) lst () ))

(def table (a b f) (prn "\n====") (each (a b) (perm (list a b)) (prf "#a : #b => ~ \n" (f a b))))

ArcでL-99 (P41b ゴールドバッハ予想をリスト表示)

Posted 2008-03-22 23:17:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前回は範囲をそのまま出力するものでしたが、ちょっとひねって、50より大きいものだけを出力するというものです。
ちょっと改造して終了。

(goldbach-list/b 1 3000 50)
;=> 992 = 73 + 919
;   1382 = 61 + 1321
;   1856 = 67 + 1789
;   1928 = 61 + 1867
;   2078 = 61 + 2017
;   2438 = 61 + 2377
;   2512 = 53 + 2459
;   2530 = 53 + 2477
;   2618 = 61 + 2557
;   2642 = 103 + 2539

(def goldbach-list/b (start end limit) (each p (range start end) (whenlet (x y) (goldbach p) (when (< 50 (min x y)) (prf "#p = #x + #y\n")))))

ArcでL-99 (P40 ゴールドバッハ予想)

Posted 2008-03-20 16:10:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
Wikipediaによれば、一般的には、6以上の偶数は、2つの奇素数の和で表わすことができる、という予想らしいのですが、この問題では、2より大きい偶数は2つの素数の和で表わせる、という説明になっています。
ということで、一応お題の定義の方で作成してみました。

(goldbach 88888888888)
;=> (29 88888888859)

(def goldbach (n) (point RETURN (if (or odd.n (> 4 n)) RETURN.nil ((afn (i) (let j (- n i) (when prime.j (RETURN:list i j))) (self next-prime.i)) 2)))))

ArcでL-99 (P39 指定した範囲の素数のリスト)

Posted 2008-03-19 13:43:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回のお題は、指定した範囲の素数のリストを作成するというものです。
以前定義したprimeとrange(Arc組込み)を組み合わせて解答。
それは良かったのですが、以前のP31 prime解答の間違いに気付いたので修正しました。(1を素数、2は素数でないと判定していた…。)

(prime-list 1 100)
;=> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)

(def prime-list (start end) (rem ~prime (range start end)))

ArcでL-99 (P38 自作したオイラーのφ関数2種を比較)

Posted 2008-03-17 17:33:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回のお題は、P34と、P37で作成したオイラーのφ関数のベンチを取って速度を比較してみようという、お題になっているような、なっていないような微妙なお題です。
ということで、timeで比較してみました。
どうやら、P37の方が速いようです。

;----(P34 totient-phi)-------------------------------------------
;time: 597 msec.
;
;----(P38 phi)---------------------------------------------------
;time: 69 msec.

(let n 10090 (prn) (prn "----(P34 totient-phi)-------------------------------------------") (time (totient-phi n)) (prn) (prn "----(P38 phi)---------------------------------------------------") (time (phi n)) (prn) nil)

ArcでL-99 (P37 オイラーのφ関数 その2)

Posted 2008-03-16 18:34:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回のお題は、P34のオイラーのφ関数の改良版の作成です。
phi(m) = (p1 - 1) * p1 ** (m1 - 1) + (p2 - 1) * p2 ** (m2 - 1) + (p3 - 1) * p3 ** (m3 - 1) + ...
という式を前回作成したprime-factors-multを利用して実装します。
今回、ふとArcの構造化代入ってどうなってるのか試してみたら、7年前のプラン通りにletに構造化代入の機能が付いてました。

(let (x y) '(1 2)
  (list x y))
;=> (1 2)
そうだったのか…、全然試してなかったな…。
arc.arcを眺める限りでは、letの定義でも、withの定義でも分解している様子はないので、fn自体に構造化代入機能がある様子。ということで、
((fn ((x (y z))) (list x y z)) 
 '(1 (2 3)))
;=> (1 2 3)
こういうことも可能だったんですね。知らなかった…。ということで、今回早速試してみました。
mapで使うと便利ですね。
(phi 1192)
;=> 592

(def phi (m) (apply * (map (fn ((p m)) (* (- p 1) (expt p (- m 1)))) (prime-factors-mult m))))

ArcでL-99 (P36 素因数分解 その2)

Posted 2008-03-16 06:25:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は素因数分解した結果を因数ごとに纏めてリストにして表現するというものです。
ヒントとして、P13をちょっと応用せよ、ということが書いてあります。
という訳で、P13と前回の解答を合体しました。

(def prime-factors-mult (n)
  ((afn (lst acc)
     (if no.lst
	 rev.acc
	 (self cdr.lst
	       (cons `(,caar.lst ,(len car.lst)) acc))))
   (pack:prime-factors n) () ))

ArcでL-99 (P35 素因数分解)

Posted 2008-03-14 08:57:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、素因数分解がお題です。
ちょうど去年の今頃、このお題をCommon Lispで解いていたのですが、職場の飲み会で普段は何をして過してるんですか、という質問に、
「いや、ほんと無趣味なんで何もしてないですね。…あ、強いて挙げれば、素因数分解ですかね」
と答えたところ、死ぬ程笑われたことを思い出します。そんなに面白かったかしら…。

私は、数学以前の算数で挫折しているクチなのですが、素朴に書いてみました。
大きめの素数を与えると返事がなくなります。
以前定義したprimeを使用しています。

(prime-factors 600851475143)
;=> (71 839 1471 6857)

(def prime-factors (n) ((afn (n i) (with (q (trunc (/ n i)) r (mod n i)) (if (< n 2) list.n (is 0 r) (if (is 1 q) list.i (cons i (self q i))) 'else (self n (next-prime i))))) n 2))

(def next-prime (n) ((afn (n) (if (prime n) n (self (+ 1 n)))) (+ n 1)))


ArcでL-99 (P34 オイラーのφ関数)

Posted 2008-03-12 11:04:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
私は、オイラーのφ関数には全く馴染みがないのですが、Wikipediaの解説から想像して作成するとこうなりました。
前回定義したcoprimeを使用しています。

(totient-phi 10)
;=> 4

(def totient-phi (n) ((afn (m n) (if (is 0 n) 0 (+ (if (coprime m n) 1 0) (self m (- n 1))))) n (- n 1)))


ArcでL-99 (P32 最大公約数を求める)

Posted 2008-03-10 07:18:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回はユークリッドの互除法で最大公約数を求めよ、というお題です。
どうも今のところArcは算術系のオペレータは充実してない様子。余りを求める関数が探し出せなかったので自作しました。

(gcd 1071 1029 14)
;=> 7

(def gcd nums (reduce (afn (x y) (if (is 0 y) x (let r (remainder x y) (if (is 0 r) y (self y r))))) nums))

(def remainder (x y) ((afn (x y) (if (> 0 x) (+ x y) (self (- x y) y))) (abs x) (abs y)))


ArcでL-99 (P31 素数かどうかを判定する)

Posted 2008-03-09 16:17:00 GMT

L-99はリスト篇が終了し今回から算術篇。28から番号が飛んで31番なのですが、一応問題の数としては、31番目にはなっています。
問題の例としては、is-primeという名前になっていますが、処理系の習慣に沿いたいということで、Arcっぽく、primeとしてみました。
コードの内容としては、Qiのチュートリアルを読んでいたら素数判定のコードがあったので、そのまま移植。

(rem ~prime (range 1 100))
;-> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97)

(def prime (n) (case n 1 'nil 2 't ((afn (x max div) (if (isa (/ x div) 'int) 'nil (> div max) 't 'else (self x max (+ 1 div)))) n (sqrt n) 2)))


ArcでL-99 (P28b 子リストの長さの頻度順で整列)

Posted 2008-03-07 03:35:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
P28も前半と後半に分かれているのを忘れていました!
リスト篇はP28までなのですが、一つの問題が前後半に分かれているものが2つあるので問題の総数としては、30問あるということになります。
今回は、子リストの長さの頻度順で整列させるというもの。以前に定義した、packと、lsortを使用してみました。
何回もソートしてるんですが、もっとすっきり書く方法があるんじゃないかと思います。

(lfsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
;-> ((o) (i j k l) (a b c) (f g h) (d e) (d e) (m n))

(def lfsort (lst) (let freq len-freq.lst (sort (fn (x y) (< (pos len.x freq) (pos len.y freq))) lst)))

(def len-freq (lst) (map car (lsort:pack (map len lsort.lst))))

ArcでL-99 (P28a リストを子リストの長さ順で整列)

Posted 2008-03-06 02:55:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、リストを子リストの要素数で昇順に整列させるというお題です。
Arcには備え付けでsortがあり、それを使った方が効率が良いとは思うのですが、sortを自作させるのが主旨なんだろうなということで再帰のqsortで書いてみました。
なお、Arcのsortは引数の順番がCommon Lispとは逆のようです。

(lsort '((a b c) (d e) (f g h) (d e) (i j k l) (m n) (o)))
;=> ((o) (d e) (d e) (m n) (a b c) (f g h) (i j k l))

(def lsort (lst) (if no.lst () (let piv (len car.lst) (+ (lsort:rem [<= piv len._] cdr.lst) (list car.lst) (lsort:rem [> piv len._] cdr.lst)))))

;; sort使用 (def lsort (lst) (sort (fn (x y) (< (len x) (len y))) lst))


ArcでL-99 (P27b リストを任意の比率で分割した組み合わせ)

Posted 2008-03-04 05:09:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、前回の続きです。
リストを任意の比率で分割したすべての組み合わせをリストで返すというお題なのですが、多分、L-99のリスト篇では一番ややこしいんじゃないかと思います。
(1 2 3 4 5)というリストで、2:3に分ける場合、((1 2) (3 4 5) )と((2 1) (4 3 5) )は同じものとみなされますが、((1 2) (3 4 5) )と((3 4 5) (1 2) )は別物という扱いになります。

解答には、前に定義したcombinationと、setdiffを使用しています。butlastも見当たらないので、自作しました。
かなり混沌としていますが、私の実力では、最早これが正しいのかさえ良く分かりません(笑)
どう書くorgにはこういうのささっと綺麗に解く人が沢山いるんですよね。あやかりたい。あやかりたい。

(group '(aldo beat carla david evi flip gary hugo ida) '(2 3 4))
;=> (((aldo beat) (gary hugo ida) (carla david evi flip)) ...)

(len (group '(aldo beat carla david evi flip gary hugo ida) '(2 3 4))) ;=> 1260

(def group (lst pat) ((afn (lst pat) (if (or no.pat (~<= 0 (apply + pat) len.lst)) () (is len.lst car.pat) list.lst (is 1 len.pat) (sep2 lst car.pat) 'else (sep2-list (self lst cdr.pat) car.pat))) lst rev.pat))

;; リストを2つに分ける (def sep2 (lst num) (map [list _ (setdiff lst _)] (combination num lst)))

;; 複数のリストを2つに分けて、それを継げたリストを返す (def sep2-list (lsts num) (let res () (each l lsts (= res (+ (map [if cadr._ `(,@butlast.l ,@_) `(,@butlast.l ,car._)] (sep2 last.l num)) res))) res))

(def butlast (lst) (cut lst 0 (- len.lst 1)))

ArcでL-99 (P27a 9人を2:3:4に分ける組み合わせ)

Posted 2008-03-03 04:40:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
P27はaとbの二段構えなのですが、今回は、9人を2:3:4に分けるすべての組み合わせをリストで返すというお題です。
組み合わせ系は総数が爆発的に増えたりすることが多く、非常に苦手です…。
ということで、解答も結構やっつけになってしまっています…。

解答には、前回定義したcombinationを使用しています。
CLでいうset-difference、SRFI-1でいうlset-differenceがArcで見付けられなかったので、MacLISPのsetdiffを参考に作成しました。
また、pointは、Schemeのlet/ccに相当するようです。

(group3 '(aldo beat carla david evi flip gary hugo ida))
;=> (((aldo beat) (carla david evi) (flip gary hugo ida))
;    ((aldo beat) (carla david flip) (evi gary hugo ida))
;    ((aldo beat) (carla david gary) (evi flip hugo ida)) ...)

(len (group3 '(aldo beat carla david evi flip gary hugo ida))) ;=> 1260

(def group3 (lst) (let res () (each u (combination 2 lst) (let diff (setdiff lst u) (each v (combination 3 diff) (= res `(,@res (,u ,v ,(setdiff diff v))))))) res))

(def setdiff (x y) (point exit (each yy y (when (mem yy x) (exit (y-x+z x y () )))) x))

(def y-x+z (y x z) (let y-x () (each xx y (or (mem xx x) (push xx y-x))) (= y-x (join (rev y-x) z))))

ArcでL-99 (P26 リストから指定した個数を抜き出す組み合わせ)

Posted 2008-03-02 07:38:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、リストから指定した個数を抜き出す組み合わせの作成がお題です。
個人的に組み合わせ問題は苦手で考えているとめまいがしてきます…。

(combination 3 '(a b c d e f))
;=> ((a b c) (a b d) (a b e) ...)

(len (combination 3 (range 1 12))) ;=> 220

(def combination (n lst) (let llen (len lst) (if (or (is n 0) (> n llen)) () (is n llen) `(,lst) (is n 1) (map list lst) 'else `(,@(map (fn (l) `(,car.lst ,@l)) (combination (- n 1) cdr.lst)) ,@(combination n cdr.lst)))))

ArcでL-99 (P25 ランダムに並び換え)

Posted 2008-02-29 22:41:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、リストの内容をランダムに並び換えるというお題です。
ヒントとしては、P23で定義したrnd-selectを使う、とのこと。
前回rnd-selectの出力をちょっと変更して、

(rnd-select '(a b c d e f) 1)
;=> ((e) (f c b d a))
のようにしましたが、中身を一つのリストにしてしまえば今回の目的に適うので、joinでくっつけて終了。
(rnd-permu '(a b c d e f))
;=> '(e f c b d a)

(def rnd-permu (lst) (apply join (rnd-select lst 1)))

ArcでL-99 (P24 ロトくじ)

Posted 2008-02-29 01:37:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、ロトくじの様に数列からランダムに任意の個数の数字を抜き出したリストを返すというお題です。
ヒントとして以前に作成したrnd-selectとrangeを使用する、とあります。
前回のお題でも若干疑問に感じていたのですが、並びもランダムにしようと思うと、remove-atのように要素を元のリストから要素を落す方法では、並びは元のリストを継承してしまいます。
その辺をどうするのかと。
問題をみると並びまでばらばらなので、rnd-selectを変更して、残った要素と、落とす要素の二つのリストをリストにして返すことにしました。Arcには多値がないようなのでリストで。

(lotto-select 6 49)
;=> (20 44 31 36 1 9)

(def rnd-select (lst num) (and (< 0 num) ((afn (lst acc cnt) (if (or no.lst (is len.lst num)) (list lst acc) (let pos (+ 1 (rand len.lst)) (self (remove-at lst pos) (cons (lst (- pos 1)) acc) (+ 1 cnt))))) lst () num)))

(def lotto-select (n rng) (cadr:rnd-select (range 1 rng) (- rng n)))

ArcでL-99 (P23 ランダムに指定した個数の要素を選択)

Posted 2008-02-28 03:10:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、ランダムに指定した個数の要素を選択するというお題です。
ヒントとして以前に作成したremove-atとシステムに用意された乱数生成関数を利用して良いとのこと。
Arcには、乱数生成用のrand、引数の中からランダムに一つ返すrand-choice、シーケンスからランダムに一つ返す、random-elt等、妙に充実しています。

(rnd-select '(a b c d e f g h) 3)
;=> (a c d)

(def rnd-select (lst num) (and (< 0 num) ((afn (lst cnt) (if (or no.lst (is len.lst num)) lst (self (remove-at lst (+ 1 (rand len.lst))) (+ 1 cnt)))) lst num)))

ArcでL-99 (P22 指定した範囲の数列のリストを作成する)

Posted 2008-02-27 07:28:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、指定した範囲の数列のリストを作成するのがお題です。
SRFI-1でいうところのiotaですね。
Arcにはこれと同じ機能のrangeがあります。

Arcもバージョン2となり、そして、ちょっと前ですが、Emacsのarc-mode.elを作った方が現われました。待ってました!
-(http://arclanguage.org/item?id=3361)
やっぱり専用のモードがあるというのは良いです。

;=> (rangE 4 9)
(4 5 6 7 8 9)

;=> (range 4 9) (4 5 6 7 8 9)

(def rangE (start end) (and (<= start end) ((afn (cnt acc) (if (> cnt end) rev.acc (self (+ 1 cnt) (cons cnt acc)))) start () )))


ArcでL-99 (P21 指定した位置に要素を挿入する)

Posted 2008-02-26 14:49:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、指定した位置に要素を挿入する関数の作成がお題です。
前回のものをちょっと細工して終了。

(insert-at 'alfa '(a b c d) 2)
;=> (a alfa b c d)

(def insert-at (item lst pos) (unless (<= 1 pos (len lst)) (err "The index is bad for a sequence of length.")) ((afn (lst acc cnt) (if (or no.lst (is pos cnt)) (join rev.acc (list item) lst) (self cdr.lst (cons car.lst acc) (+ 1 cnt)))) lst () 1))

ArcでL-99 (P20 指定した要素を削除)

Posted 2008-02-24 18:36:00 GMT

今回は、指定した要素を削除するというお題です。
割とこのL-99(というよりP-99)というのは、以前に解いた問題を応用して新しい問題を解かせるということにおいても秀逸で、なるほど!と感心することが結構あります。

(remove-at '(a b c d) 2)
;=> (a c d)

(def remove-at (lst pos) ((afn (lst acc cnt) (if (or no.lst (> cnt pos)) (join rev.acc lst) (self cdr.lst (if (is cnt pos) acc (cons car.lst acc)) (+ 1 cnt)))) lst () 1))

たまにするならこんな拡張

Posted 2008-02-23 16:03:00 GMT

Arcのafn(On Lispでのalambda)は、使い捨て感覚の関数に付ける名前を考えなくても良いので、個人的に気に入って使っているのですが、引数の取り方がlambdaと一緒のため本体部分が長くなると読み辛くなるかなあと思います。
そこで、形式をlambdaからletにしたものはどうかなと思い、そんなのを作ってみることにしました。要するに名前付きletのアナフォリック版ということですね。
それで名前をどうするか考えたんですが、Arcでletは1引数なので、そうなるとwithになるかと思い、awithにしてみました。
全体的には割とすっきり書けて良い感じにも思えるのですが、引数部分がなんとなくごちゃごちゃしてる気もします。
また、ドットで連結するのに馴れると(+ 1 foo)のようなものも1+.cntのように書きたくなってくるので、 古式ゆかしいadd1という名前の復活も試してみることにしました。

(mac awith (binds . body)
  (let b (pair binds)
    `((afn ,(map car b)
	,@body)
      ,@(map cadr b))))

(set add1 [+ _ 1]) (set sub1 [- _ 1])

;; 使用例 (def rotate (lst pos) (let pos (mod pos len.lst) (awith (lst lst acc () cnt 0) (if (or no.lst (is pos cnt)) (join lst rev.acc) (self cdr.lst (cons car.lst acc) add1.cnt)))))

ArcでL-99 (P19 指定した位置でローテーションさせる)

Posted 2008-02-23 14:56:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、リストの指定した位置でローテーションさせるというお題です。
ヒントとしては、P17を参照せよとのこと。
また、インデックスはマイナスの数値も扱えるようにするみたいです。

(rotate '(a b c d e f g h) 3)
;=> (d e f g h a b c)

(rotate '(a b c d e f g h) -2) ;=> (g h a b c d e f)

(def rotate (lst pos) (let pos (mod pos len.lst) ((afn (lst acc cnt) (if (or no.lst (is pos cnt)) (join lst rev.acc) (self cdr.lst (cons car.lst acc) (+ 1 cnt)))) lst () 0)))


ArcでL-99 (P18 指定した範囲を切り出す)

Posted 2008-02-22 15:26:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、リストの指定した範囲を切り出すというお題です。
CLでいうところのsubseqの作成ですね。
Arcもこの前までは、subseqだったんですが、cutって名前に変更になっちゃったみたいです。
マイナスのインデックスは、配列の後から数えた位置になります。また、配列のサイズより大きい数値でもエラーにはなりません。

(def slice (lst start end)
  (unless (<= 0 start end (len lst))
    (err "The bounding indices are bad for a sequence of length."))
  ((afn (lst acc cnt)
	(if (or no.lst (< end cnt))
	    rev.acc
	    (self cdr.lst
		  (if (<= start cnt end)
		      (cons car.lst acc)
		      acc)
		  (+ 1 cnt))))
   lst () 1))

(slice '(a b c d e f g h i k) 3 7) ;=> (c d e f g)

(cut '(a b c d e f g h i k) 3 7) ;=> (d e f g) ; 0オリジン

(cut '(a b c d e f g h i k) 3 -3) ;=> (d e f g)

ArcでL-99 (P17 指定した位置でリストを二分する)

Posted 2008-02-21 06:57:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、指定した位置でリストを二分するというお題です。
但し、予め定義された述語を使わないこと、とのこと。

(split '(a b c d e f g h i k) 3)
;=> ((a b c) (e f g h i k))

(def split (lst n) (if (<= n 0) lst ((afn (lst acc cnt) (if (is 0 cnt) (cons rev.acc (list cdr.lst)) (self cdr.lst (cons car.lst acc) (- cnt 1)))) lst () n)))

ArcでL-99 (P16 周期Nで該当した要素を除外)

Posted 2008-02-20 05:18:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、指定した周期で要素を除外するというお題です。

(drop '(a b c d e f g h i k) 3)
;=> (a b d e g h k)

(def drop (lst n) ((afn (lst acc (o cnt 1)) (if no.lst rev.acc (if (is cnt n) (self cdr.lst acc) (self cdr.lst (cons car.lst acc) (+ 1 cnt))))) lst () ))

;; 繰り返しで (def drop (lst n) (let acc () (forlen i lst (unless (is 0 (mod (+ i 1) n)) (push lst.i acc))) rev.acc))

ArcでL-99 (P15 各要素を任意の回数複製)

Posted 2008-02-19 06:02:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前回は2つずつにするというお題でしたが、今回は、ちょっと発展して任意の回数繰り返したリストを返せというお題です。

(repli '(a b c) 6)
;=> (a a a a a a a b b b b b b b c c c c c c c)

(def repli (lst times) ((afn (lst acc cnt) (if no.lst rev.acc (if (is 0 cnt) (self cdr.lst (cons car.lst acc) times) (self lst (cons car.lst acc) (- cnt 1))))) lst () times))

;; 繰り返しで (def repli (lst times) (mappend [newlist times _] lst))

(def newlist (n (o elt nil)) (let acc () (repeat n (push elt acc)) acc))

ArcでL-99 (P14 各要素を2つずつに複製)

Posted 2008-02-18 05:40:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
リストの各要素を2回繰り返したリストを返せというお題です。
要素を2倍したリストをjoin(append)するのではなくて、ちょっと捻ってconsを2回することにしてみました。

(def dupli (lst)
  ((afn (lst acc)
     (if no.lst
	 rev.acc
	 (self cdr.lst
	       (let f [cons car.lst _]
		 f:f.acc))))
   lst () ))

(dupli '(a b c c d)) ;=> (a a b b c c c c d d)

;; 短かく (def dupli (lst) (and lst `(,lst.0 ,lst.0 ,@(dupli cdr.lst))))

ArcでL-99 (P13 ランレングス圧縮 その2)

Posted 2008-02-17 09:08:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
P09では、ランレングス圧縮の方法として同じものを最初にリストにして、その子リストの長さと、要素でリストを構成していましたが、そうではなしに先頭から直接リストを作成して行けというお題。
連続する要素ならば、カウンタを一つ進め、そうでないなら、要素を追加、というような方法になるでしょうか。

(def encode-direct (lst)
  ((afn (lst acc)
     (if no.lst
	 rev.acc
	 (self cdr.lst
	       (let a car.acc
		 (if atom.a
		     (if (is car.lst a)
			 (cons `(2 ,a) cdr.acc)
			 (cons car.lst acc))
		     (if (is car.lst cadr.a)
			 (cons `(,(+ 1 car.a) ,car.lst) cdr.acc)
			 (cons car.lst acc)))))))
   lst () ))

(encode-direct '(a a a a b c c a a d e e e e)) ;=> ((4 a) b (2 c) (2 a) d (4 e))

ArcでL-99 (P12 ランレングス圧縮されたものを復元する)

Posted 2008-02-16 08:23:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前回のP11は、圧縮するものでしたが、そのデータを復元するのがお題。
Arcでmake-listに相当するものが見当たらなかったので自作しました。一応、newstringからの類推で、newlistという名前に。
make-listは全然違う名前になって潜んでたりして…。

(def decode (lst)
  ((afn (lst acc)
	(if no.lst
	    rev.acc
	    (self cdr.lst
		  (cons (if (atom car.lst)
			    car.lst
			    (apply newlist car.lst))
			acc))))
   lst () ))

(def newlist (size (o elt nil)) ((afn (cnt acc) (if (<= cnt 0) acc (self (- cnt 1) (cons elt acc)))) size () ))

(decode '((4 a) b (2 c) (2 a) d (4 e))) ;=> ((a a a a) b (c c) (a a) d (e e e e))

ArcでL-99 (P11 連続する要素をランレングス圧縮する その2)

Posted 2008-02-15 04:02:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前回は、

((4 a) (1 b) (2 c) (2 a) (1 d) (4 e))
という風に出力していましたが、今回は、
((4 a) b (2 c) (2 a) d (4 e))
のように出力せよ、との問題。1つの場合は、リストにしないで、アトム単体で表現するというわけですね。
ということで前回のを少し修正して終わり。
(def encode-modified (lst)
  ((afn (lst acc)
	(if no.lst
	    rev.acc
	    (self cdr.lst
		  (let n (len car.lst)
		    (cons (if (is 1 n) caar.lst `(,n ,caar.lst)) 
			  acc)))))
   pack.lst () ))

(encode-modified '(a a a a b c c a a d e e e e)) ;=> ((4 a) b (2 c) (2 a) d (4 e))

Arcでcond

Posted 2008-02-14 08:42:00 GMT

どうもArcのifには我慢できなくなったのでマクロでcondを作ってみることにしました。
ちょちょっと作業をしてみたのですが、SLIMEに馴れ切った自分にはSLIMEの助けが無いとマクロが書けないことに、はたと気付いてしまいました。
つまりマクロの展開形が簡単に確認できないと無計画にマクロを書けなということですね…。
そういうわけで遠回りながら、まず簡単にmacex1の結果が見れるようにしてみました。
といっても、Emacsのlisp-eval-region関数をちょっといじっただけのものを作っただけです。
EmacsのArc-modeが待ち遠しい…。

(defun arc-mecex1-region (start end &optional and-go)
  (interactive "r\nP")
  (comint-send-string (inferior-lisp-proc) "(ppr (macex1 '")
  (comint-send-region (inferior-lisp-proc) start end)
  (comint-send-string (inferior-lisp-proc) "))\n")
  (if and-go (switch-to-lisp t)))
これで気休め程度はマクロが書きやすくなったので、condの作成
;; そのまんまバージョン
(mac cond body
  `(if ,@(mappend [list car._ `(do ,@cdr._)] body)))

;; elseも使えるバージョン (mac cond body `(if ,@(mappend [list (let x _.0 (or is!else.x x)) `(do ,@cdr._)] body)))

;; 動作 (cond (a b) (c d) (else e)) ;マクロ展開 => ;(if a (do b) c (do d) t (do e))

新しい構文も取り入れて書いてみましたが、ArcはどんどんPerl化して行っている気がする!

ArcでL-99 (P10 連続する要素をランレングス圧縮する)

Posted 2008-02-14 06:24:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
前回に引き続き連続する要素を纏める系の問題ですが、前回のpackを使えば簡単です。

そして昨日、新しいArcが公開されました。
新しい構文が追加されたり、関数名が変更されたり。
といっても、(http://www.paulgraham.com/arcll1.html)にも書いてあるアイディアなので、今回採用になった、というほうが良いでしょうか。
この時は、x.yとx:yですが、これが、x.yと、x!yってことになったみたいです。

list.1.2.3
;=> (1 2 3)
list!x!y!z
;=> (x y z)
なんとなく微妙。
しかし、この構文を使って書くとコードの見た目が、かなり変わって来ます。
今回は、折角なので、新しい書法で書いてみました。
括弧がどんどん無くなる…。
(def encode (lst)
  ((afn (lst acc)
	(if no.lst
	    rev.acc
	    (self cdr.lst
		  (cons `(,(len car.lst) ,caar.lst) acc))))
   pack.lst () ))

(encode '(a a a a b c c a a d e e e e)) ;=> ((4 a) (1 b) (2 c) (2 a) (1 d) (4 e))

ArcでL-99 (P09 連続して現われる要素を纏める)

Posted 2008-02-13 02:38:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
この辺から私の頭では結構考えないと解けなくなってまいります。
折角Arcなのでネストしたifを若干無理な感じで使ってみました。PG氏のソースを読むと、ネストしたifの場合は、述部以外は一文字字下げしてるみたいです。
'elseはどこかで、こういう風に書くと分かりやすいよ、ってのを見たので真似してみたんですが、なんか落着かない…。結局どんどんcondに近付いて行くような…。

(def pack (lst)
  (rev ((afn (lst acc tem) 
	     (if (no lst)
		  (cons tem acc)
		 (or (is (car lst) (car tem)) (no tem))
		  (self (cdr lst)
			acc
			(cons (car lst) tem))
		 'else
		  (self (cdr lst)
			(cons tem acc)
			(list:car lst))))
	lst () () )))

(pack '(a a a a b c c a a d e e e e)) ;=> ((a a a a) (b) (c c) (a a) (d) (e e e e))

ArcでL-99 (P08 連続して現われるリストの要素を圧縮する)

Posted 2008-02-12 02:36:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
'(a a a a b c c a a d e e e e)というリストを、'(A B C A D E)という風に圧縮せよ、という問題です。
思いついたまま書いてみました。(nilを正しく扱っていなかったので、3/19修正)

(def compress (lst) ((afn (lst acc) (if no.lst rev.acc (self cdr.lst (if (and (is car.acc car.lst) acc) acc (cons car.lst acc))))) lst () ))

(compress '("a" "a" "a" "a" a b b b c c c e a a d e)) ;-> ("a" a b c e a d e)

ArcでL-99 (P07 リストの中身を平板化する)

Posted 2008-02-10 22:18:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
平板化って言葉がなんだか良く分からないのですが、変換できたので使ってみます。
おなじみのflattenの作成ということのようです。
nilを要素とするか、空リストと見るかで動作が変ってしまうと思うんですが、どっちがメジャーな解釈なんでしょう。
とりあえず、nilは、要素とすることにしてみました。
Arcには、flatがあって、こっちは、nilはリストってことになるようです。
また、appendは、Arcでは+か、joinになります。

(def flatten (lst)
  (rev ((afn (lst acc)
	     (if (no lst)
		  acc
		  (self (cdr lst) 
			(if (atom (car lst))
			    (cons (car lst) acc)
			    (+ (self (car lst) () ) acc)))))
	lst () )))

(flatten '(1 2 (3 (4 5 (()(()(((((((6((((((7 8 9)))))))10)))))))))()) 11 (12))) ;-> (1 2 3 4 5 nil nil 6 7 8 9 10 nil 11 12)

(flat '(1 2 (3 (4 5 (()(()(((((((6((((((7 8 9)))))))10)))))))))()) 11 (12))) ;-> (1 2 3 4 5 6 7 8 9 10 11 12)

ArcでL-99 (P06 リストの中身が回文的かを調べる)

Posted 2008-02-09 22:07:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、リストの内容が回文になっているかどうかを調べるというもの、ひっくりかえして比較すれば良いのですが、一応練習ということで丁寧に書いてみました。
同じ要素で構成されたリストかを比較するので、isoを使っています。

(def palindrome (lst)
  ((afn (l acc)
	(if (no l)
	    (iso lst acc)
	    (self (cdr l) (cons (car l) acc))))
   lst () ))

;; 簡単に (def palindrome (lst) (iso (rev lst) lst))

(palindrome '(x a m a x)) ;-> t

(palindrome '(た け や ぶ や け た)) ;-> t

ArcでL-99 (P05 リストの中身を逆転させる)

Posted 2008-02-08 12:45:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
今回は、「リストの中身を逆転させる」ということで、CLでいうとreverseの作成ですね。
Arcには標準で、revがあります。

(def reverse (lst)
  ((afn (org acc)
	(if (no org)
	    acc
	    (self (cdr org) (cons (car org) acc))))
   lst () ))

(reverse '(foo bar baz)) ;=> (baz bar foo)

(rev '(foo bar baz)) ;=> (baz bar foo)

ArcでL-99 (P04 リストの要素の個数を数える)

Posted 2008-02-06 19:33:00 GMT

今回は、「リストの要素の個数を数える」のがお題ということで、要するに、lengthの作成ですね。
Arcでは、lengthはlenとなっていて、リスト/文字列/テーブルが引数に取れるようです。

;; 動作
(list-len '(foo bar baz))
;=> 3

;; 定義 (def list-len (lst) ((afn (lst cnt) (if (no lst) cnt (self (cdr lst) (+ cnt 1)))) lst 0))

;(len '(foo bar baz)) ;=> 3

ArcでL-99 (P03 リストのK番目の要素を取り出す)

Posted 2008-02-03 14:33:00 GMT

-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
P03はリストのK番目の要素を取り出すものを作成せよとのこと。
CLでは、nthや、elt、Arcだと、(lst idx)という風に直接指定できますが、勉強ということで再帰的定義で。

;; L-99 (3)
;; 定義
; 1オリジンで勘定せよとのこと
(def elt-at (lst idx)
  (if (is idx 1)
      (car lst)
      (elt-at (cdr lst) (- idx 1))))

;; 動作 (elt-at '(a b c d e) 3) ;=> c

;; 別解 (def elt-at (lst idx) (lst (- idx 1)))


ArcでL-99 (P02 最後の要素をリストにして返す)

Posted 2008-02-02 09:45:00 GMT

P01をリストでくるんで終了
-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)

;; L-99 (2)
;; last-cons
(def last-cons (lst)
  (if (atom:cdr lst)
      (list ((if (dotted lst) cdr car) lst))
      (last-cons:cdr lst)))

;; 動作 (lasT '(foo bar baz)) ;-> (baz) (lasT '(foo . bar)) ;-> (bar)


ArcでL-99 (P01 my-last):修正

Posted 2008-02-02 09:43:00 GMT

問題を思いっきり読み違えてました…。
最後の要素を返すとのことでした。
…ということで修正!
-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)

;; L-99 (1)
;; my-last
(def lasT (lst)
  (if (atom:cdr lst)
      ((if (dotted lst) cdr car) lst)
      (lasT:cdr lst)))

;; 動作 (lasT '(foo bar baz)) ;-> baz (lasT '(foo . bar)) ;-> bar


ArcでL-99 (P01 my-last)

Posted 2008-02-01 10:21:00 GMT

今後、ArcでSICPに挑戦してみたり、PAIPに挑戦してみたりと色々ブログ上などで挑戦記事が増えると予想しているんですが、自分は、ArcでL-99に挑戦してみることにしました!
-(http://www.ic.unicamp.br/~meidanis/courses/mc336/2006s2/funcional/L-99_Ninety-Nine_Lisp_Problems.html)
といっても、Common Lispでも84問中64問までしか解答できていないので、まあ、途中で挫折すると思うんですが(笑)
まったり進行で、1エントリ一問って感じで挑戦して行きます。完成は、10年後位を目途に。
それとは別に、グループで掲示板が使われないのがもったいない気がするので、Arcで、SRFI-1を作ってみるというスレを立ててみました。
はてなユーザの方ならどなたでも書き込めるので、暇潰しにコードでも書いて行って下さいませ!
-(http://cadr.g.hatena.ne.jp/bbs/7?from=1)

;; L-99 (1)
;; my-last
(def lasT (lst)
  (if (atom:cdr lst)
      lst
      (lasT:cdr lst)))

;; 伝統的なlispのlastと同じ動作 (lasT '(foo bar baz)) ;-> (baz) (lasT '(foo . bar)) ;-> (foo . bar)

;; Arcのlast (SRFIっぽい動作) (last '(foo bar baz)) ;-> baz (last '(foo . bar)) ;-> Error: "Can't take cdr of bar"


Arc公開!

Posted 2008-01-30 10:22:00 GMT

Arcが、本当にこの冬に公開されました!
結構話題にもなってるようですね。
マイコミにも取り上げれるとは思いませんでした。(いつもマニアックな記事を書いてる方ではあるんですが)
-(http://journal.mycom.co.jp/news/2008/01/30/022/index.html)
しかし、画面写真は、なんでわざわざArcからSchemeに抜けてHello, World!を実行しているんだろう(笑)
とりあえず、早速インストールしてみます!

インストール

-(http://arclanguage.org/install)
からソースをダウンロード
とりあえず、MzSchemeをUbuntuでパッケージからインストールしたところバージョンは、360でした。
推奨は、バージョン352とのことなのですが、面倒なのでとりあえず360で起動。
-Brief tutorial on Arc.
ざっとチュートリアルを眺めてみましたが、7年前の発表から比べると、なんとなく、とんがっていたところが丸くなってCommon Lisp風味が増した気がします。
On Lispでお馴染のものが沢山定義されているので、Common LispとOn Lispに馴染んだ人は親近感を覚えるんじゃないかと思います。
条件式がデフォルトでアナフォリックでなくなったり、若干寂しいですが、マクロの中で使うことなどを考えると厄介な気もするのでこれで良いのでしょう。
とはいえ、どの辺までが、コアの部分で、どこからがライブラリなのか良く分からないので、上記の評価も間違っているような(笑)
(aif "World!"
     (prn (+ "Hello, " it))
     (prn it))
;=> Hello, World!
とはいえ、aif等は予め用意されています。
-色々試してみる
('(foo bar baz) 0)
;=> foo

("012345" 4) ;=> #\4

(let h (fn (n) (repeat n (prn "Hello"))) (h 5)) ;=> ;Hello ;Hello ;Hello ;Hello ;Hello ;nil

(with (inc (annotate 'mac (fn (n) `(= ,n (+ ,n 1)))) num 5) (inc num)) ;=> error ;うーん、駄目。

(do (= foo (annotate 'mac (fn (n) `(= ,n (+ ,n 1))))) (let n 3 (foo n) (foo n))) ;=> 5 ;これは動いたけど、ローカルのマクロじゃないなあ。

うーん、自分の一番の関心はファースト・クラスのマクロ採用案ってのはどうなったのかということなのですが、変数にマクロを格納するのってどうやるんですかね。
それはさておき、とりあえず、記念にどう書くorgにHello,World!を投稿!
((pr "Hello, World!\n")で投稿しましたが、改行付きは、prnで書けた模様…。)

俺Arc祭り 2008冬 (8)

Posted 2008-01-21 23:10:00 GMT

やっと最後まで辿り着きました、俺Arc祭りこと、生後3週間目のArc追っかけ。
最後に来て、ラムダパラメータリストについてです。
keyの代わりに、db(ハッシュ)を使用することにし、また、分割代入をサポートするとのこと。
キーワードを一々指定するのは面倒だから、ハッシュテーブルを引数として食べさせるってことでしょうか。
便利なような便利でないような…。

ノープランで頭から作っていただけに、let、with、def、macro(mac)は定義し直し。
また、変数の分割代入ですが、混み入ってくると正しい文法なのかどうか怪しいです。

;; 動作
(def foo (x (ds (i j)) (get m n) (opt q 'a) . z)
  (list x i j m n q z))

(foo 1 '(red green) (db m 'a n 'b) 'hel 'lo) ;-> (1 RED GREEN A B HEL (LO))

(let x 5 x) ;-> 5

(with (x 5 y 6) (list x y)) ;-> (5 6)

(let (ds (x y (z))) '(1 2 (3)) (list x y z)) ;-> 1 2 3

(with ((ds (x y z)) '(1 2 3) a 5) (list x y z a)) ;-> 1 2 3 5

;; これはアリなのだろうか? (let (a . b) '(1 2 3 4) (list a b)) ;->(1 (2 3 4))

;; これで良いのか? (let (ds ((a b) . rest)) '((1 2) 3 4) (list a b rest)) ;->(1 2 (3 4))

(with ((ds ((a b) . rest)) '((1 2) 3 4) x 10) (list a b rest x)) ;->(1 2 (3 4) 10)

;; おれおれ定義 (cl:defmacro let (var val cl:&body body) `(cl:destructuring-bind ,(remove-ds (opt-to-&optional (dotex-to-&rest `(,var)))) (list ,val) (declare (ignorable ,@(metatilities:flatten (remove-ds `(,var))))) ,@body))

(cl:defmacro with (spec &body body) (reduce (fn (x res) `(let ,@x ,res)) (loop :for i :on spec :by #'cddr :collect (metatilities:firstn 2 i)) :initial-value `(progn ,@body) :from-end 'T))

(cl:defmacro def (name args cl:&body body) (multiple-value-bind (spec /ds /syms) (replace-specs (opt-to-&optional (dotex-to-&rest args))) (if /ds `(cl:defun ,name ,spec (destructuring-bind ,/ds ,/syms ,@body)) `(cl:defun ,name ,spec ,@body))))

;; 他のエッセイを読んだら、macroじゃなくて、macになってたのでついでに変更してみる (cl:defmacro mac (name args cl:&body body) (multiple-value-bind (spec /ds /syms) (replace-specs (opt-to-&optional (dotex-to-&rest args))) (if /ds `(cl:defmacro ,name ,spec (destructuring-bind ,/ds ,/syms ,@body)) `(cl:defmacro ,name ,spec ,@body))))

;; ラムダパラメータ分解ユーティリティ (cl:defun opt-to-&optional (expr) (loop :for x :in expr :nconc (if (eq 'opt (metatilities:car-safe x)) `(&optional ,(if (cl:= 2 (length x)) (cadr x) (cdr x))) (list x))))

(cl:defun dotex-to-&rest (expr) (cl:cond ((atom expr) `(&rest ,expr)) ((tailp () expr) expr) ('T (cl:let ((x (copy-list expr))) (rplacd (last x) (list '&rest (cdr (last x)))) x))))

(cl:defun replace-specs (expr) (loop :with ds :and vars :for x :in expr :collect (cl:cond ((eq 'ds (metatilities:car-safe x)) (cl:let ((sym (gensym "DS-"))) (push sym vars) (push (cadr x) ds) sym)) ((eq 'get (metatilities:car-safe x)) (cl:let ((sym (gensym "DB-"))) (push (cdr x) ds) (push `(list ,@(mapcar (cl:lambda (x) `(get ,x ,sym)) (cdr x))) vars) sym)) ('T x)) :into specs :finally (return (values specs ds `(list ,@vars)))))

(defun remove-ds (expr) (loop :for x :in expr :collect (if (eq 'ds (metatilities:car-safe x)) (cadr x) x)))

俺Arc祭り 2008冬 (7)

Posted 2008-01-21 17:46:00 GMT

もう少しで終了の俺Arc祭り。知らぬ間に世の中では、俺Scheme/Lisp祭りが始まっている様子。
今年、Schemeは盛り上がりそうだなー。
Common Lispも、意味なく盛り上がんないかな。
Common Lisp面白いと思うんだけどなあ。
それはさておき、

16. Overloading

クラスを作るときに関数を指定して実行時に指定した関数をオーバーロードするとのことですが、ギブアップです(;´Д`)
 (= pt (class nil 'x 0 'y 0 pr my-pr))
とかすると、ptの呼び出しでは、prじゃなくて、my-prが呼び出される、ということでしょうか。
どうすれば良いのか検討もつかないなあ。

17. DBs are hashes/alists

dbというものが定義されて、これは、連想リストや、ハッシュ的なものだそうです。
-newdb、db、get
newdbで新規のdbを作成、dbは簡略版で、問い合わせのテストにeqを過程するものだそうです。
getで、キーを指定して値を取り出します。
また、問い合わせに失敗した場合は、大域変数*fail*を返すとのこと。
;;
;; 動作
;(newdb eq 'x 'a 'y 'b)

(= foo (db x 'a y 'b))

(get x foo) ;-> a

(each x (db x 1 y 2) (pr x) (keep key)) ;12 ;(X Y)

;; おれおれ定義 (cl:defmacro newdb (test &rest keys-&-vals) `(loop :with ht = (make-hash-table :test #',test) :for kv :on ',keys-&-vals :by #'cddr :do (setf (cl:gethash (car kv) ht) (%unquote (cadr kv))) :finally (return ht)))

(cl:defmacro db (&rest keys-&-vals) `(newdb eq ,@keys-&-vals))

(shadow 'get)

(defparameter *fail* nil)

(cl:defmacro get (key db) `(multiple-value-bind (val test) (cl:gethash ',key ,db) (cl:if test val '*fail*)))

;; dbを扱えるようにeachを拡張。禁斷のeval発動…。 (macro each body (if (hash-table-p (eval (cadr body))) `(with-keep-or-sum (each/hash ,@body)) `(with-keep-or-sum (each1 ,@body))))

(cl:defun %keys+values (ht) (loop :for k :being :the :hash-keys :in ht :using (:hash-value v) :collect k :into ks :collect v :into vs :finally (return (values (coerce ks 'vector) (coerce vs 'vector)))))

(cl:defmacro each/hash (var ht cl:&body body) (with (/v (gensym) /k (gensym) /cnt (gensym)) `(multiple-value-bind (,/k ,/v) (%keys+values ,ht) (cl:let (,var key) (declare (ignorable key ,var)) (to1 ,/cnt (length ,/k) (setq ,var (aref ,/v ,/cnt) key (aref ,/k ,/cnt)) ,@body)))))

;; with-keep-or-sumの定義が変だったので変更 (cl:defmacro with-keep-or-sum (&body body) (with (s (x-finder 'sum body) k (x-finder 'keep body)) (cl:cond ((and s k) (error "SUMとKEEPはどちらかでお願いしたい。")) (s `(with-sum ,@body)) (k `(with-keep ,@body)) ('T `(progn ,@body)))))

俺Arc祭り 2008冬 (6)

Posted 2008-01-20 11:35:00 GMT

惰性で続けております、俺Arc祭り。気力が無くなってまいりました。

15. Classes and Objects

クラスとオブジェクトです。単一継承にする予定とのこと。
あんまり詳しく説明はされてません。
基本的に名前の付け替えで逃げました。(++ (p1 'x))というのは逃げきれませんでした。
意味的には(incf (slot-value p1 'x))ということだと思うんですが…。
切ったり貼ったりの無理矢理風味に出来上がりました。
;;
;; 動作
(= pt (class nil 'x 0 'y 0)) ;ptというクラスを作る?

(type pt (x 0) (y 0)) ; 上記の簡便な方法?

(= p1 (new pt)) ;インスタンスをnewで作ってp1に代入

(p1 'y) ; p1は自動的にメソッドの名前にもなり、スロットを読み出せる。 ;=> 0

(++ (p1 'x)) ;読み出して、値をセット ;=> 1

;; おれおれ定義 (cl:defun %unquote (sym) (if (and (consp sym) (eq 'quote (car sym))) (cadr sym) sym))

(shadow 'class) (cl:defmacro class (name &body body) `(cl:defclass ,(if name name (gensym)) () ,(loop :for l :on body :by #'cddr :collect `(,(%unquote (car l)) :initform ,(cadr l)))))

;; classと、newのために拡張 (cl:defmacro = (place val) (cl:cond ((and (consp val) (eq 'class (car val))) `(progn (cl:setf ,place (class ,place ,@(cddr val))) (defmethod ,place (slot) (slot-value ,place slot)))) ((and (consp val) (eq 'new (car val))) `(progn (cl:setf ,place ,val) (defmethod ,place (slot) (slot-value ,place slot)))) ('T `(cl:setf ,place ,val))))

(shadow 'type) (cl:defmacro type (name &body body) `(cl:defclass ,name () ,(mapcar (cl:lambda (x) `(,(car x) :initform ,(cadr x))) body)))

(cl:defmacro new (class) `(make-instance ',class))

俺Arc祭り 2008冬 (5)

Posted 2008-01-18 18:05:00 GMT

12. Data Types

データの型について
+シンボル
+数(Common Lispと同じ)
+コンス
+文字
+文字列
+配列
+クラス、オブジェクト
+データベース(ハッシュ/連想リスト)
+関数
+マクロ
+その他
だそうです。マクロってのが光ってはいますね。

13. Compounds = Functions on Indices

複合したデータをインデックス付きの関数とみなす試みとのこと。
これも無理目なので、funcallみたいな、obcallというものをでっち上げて代用することにしてみました。

;; 動作 (obcall "hello" 2) ;=> #\l

(obcall '(foo bar baz) 1) ;=> bar

(map #'pr '(3 4 1 2)) ;=> 3412

(map "carpet" '(3 4 1 2)) ;=> (#\p #\e #\a #\r)

;; ---- 定義 (defun obcall (obj index) (elt obj index))

(defun map (fn &rest args) (if (functionp fn) (apply #'cl:mapcar fn args) (apply #'cl:mapcar (fn (x) (obcall fn x)) args))) ;複数の引数の場合は?


14. Strings Work Like Lists

文字列をリストに見立てるとのこと。TAO/ELISって文字列をリストとして扱えたらしいというのをどっかで読んだ記憶があるのですが、こういうこともできたんでしょうか。マニュアルには載ってないので、記憶違いかもしれませんが…。
色々と夢が広がりまくりなのですが、適当にできそうなものだけ作ってみました。

;; 動作 (car "abc") ;=> #\a

(cons #\a "bc") ;=> "abc"

;; ---- 定義 (defmethod car ((obj string)) (aref obj 0))

(defmethod cdr ((obj string)) (subseq obj 1))

(shadow 'cons) (defgeneric cons (x y) (:method ((x string) (y string)) (cl:concatenate 'string x y)) (:method ((x character) (y character)) (cl:concatenate 'string (string x) (string y))) (:method ((x string) (y character)) (cl:concatenate 'string x (string y))) (:method ((x character) (y string)) (cl:concatenate 'string (string x) y)) (:method (x y) (cl:cons x y)))

俺Arc祭り 2008冬 (4)

Posted 2008-01-18 17:22:00 GMT

Lisp系言語には繰り返し構文が色々ありすぎる位ですが、Arcでも新しい構文を導入するようです。

10. Iteration

-for, each, to, while
Common LispのDOはわかりづらい!とのこと。自分は、DO大好きなので、全然そう思わないのですが、多分少数派なんでしょう。そういう意見しか目にしたことないし…。繰り返し機構が付いたLETだと思えば、そんなに難解でもないと思うんですが、どうなんでしょう。あと、LOOPは色々話題にのぼるんですが、DOって話題になるとしても「気持ち悪い」で終わることが多いですね(笑)
さっと見た感じでは、ArcではCというかPerlの機構を取り入れてみたようです。どうもこの時のArcは、思い切りPerlの方向に進んでいるような。すべての言語はLispに向かうんじゃなかったのか!

11. Iteration Captures

繰り返し時にsumとか、keepとかitに値を束縛するという試み。加えてwhileは、itを束縛するとのこと。
loopのsum、collect、Perlの、$_とか、そういう感じでしょうか。
keepはリストに蓄え、sumは数を合計します。どうしてかは知りませんが、keepと、sumは二者択一だそうです。
下記のコードはCommon Lispと俺Arcの組み合わせで記述していることもあいまって非常にごちゃごちゃしています。
しかし、どうも括弧の足りないcondは好きになれないな…。

;; 動作 (for (= i 0) (< i 10) (++ i) (pr i))

;-> 123456789 NIL

(each x '(1 2 3 4 5) (pr x) (sum x))

(each x '("al" "bob" "joe") (if (> (len x) 2) (keep x))) ;=> ("bob" "joe")

(to x 5 (sum x) (pr x)) ;->01234 10

(let i 0 (pr (while (< (++ i) 10) (pr i) (keep i))))) ;123456789(1 2 3 4 5 6 7 8 9)

;; 定義

;; for ;;predが受け付けるのは、任意の式なのか、決まった形式か分からないので、 ;;predの変数多重評価問題放置 (macro for (init pred then . body) (with (tag (gensym)) `(do ,init (block nil (tagbody ,tag (unless ,pred (return)) ,@body ,then (go ,tag))))))

;; ++ (shadow 'incf) (shadow '++) (macro ++ body `(cl:incf ,.body))

;; to (macro to body `(with-keep-or-sum to1 ,.body))

(macro to1 (var limit . body) (with (/limit (gensym) /tag (gensym)) `(let ,/limit ,limit (do (= ,var 0) (block nil (tagbody ,/tag (unless (< ,var ,/limit) (return)) ,@body (++ ,var) (go ,/tag)))))))

;; each (macro each body `(with-keep-or-sum each1 ,@body))

(macro each1 (var obj . body) (with (/i (gensym) /obj (gensym)) `(with (,/obj (coerce ,obj 'vector) ,var nil) (to1 ,/i (length ,/obj) (setq ,var (aref ,/obj ,/i)) ,@body))))

;; while (macro while body `(with-keep-or-sum while1 ,.body))

(macro while1 (pred . body) (let tag (gensym) `(block nil (tagbody ,tag (if ,pred (do ,.body (go ,tag)) nil)))))

(macro with-keep-or-sum (fn . body) (with (s (x-finder 'sum body) k (x-finder 'keep body)) (cond (and s k) (error "SUMとKEEPはどちらかでお願いしたい。") s `(with-sum (,fn ,.body)) k `(with-keep (,fn ,.body)) `(,fn ,.body))))

(macro with-keep body (let /tem (gensym) `(let keep (list ()) (declare (ignorable keep)) (let ,/tem keep (cl:macrolet ((keep (var) `(rplacd (cl:last ,',/tem) (list ,var)))) ,@body)) (cl:cdr keep))))

(macro with-sum body `(let sum 0 (declare (ignorable sum)) (cl:macrolet ((sum (var) `(++ sum ,var))) ,@body) sum))

俺Arc祭り 2008冬 (3)

Posted 2008-01-18 15:55:00 GMT

だんだん疲れて来てしまいました。俺Arc祭り。段々恥ずかしい駄目駄目なコードを晒すのも恥ずかしくなってまいりました。
実際のところは駄目なところが分からないのと、恥ずかしいところが分からない自分が恥かしいのですが。
それはさておき、

9. Binding

-with, let
Arcの変数束縛機構ですが、letは、変数を一組しかとらないことにするみたいです。Gaucheのlet1と同じ感じ。
複数の場合には、withを使用するとのこと。
また、(let x 3 (foo x))は((fn (x) (foo x) ) 3)に展開されるんだそうです。letがlambdaに展開されるってことでしょうか。
色々深いんだと思いますが、単にletに展開するだけにしました。

;; 動作 (with (x 'a y 'b) (list x y)) ;=> (A B)

(let x 'a (cons x 5)) ;=> (A . 5)

;; 定義 (cl:defmacro with ((&rest spec) &body body) `(cl:let ,(cl:do ((s spec (cddr s)) res) ((endp s) (nreverse res)) (push `(,(car s) ,(cadr s)) res)) ,@body))

(shadow 'let) (cl:defmacro let (var val &body body) `(cl:let ((,var ,val)) ,@body))

俺Arc祭り 2008冬 (2)

Posted 2008-01-18 15:18:00 GMT

だらだら続いております。俺Arc祭り。
自分の書いているものが、非常に読み辛く、また書いてても良く分からなくなって来たので、小分けにして行くことにしました。

8. Functions and Macro

-fn
lambdaは、fnと書くそうです。

(macro fn body `(cl:lambda ,@body))

非常に安直に…。(funcall (fn (x) (+ x 3)) 3)としないと動きません…。
((fn (x) (+ x 3) ) 3)みたいにして動くようにする簡単な方法ってあるんでしょうか。
-rfn
labels(再帰可能なローカル関数定義)は、rfnと書くとのこと。
rfnは、多分トップレベルでも使えるんだろうとは思いますが、色々大変そうなので、doに埋め込むことにしました。
段々と定義するのにパッケージを指定するのが面倒になってきたので、my-arcパッケージを定義するために、my-arc-defというパッケージを作成し、そこからインポートすることにしてみます。
-no
doの例で出てきたので、nullの一般化されたものと勝手に解釈して適当に定義。

;; 動作 (do (= x '(foo bar baz)) (rfn len (x) (if (no x) 0 (+ 1 (len (cdr x))))) (pr 1) (rfn fact (n) (if (no n) 1 (* n (fact (1- n))))) (pr 2) (= y (len x)) (list x y (fact 10)))

;->1 2 ;=> ((FOO BAR BAZ) 3 3628800)

;; 上記のマクロ展開 (let (y x) (declare (ignorable y x)) (setq x '(foo bar baz)) (labels ((len (x) (let ((it (no x))) (if it 0 (+ 1 (len (cdr x)))))) (fact (n) (let ((it (no n))) (if it 1 (* n (fact (1- n))))))) (pr 1) (pr 2) (setq y (len x)) (list x y (fact 10))))

;; ごちゃごちゃ定義 (in-package :my-arc-def)

(defun rfn-expander (body) (do ((b body (cdr b)) res) ((endp b) (nreverse res)) (if (eq 'rfn (alexandria:ensure-car (car b))) (multiple-value-bind (fn bo) (rfn+body b) (return `(,@(nreverse res) (labels ,fn ,@bo)))) (push (car b) res))))

(defun rfn+body (body) (let (fn bo) (dolist (b body (values (nreverse fn) (nreverse bo))) (if (eq 'rfn (car b)) (push (cdr b) fn) (push b bo)))))

(in-package :my-arc)

(macro do body (let vars (x-finder '= body) `(cl:let ,vars (declare (ignorable ,@vars)) ,@(rfn-expander body))))

(defmethod no ((obj null)) t) (defmethod no ((obj string)) (equal obj "")) (defmethod no ((obj character)) (equal obj #\Nul)) (defmethod no ((obj number)) (zerop obj)) (defmethod no ((obj vector)) (equalp obj #())) (defmethod no (obj) nil)


-マクロはファーストクラスオブジェクト
局所マクロを作るのは単に変数に束縛するだけ。
これは無理なのでスルー。
しかし、マクロがファーストクラスオブジェクトだとどういう風にプログラミングスタイルが変わるんでしょうね。
例示されているmacroの例なんですが、

(macro (test . body) `(if ,test (do ,.body)))

;; when? (macro when (test . body) `(if ,test (do ,.body)))

;; 動作 (when 33 'foo 'bar 'baz it) ;=> 33

これってタイポでwhenが抜けてるんですかね? whenだと合点が行くのですが…。
ひたすら続きます…。

俺Arc祭り 2008冬 (1)

Posted 2008-01-18 01:17:00 GMT

ポール・グレアム氏のArcが、この冬に公開されるらしいとのこと。
それでそのArc公開のニュースなんですが、存外、話題にもなってない様子です。
もっとドッカンドッカン騒がれるのかと思ったんですが…。
Arcの計画が世に現われたのは、2001年の11月位とのことなので、早6年。
-(http://www.paulgraham.com/arcll1.html)
話の流れ的には、全くつながっていないのですが、この6年前のアイディアを、そのままCommon Lispのマクロで書いて俺Arcを作ってみることにしました。
多分、結構試してみた方は結構いるんじゃないかと思うんですが、へんてこ俺Arcを作って実物のArcに思いを馳せることができるの残り僅かかも知れません。
また、俺Arcを作ってみることで、本物のArcへの理解も深まるかもしれません。
俺Arcはまさに今が旬なのです!
ということで、早速、ノープランでこの2001年の発表を頭から順番に作っていってみます。

下準備

とはいえなんとなく必要そうなものは予め作ってみます。

(defpackage :my-arc (:use :cl))

(in-package :my-arc)

(cl:defmacro macro (cl:&body body) (cl:if (cl:consp (second body)) `(cl:defmacro ,@body) `(cl:defmacro ,(first body) (cl:&body ,(second body)) ,@(cddr body))))

(cl:defmacro def (cl:&body body) (cl:if (cl:consp (second body)) (cl:if (tailp body ()) `(cl:defun ,@body) `(cl:defun ,(first body) ,(%add-rest (second body)) ,@(cddr body))) `(cl:defun ,(first body) (cl:&rest ,(second body)) ,@(cddr body))))

(cl:defun %add-rest (expr) (cl:let ((l (copy-list expr))) (cl:let ((tail (last l))) (rplacd tail `(&rest ,(cdr tail))) l)))

パッケージ名は安直に、my-arc。defmacroと、defunに、macro、defという名前を付け直してみました。&restパラメータは取らないそうなので、適当にSchemeのlambdaみたいにすることにしました。割と悲しげに仕上がりました。

4. Other Principles

Arcはポリモーフィックだそうで、+で文字列の連結とかするそうです。総称関数にしようかとも思いましたが、etypecaseで分けました。これは結構やってる人は多そうです。

;; 動作 (+ "foo" "bar") ;=>"foobar"

(pr (+ #(foo) "bar")) ;#(FOO b a r) (+ '(foo bar) '(baz)) ;(foo bar baz)

(+ 0 pi) ;3.141592653589793d0

;; 定義 (def + (arg . args) (etypecase arg (string (apply #'concatenate 'string arg args)) (vector (apply #'concatenate 'vector arg args)) (list (apply #'concatenate 'list arg args)) (number (apply #'cl:+ arg args))))

5. Syntax

Arcでは、文法を定義して、foo.barのような呼び出しを可能にしてみる、とのことですが、これは当然ながらしんどいので中途半端に挑戦して諦めることにしました。
fn.y => (fn y)
fn:y => (fn 'y)
[+ _ 1] => (fn (x) (+ x 1))
だそうです。
角カッコのやつは、リーダマクロでできそうです。

;; 存在しないものを捏造 (macro arcall (expr) (arc-to-cl expr))

;; 定義 (let ((foo -33.5)) (arcall truncate.abs.foo)) ;=> 33, 0.5

(defun arc-to-cl (expr) (reduce #'list (map #'read-from-string (ppcre:split "\\." (string expr))) :from-end 'T))

6. Arc Core

condの括弧が多いので、減らすそうです。
自分はlet、do、condの括弧は割と苦にならないタイプなんですが、そういうのは少数派なんでしょうか…。(とはいえ、もう一段階ネストした、Schemeのmatch-letはわけがわかりませんが…。)
とりあえず、安直にボディを適当に振り分けて、itを使うためにkmrclのacondに展開することにしてみました。
ちなみにここで、Lisp 1.5のcondの暗黙のprognについて語られてますが、エミュレータのLisp 1.5で試した限りでは、Lisp 1.5のcondは暗黙のprognじゃないみたいなんですよね。lambdaのボディも暗黙のprognじゃないみたいで、Lisp 1.5は謎が多いです…。
それと、nilへのcar、cdrの適用は、エラーとのこと。

;; 動作 (cond (probe-file "/tmp/") (do (pr "it -> ") (pr it) (terpri)) nil) ;it -> /tmp/

;; 定義 (shadow 'cond)

(macro cond body (cl:let ((cond-body (cl:do ((b body (cl:cddr b)) res) ((endp b) (nreverse res)) (cl:if (cl:cdr b) (push `(,(cl:car b) ,(cl:cadr b)) res) (push `(t ,(cl:car b)) res))))) `(kmrcl:acond ,@cond-body)))

(shadow 'car) (shadow 'cdr)

(defmethod car ((obj null)) (error "The value ~S is not of type LIST." obj))

(defmethod car ((obj cons)) (cl:car obj))

(defmethod cdr ((obj null)) (error "The value ~S is not of type LIST." obj))

(defmethod cdr ((obj cons)) (cl:cdr obj))

7. Assignment (Scope)

ローカル変数は値を代入すると暗黙に作られて、まだ宣言されていない変数に値を代入すると、現在のブロックの残りの部分までを有効範囲とする局所変数が作られるとのこと。
ブロックは、主にdoで作成。
=は、setfに相当するとのこと。
ArcのdoはCommon LispのprognでprはCommon Lisp のprincだそうです。
変数を束縛しないのは、justdoになるとのこと。ってことは、do = prognなくて、justdo = prognなんでしょうか。
とりあえず、無理矢理letに変換することにしました。

(do (= x 5) (cons x 'a)) ;=:> (5 . A)

(do (= x 5) (do (= y 6) (list x y))) ;=> (5 6)

;; 定義 (shadow 'do)

(macro do body (cl:let ((vars (%x-finder '= body))) `(cl:let ,vars (declare (ignorable ,@vars)) ,@body)))

(cl:defun %x-finder (sym form &optional taglist) (and form (if (eq sym (car form)) (push (cadr form) taglist) (dolist (c (remove-if-not #'consp form) (delete-duplicates taglist)) (cl:let ((tem (%x-finder sym c taglist))) (cl:when tem (setq taglist tem)))))))

(shadow '=)

(macro = args `(cl:setf ,@args))

(macro justdo body `(progn ,@body))

(shadow 'princ)

(setf (symbol-function 'pr) #'cl:princ)


大した内容でもないのに長くなってしまいました。まだまだあるので、続きは別エントリにします…。

(graym 12)(gray 12)
1time: 159 msec.time: 265 msec.
2time: 0 msec. time: 327 msec.
3time: 0 msec.time: 206 msec.