【追記】簡易LISP処理系の各プログラミング言語実装例の記事作成に伴い，『7行インタプリタ実装まとめ』は更新無期延期としました．
拙作記事『7行インタプリタ実装まとめ』について，そろそろSchemeとPython以外にも対応しないとなあと思っていろいろ整理した結果，『S式入力の実装部分がほとんどじゃないこれ？』→『あと，リスト処理内容に基準を設けてないと言語ごとに実装方針がバラバラになりそう』となり，とりあえず『cons car cdr eq atomが使える』ようにする記述例を先にまとめていくことにした次第．ホスト言語上での純LISP機能実装に近いとでもいいますか．
#仕様
- コンスセル（cons cells）を定義
- アトムは全て文字列．空リストは各言語のNULL相当を使用，もしくは，独自定義
-
conscarcdrを実装 - アトム同士が等しいかを判定する
eqを実装 - アトムか否かを判定する
atomを実装，空リストおよび真偽値もアトムと判断
実装上の最大のポイントは，アトムとしての文字列と，アトム（やコンスセル自身）を組み合わせたコンスセルの双方を参照できる変数や型，名前付けをどのように記述するか，でしょうか．動的型付きの場合は問題ありませんが，静的型付きの場合は，新規の型定義やキャストなどを用いて工夫する必要があります．なお，元が関数型処理であることから，コンスセルは可能な限りイミュータブルな設定としています．
#Pythonの実装例
##タプル定義版
コンスセルをペア要素のタプルで定義したバージョン．空リストはNoneを使用．
listproc.py
# Cons cells are created by using tuple.
# All of atoms are string and the null value is None.
def cons(x, y): return (x, y)
def car(s): return s[0]
def cdr(s): return s[1]
def eq(s1, s2): return s1 == s2
def atom(s): return isinstance(s, str) or eq(s, None) or isinstance(s, bool)
利用例は次の通り．Python 3，Python 2で確認．
def mkassoc(a, b):
if eq(a, None) or eq(b, None):
return None
else:
return cons(cons(car(a), car(b)), mkassoc(cdr(a), cdr(b)))
def assoc(k, vs):
if eq(vs, None):
return None
else:
if eq(car(car(vs)), k):
return car(vs)
else:
return assoc(k, cdr(vs))
>>> al_k = cons("hoge", cons("hage", cons("hige", None)))
>>> al_v = cons("10", cons("20", cons("30", None)))
>>> al = mkassoc(al_k, al_v)
>>> assoc("hage", al)
('hage', '20')
>>> car(assoc("hage", al))
'hage'
>>> cdr(assoc("hage", al))
'20'
##クラス定義版
コンスセルをクラス定義したバージョン．主に，静的型付け言語による記述との対比のために実装．
- アトムとしての文字列とコンスセル参照の双方を想定した基本クラス
CELL -
CELLインスタンスをふたつもつことを想定したCONSクラス - ドット対やリスト簡便表記に対応したS式表示を
printで行えるよう__str__を定義 -
carcdrはクラスCELLのメソッドとして定義 -
eq相当はCELLCONS双方で==の比較が可能となるよう記述 -
atomはCELLCONS双方のメソッドとして定義
conscells.py
# Cons cells are created by using class.
# All of atoms are string and the null value is "nil".
class cons:
def __init__(self, x, y):
self.x = x
self.y = y
def __str__(self):
r = self.x.__str__()
if isinstance(self.y.v, str):
d = self.y.v
if d == "nil":
return r
else:
return r + ' . ' + d
else:
return r + ' ' + self.y.v.__str__()
def __eq__(self, other): return False
def atom(self): return False
class cell:
def __init__(self, v):
self.v = v
def __str__(self):
if self.v == "nil":
return '()'
elif isinstance(self.v, str):
return self.v
else:
return '(' + self.v.__str__() + ')'
def car(self): return self.v.x
def cdr(self): return self.v.y
def strp(self): return isinstance(self.v, str)
def boolp(self): return isinstance(self.v, bool)
def __eq__(self, other):
if self.strp() and other.strp():
return self.v == other.v
else: return False
def atom(self): return self.strp() or self.boolp()
利用例は次の通り．Python 3のみ対応．
NIL = cell("nil")
def mkassoc(a, b):
if a == NIL or b == NIL:
return NIL
else:
return cell(cons(
cell(cons(a.car(), b.car())),
mkassoc(a.cdr(), b.cdr())))
def assoc(k, vs):
if vs == NIL:
return NIL
else:
if vs.car().car() == k:
return vs.car()
else:
return assoc(k, vs.cdr())
al_k = cell(cons(cell("hoge"),
cell(cons(cell("hage"),
cell(cons(cell("hige"), NIL))))))
print("al_k =", al_k)
al_v = cell(cons(cell("10"),
cell(cons(cell("20"),
cell(cons(cell("30"), NIL))))))
print("al_v =", al_v)
al = mkassoc(al_k, al_v)
print("mkassoc(al_k, al_v) =", al)
print("assoc(cell(\"hage\"), al) =",
assoc(cell("hage"), al))
print("assoc(cell(\"hage\"), al).car() =",
assoc(cell("hage"), al).car())
print("assoc(cell(\"hage\"), al).cdr() =",
assoc(cell("hage"), al).cdr())
print("NIL =", NIL)
$ python3 -i conscells.py
al_k = (hoge hage hige)
al_v = (10 20 30)
mkassoc(al_k, al_v) = ((hoge . 10) (hage . 20) (hige . 30))
assoc(cell("hage"), al) = (hage . 20)
assoc(cell("hage"), al).car() = hage
assoc(cell("hage"), al).cdr() = 20
NIL = ()
#C言語の実装例
まず，文字列ポインタとコンスセルポインタの両方を扱うことができるnode_t構造体を定義，それを用いてコンスセルcons_t構造体を定義．空リストはNULLポインタを使用．
※下記は32ビット仕様の場合です．64ビット仕様の場合は，value_tの型定義を（unsigned intではなく）unsigned longとして下さい．
listproc.c
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
/* Cons cells are created by using typedef struct. */
/* All of atoms are char* and the null value is NULL. */
typedef unsigned int value_t;
enum NODE_TAG { NODE_STRG, NODE_CONS };
typedef struct _node_t_ {
value_t value;
enum NODE_TAG tag;
} _node_t, *node_t;
node_t node(value_t value, enum NODE_TAG tag)
{
node_t n = (node_t)malloc(sizeof(_node_t));
n->value = value; n->tag = tag;
return (n);
}
typedef struct _cons_t_ {
node_t x;
node_t y;
} _cons_t, *cons_t;
node_t cons(node_t x, node_t y)
{
cons_t c = (cons_t)malloc(sizeof(_cons_t));
c->x = x; c->y = y;
node_t n = node((value_t)c, NODE_CONS);
return (n);
}
#define str_to_node(s) (node((value_t)(s), NODE_STRG))
#define node_to_str(s) ((char *)(s->value))
#define car(s) (((cons_t)(s->value))->x)
#define cdr(s) (((cons_t)(s->value))->y)
int eq(node_t s1, node_t s2)
{
if (s1 == NULL && s2 == NULL) return (1);
else if (s1->tag == NODE_CONS || s2->tag == NODE_CONS) return (0);
else return (!strcmp(node_to_str(s1), node_to_str(s2)));
}
#define atom(s) ((s->tag == NODE_STRG) || eq(s, NULL) || eq(s, (0==0)) || eq(s, (0==1)))
利用例は次の通り．GCC 8.3.0（32ビット版）で確認．
#define MAXSTR 64
node_t mkassoc(node_t a, node_t b)
{
if (eq(a, NULL) || eq(b, NULL)) {
return NULL;
} else {
return cons(cons(car(a), car(b)), mkassoc(cdr(a), cdr(b)));
}
}
node_t assoc(node_t k, node_t vs)
{
if (eq(vs, NULL)) {
return NULL;
} else {
if (eq(car(car(vs)), k)) {
return car(vs);
} else {
return assoc(k, cdr(vs));
}
}
}
int main(void)
{
node_t al_k = cons(str_to_node("hoge"),
cons(str_to_node("hage"),
cons(str_to_node("hige"), NULL)));
node_t al_v = cons(str_to_node("10"),
cons(str_to_node("20"),
cons(str_to_node("30"), NULL)));
node_t al = mkassoc(al_k, al_v);
node_t k = str_to_node("hage");
node_t r = assoc(k, al);
printf("car(assoc(\"hage\", al)) = %s\n", node_to_str(car(r)));
printf("cdr(assoc(\"hage\", al)) = %s\n", node_to_str(cdr(r)));
free(al);
free(al_k);
free(al_v);
free(k);
free(r);
return (0);
}
car(assoc("hage", vs)) = hage
cdr(assoc("hage", vs)) = 20
#Common Lispの実装例
あくまで参考．コンスセルはクロージャで実現．オリジナルと区別するため，s_cons s_car s_cdr s_eq s_atomの名前で定義．空リストはNILを使用．
lisproc.lsp
;;;; Cons cells are created by using lambda closure.
;;;; All of atoms are string and the null value is NIL.
(defun s_cons (x y) (lambda (f) (funcall f x y)))
(defun s_car (c) (funcall c (lambda (x y) x)))
(defun s_cdr (c) (funcall c (lambda (x y) y)))
(defun s_eq (s1 s2) (equal s1 s2))
(defun s_atom (s) (or (and (not (functionp s)) (not (equal s NIL))) (equal s t)))
利用例は次の通り．SBCL 1.4.16で確認．
(defun s_mkassoc (a b)
(if (or (s_eq a NIL) (s_eq b NIL)) NIL
(s_cons (s_cons (s_car a) (s_car b))
(s_mkassoc (s_cdr a) (s_cdr b)))))
(defun s_assoc (k vs)
(if (s_eq vs NIL) NIL
(if (s_eq (s_car (s_car vs)) k)
(s_car vs)
(s_assoc k (s_cdr vs)))))
* (defparameter al_k
(s_cons "hoge" (s_cons "hage" (s_cons "hige" NIL))))
AL_K
* (defparameter al_v
(s_cons "10" (s_cons "20" (s_cons "30" NIL))))
AL_V
* (defparameter al (s_mkassoc al_k al_v))
AL
* (s_assoc "hage" al)
#<CLOSURE (LAMBDA (F) :IN S_CONS) {50F2E3F5}>
* (s_car (s_assoc "hage" al))
"hage"
* (s_cdr (s_assoc "hage" al))
"20"
#Rubyの実装例
コンスセルは二要素の（凍結）配列で定義．空リストはnilを使用．
listproc.rb
#### Cons cells are created by using Array.
#### All of atoms are string and the null value is nil.
def cons(x, y) [x, y].freeze end
def car(s) s[0] end
def cdr(s) s[1] end
def eq(s1, s2) s1 == s2 end
def atom(s) s.is_a?(String) || s == nil || s == true || s == false end
利用例は次の通り．CRuby 2.5.5で確認．
def mkassoc(a, b)
if eq(a, nil) || eq(b, nil) then
return nil
else
return cons(cons(car(a), car(b)), mkassoc(cdr(a), cdr(b)))
end
end
def assoc(k, vs)
if eq(vs, nil) then
return nil
else
if eq(car(car(vs)), k) then
return car(vs)
else
return assoc(k, cdr(vs))
end
end
end
>> al_k = cons("hoge", cons("hage", cons("hige", nil)))
=> ["hoge", ["hage", ["hige", nil]]]
>> al_v = cons("10", cons("20", cons("30", nil)))
=> ["10", ["20", ["30", nil]]]
>> al = mkassoc(al_k, al_v)
=> [["hoge", "10"], [["hage", "20"], [["hige", "30"], nil]]]
>> assoc("hage", al)
=> ["hage", "20"]
>> car(assoc("hage", al))
=> "hage"
>> cdr(assoc("hage", al))
=> "20"
#JavaScriptの実装例
コンスセルは二要素の（凍結）配列で定義．空リストはnullを使用．
listproc.js
//// Cons cells are created by using Array.
//// All of atoms are string and the null value is null.
function cons(x, y) { return Object.freeze([x, y]); }
function car(s) { return s[0]; }
function cdr(s) { return s[1]; }
function eq(s1, s2) { return s1 === s2; }
function atom(s) { return typeof s == 'string' || eq(s, null) || eq(s, true) || eq(s, false); }
利用例は次の通り．Node.js 10.21で確認．
function mkassoc(a, b) {
return eq(a, null) || eq(b, null)
? null
: cons(cons(car(a), car(b)), mkassoc(cdr(a), cdr(b)));
}
function assoc(k, vs) {
if (eq(vs, null)) {
return null;
} else {
if (eq(car(car(vs)), k)) {
return car(vs);
} else {
return assoc(k, cdr(vs));
}
}
}
> al_k = cons("hoge", cons("hage", cons("hige", null)));
[ 'hoge', [ 'hage', [ 'hige', null ] ] ]
> al_v = cons("10", cons("20", cons("30", null)));
[ '10', [ '20', [ '30', null ] ] ]
> al = mkassoc(al_k, al_v);
[ [ 'hoge', '10' ], [ [ 'hage', '20' ], [ [Array], null ] ] ]
> assoc("hage", al);
[ 'hage', '20' ]
> car(assoc("hage", al));
'hage'
> cdr(assoc("hage", al));
'20'
#Haskellの実装例
コンスセルはデータ構築子（data constructors）で定義．空リストはNullを定義して使用．また，そのままでは，アトムやコンスセルの指定が残ったままの表示となり大変見にくいため，Show定義によるS式出力も併せて定義．
listproc.hs
-- Cons cells are created by using data constructors.
-- All of atoms are string and the null value is Null.
data CELL = Null | Bool Bool | Sybl String | Pair CELL CELL
sStrcons :: CELL -> String
sStrcons (Pair x y) =
case y of
Null -> show x
(Bool a) -> show x ++ " . " ++ show a
(Sybl a) -> show x ++ " . " ++ a
_ -> show x ++ " " ++ sStrcons y
instance Show CELL where
show Null = "()"
show (Bool True) = "t"
show (Bool False) = "nil"
show (Sybl x) = x
show ss = "(" ++ sStrcons ss ++ ")"
instance Eq CELL where
Null == Null = True
Bool True == Bool True = True
Bool False == Bool False = True
Sybl x == Sybl y = x == y
_ == _ = False
cons :: CELL -> CELL -> CELL
cons x y = Pair x y
car :: CELL -> CELL
car (Pair x _) = x
cdr :: CELL -> CELL
cdr (Pair _ y) = y
eq :: CELL -> CELL -> Bool
eq s1 s2 = s1 == s2
atom :: CELL -> Bool
atom s =
case s of
Null -> True
(Bool s) -> True
(Sybl s) -> True
_ -> False
利用例は次の通り．GHC 8.4.4で確認．
mkassoc :: CELL -> CELL -> CELL
mkassoc a b =
if (eq a Null) || (eq b Null) then Null
else (cons (cons (car a) (car b)) (mkassoc (cdr a) (cdr b)))
assoc :: CELL -> CELL -> CELL
assoc k vs =
if (eq vs Null) then Null
else if (eq (car (car vs)) k) then (car vs)
else (assoc k (cdr vs))
*Main> al_k = (cons (Sybl "hoge") (cons (Sybl "hage") (cons (Sybl "hige") Null)))
*Main> al_v = (cons (Sybl "10") (cons (Sybl "20") (cons (Sybl "30") Null)))
*Main> al = (mkassoc al_k al_v)
*Main> (assoc (Sybl "hage") al)
(hage . 20)
*Main> (car (assoc (Sybl "hage") al))
hage
*Main> (cdr (assoc (Sybl "hage") al))
20
#Go言語の実装例
コンスセルは，文字列・コンスセル双方参照可能なインタフェース型を使用した構造体で定義．空リストはnilを使用．
listproc.go
package main
import "fmt"
// Cons cells are created by using interface and struct.
// All of atoms are string and the null value is nil.
type NODE interface{};
type CONS struct { x NODE; y NODE; };
func cons(x NODE, y NODE) NODE {
var r CONS; r.x = x; r.y = y;
return NODE(r);
}
func car(s NODE) NODE { return s.(CONS).x; }
func cdr(s NODE) NODE { return s.(CONS).y; }
func eq(s1 NODE, s2 NODE) bool { return s1 == s2; }
func atom(s NODE) bool {
if (s == nil) {
return true;
} else {
switch s.(type) {
case string: return true;
case bool: return true;
default: return false;
}
}
}
利用例は次の通り．Go 1.11.6で確認．
func mkassoc(a NODE, b NODE) NODE {
if (eq(a, nil) || eq(b, nil)) {
return nil;
} else {
return cons(cons(car(a), car(b)), mkassoc(cdr(a), cdr(b)));
}
}
func assoc(k NODE, vs NODE) NODE {
if (eq(vs, nil)) {
return nil;
} else {
if (eq(car(car(vs)), k)) {
return car(vs);
} else {
return assoc(k, cdr(vs));
}
}
}
func main() {
al_k := cons("hoge", cons("hage", cons("hige", nil)));
al_v := cons("10", cons("20", cons("30", nil)));
fmt.Println("al_k =", al_k);
fmt.Println("al_v =", al_v);
al := mkassoc(al_k, al_v);
fmt.Println("mkassoc(al_k, al_v) =", al);
fmt.Println("assoc(\"hage\", al) =", assoc("hage", al));
fmt.Println("car(assoc(\"hage\", al)) =", car(assoc("hage", al)));
fmt.Println("cdr(assoc(\"hage\", al)) =", cdr(assoc("hage", al)));
}
$ go run listproc.go
al_k = {hoge {hage {hige <nil>}}}
al_v = {10 {20 {30 <nil>}}}
mkassoc(al_k, al_v) = {{hoge 10} {{hage 20} {{hige 30} <nil>}}}
assoc("hage", al) = {hage 20}
car(assoc("hage", al)) = hage
cdr(assoc("hage", al)) = 20
#Juliaの実装例
コンスセルはペア要素のタプルで定義．空リストはnothingを使用．atomでの文字列判定は，型としてStringだけでなく（字句解析後などの）SubStringもあることに注意．
listproc.jl
# Cons cells are created by using tuple.
# All of atoms are string and the null value is nothing.
cons = (x, y) -> (x, y)
car = s -> s[1]
cdr = s -> s[2]
eq = (s1, s2) -> s1 == s2
atom = s ->
isa(s, String) || isa(s, SubString) || isa(s, Nothing) || isa(s, Bool)
利用例は次の通り．Julia 1.0.3で確認．
mkassoc = (a, b) ->
eq(a, nothing) || eq(b, nothing) ? nothing :
cons(cons(car(a), car(b)), mkassoc(cdr(a), cdr(b)))
assoc = (k, vs) ->
eq(vs, nothing) ? nothing :
eq(car(car(vs)), k) ? car(vs) :
assoc(k, cdr(vs))
julia> al_k = cons("hoge", cons("hage", cons("hige", nothing)))
("hoge", ("hage", ("hige", nothing)))
julia> al_v = cons("10", cons("20", cons("30", nothing)))
("10", ("20", ("30", nothing)))
julia> al = mkassoc(al_k, al_v)
(("hoge", "10"), (("hage", "20"), (("hige", "30"), nothing)))
julia> assoc("hage", al)
("hage", "20")
julia> car(assoc("hage", al))
"hage"
julia> cdr(assoc("hage", al))
"20"
#PHPの実装例
コンスセルはペア要素の（連想）配列で定義．空リストはNULLを使用．==では型変換によって真の値が正確には扱えないため，eqでは===を使用．また，echoやprint_rではコンスセルに基づくリストの表示がわからない／わかりにくいため，S式出力s_stringも併せて定義．
listproc.php
# Cons cells are created by using Array.
# All of atoms are string and the null value is NULL.
function cons($x, $y) { return [$x, $y]; }
function car($s) { return $s[0]; }
function cdr($s) { return $s[1]; }
function eq($s1, $s2) { return $s1 === $s2; }
function atom($s) {
return is_string($s) || is_bool($s) || is_null($s);
}
# S-expression output: s_string
function s_strcons($s)
{
$sa_r = s_string(car($s));
$sd = cdr($s);
if (eq($sd, NULL)) {
return $sa_r;
} elseif (atom($sd)) {
return $sa_r . " . " . $sd;
} else {
return $sa_r . " " . s_strcons($sd);
}
}
function s_string($s)
{
if (eq($s, NULL)) { return "()"; }
elseif (eq($s, true)) { return "t"; }
elseif (eq($s, false)) { return "nil"; }
elseif (atom($s)) {
return $s;
} else {
return "(" . s_strcons($s) . ")";
}
}
利用例は次の通り．PHP 7.4.10で確認．
function mkassoc($a, $b)
{
if (eq($a, NULL) || eq($b, NULL)) {
return NULL;
} else {
return cons(cons(car($a), car($b)),
mkassoc(cdr($a), cdr($b)));
}
}
function assoc($k, $vs)
{
if (eq($vs, NULL)) {
return NULL;
} else {
if (eq(car(car($vs)), $k)) {
return car($vs);
} else {
return assoc($k, cdr($vs));
}
}
}
php > $al_k = cons("hoge", cons("hage", cons("hige", NULL)));
php > $al_v = cons("10", cons("20", cons("30", NULL)));
php > $al = mkassoc($al_k, $al_v);
php > echo assoc("hage", $al);
Array
php > print_r(assoc("hage", $al));
Array
(
[0] => hage
[1] => 20
)
php > echo s_string(assoc("hage", $al));
(hage . 20)
php > echo car(assoc("hage", $al));
hage
php > echo cdr(assoc("hage", $al));
20
#Rustの実装例
##ムーブセマンティクス版
Rustは静的型付き言語であることに加え，原則として値の全てが（原則として）所有権の移動として管理されるムーブセマンティクスのため，値がコピーされることを前提とした定義や処理が不可能である．そのことを踏まえ，次のように実装．
-
CELLを，アトムとしての文字列またはコンスセル参照のいずれかをとる列挙体enumとして定義． -
CONSを，ふたつのCELLの値をヒープメモリに動的にとるBoxで構成された構造体として定義． -
carcdrは単独実装せず，car部とcdr部をそれぞれBoxからメモリリークして多値として返すCELLのメソッドunconsを定義．理由は，どちらか一方のみを取り出すと，もう一方はunconsに所有権が移ったまま終了してメモリ解放されてしまうため．一方のみで良い場合は_を用いる． -
eqも単独実装せず，CELLおよびCONSのトレイトPartialEqを定義． -
atomは，CELLの値が文字列の時のみtrueを返すメソッドとして定義． - 列挙体／構造体で構成されたデータ構造を
Debugで表示するとわかりにくいため，ドット対やリスト簡便表記に対応したS式表示をprintln!等で行えるよう，CELLおよびCONSのstd::fmt::Displayを定義．
use std::fmt;
enum CELL { ATOM(String), PAIR(CONS), }
struct CONS { x: Box<CELL>, y: Box<CELL>, }
#[allow(dead_code)]
impl fmt::Display for CONS {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match &(*self.y) {
CELL::ATOM(s) => {
if s == "nil" {
write!(f, "{}", self.x)
} else {
write!(f, "{} . {}", self.x, self.y)
}
},
CELL::PAIR(s) => { write!(f, "{} {}", self.x, s) },
}
}
}
#[allow(dead_code)]
impl fmt::Display for CELL {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match self {
CELL::ATOM(s) => write!(f, "{}", s),
CELL::PAIR(ss) => write!(f, "({})", ss),
}
}
}
#[allow(dead_code)]
impl CELL {
fn strg(c: &str) -> CELL { CELL::ATOM(String::from(c)) }
fn cons(a: CELL, d: CELL) -> CELL {
CELL::PAIR( CONS { x: Box::new(a), y: Box::new(d), })
}
fn uncons(s: CELL) -> (CELL, CELL) {
match s {
CELL::PAIR(CONS { x, y }) => {
(::std::mem::replace(&mut *Box::leak(x), CELL::strg("nil")),
::std::mem::replace(&mut *Box::leak(y), CELL::strg("nil")))
},
CELL::ATOM(s) => (CELL::ATOM(s), CELL::strg("nil")),
}
}
fn atom(s: &CELL) -> bool {
match &s {
CELL::PAIR(CONS { x: _, y: _ }) => false,
CELL::ATOM(_) => true,
}
}
}
#[allow(dead_code)]
impl PartialEq for CONS {
fn eq(&self, _: &Self) -> bool { false }
}
#[allow(dead_code)]
impl PartialEq for CELL {
fn eq(&self, other: &Self) -> bool {
match self {
CELL::ATOM(s1) => {
match other {
CELL::ATOM(s2) => { s1 == s2 },
_ => false,
}
}, _ => false,
}
}
}
利用例は次の通り．rustc 1.34.2にて，上記を含むコードを全てsrc/main.rsにまとめて実行を確認．
fn mkassoc(a: CELL, b: CELL) -> CELL {
let nil = CELL::strg("nil");
if a == nil && b == nil { nil }
else {
let (aa, ad) = CELL::uncons(a);
let (ba, bd) = CELL::uncons(b);
let aad = CELL::cons(aa, ba);
CELL::cons(aad, mkassoc(ad, bd))
}
}
fn assoc(k: CELL, vs: CELL) -> CELL {
let nil = CELL::strg("nil");
if vs == nil { nil }
else {
let (vsa, vsd) = CELL::uncons(vs);
let (vsaa, vsad) = CELL::uncons(vsa);
if vsaa == k {
CELL::cons(vsaa, vsad)
} else {
assoc(k, vsd)
}
}
}
fn main() {
let alk = CELL::cons(CELL::strg("hoge"),
CELL::cons(CELL::strg("hage"),
CELL::cons(CELL::strg("hige"),
CELL::strg("nil"))));
println!("alk = {}", alk);
let alv = CELL::cons(CELL::strg("10"),
CELL::cons(CELL::strg("20"),
CELL::cons(CELL::strg("30"),
CELL::strg("nil"))));
println!("alv = {}", alv);
let al = mkassoc(alk, alv);
println!("al = mkassoc(alk, alv) = {}", al);
let r = assoc(CELL::strg("hage"), al);
println!("r = assoc(CELL::strg(\"hage\"), al) = {}", r);
let (ra, rd) = CELL::uncons(r);
println!("car(r) = {}", ra);
println!("cdr(r) = {}", rd);
}
$ cargo run
Finished dev [unoptimized + debuginfo] target(s) in 0.04s
Running `target/debug/listproc_rs`
alk = (hoge hage hige)
alv = (10 20 30)
al = mkassoc(alk, alv) = ((hoge . 10) (hage . 20) (hige . 30))
r = assoc(CELL::strg("hage"), al) = (hage . 20)
car(r) = hage
cdr(r) = 20
##コピーセマンティクス版
ムーブセマンティクス版のCELL CONSにCloneトレイトを追加した上で，car cdrをCELLのメソッドとして実装，リスト処理関数やサンプル実行などでコンスセルを参照する箇所全てでclone()メソッドを使用．実行結果はムーブセマンティクス版と同じ．
main.rs
use std::fmt;
#[derive(Clone)]
enum CELL { ATOM(String), PAIR(CONS), }
#[derive(Clone)]
struct CONS { x: Box<CELL>, y: Box<CELL>, }
#[allow(dead_code)]
impl fmt::Display for CONS {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match &(*self.y) {
CELL::ATOM(s) => {
if s == "nil" {
write!(f, "{}", self.x)
} else {
write!(f, "{} . {}", self.x, self.y)
}
},
CELL::PAIR(s) => { write!(f, "{} {}", self.x, s) },
}
}
}
#[allow(dead_code)]
impl fmt::Display for CELL {
fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
match self {
CELL::ATOM(s) => write!(f, "{}", s),
CELL::PAIR(ss) => write!(f, "({})", ss),
}
}
}
#[allow(dead_code)]
impl CELL {
fn strg(c: &str) -> CELL { CELL::ATOM(String::from(c)) }
fn cons(a: CELL, d: CELL) -> CELL {
CELL::PAIR( CONS { x: Box::new(a), y: Box::new(d), })
}
fn car(s: CELL) -> CELL {
match s {
CELL::PAIR(CONS { x, y: _ }) => {
(&mut *Box::leak(x)).clone()
},
CELL::ATOM(_) => { CELL::strg("nil") },
}
}
fn cdr(s: CELL) -> CELL {
match s {
CELL::PAIR(CONS { x: _, y }) => {
(&mut *Box::leak(y)).clone()
},
CELL::ATOM(_) => { CELL::strg("nil") },
}
}
fn atom(s: &CELL) -> bool {
match &s {
CELL::PAIR(CONS { x: _, y: _ }) => false,
CELL::ATOM(_) => true,
}
}
}
#[allow(dead_code)]
impl PartialEq for CONS {
fn eq(&self, _: &Self) -> bool { false }
}
#[allow(dead_code)]
impl PartialEq for CELL {
fn eq(&self, other: &Self) -> bool {
match self {
CELL::ATOM(s1) => {
match other {
CELL::ATOM(s2) => { s1 == s2 },
_ => false,
}
}, _ => false,
}
}
}
fn mkassoc(a: CELL, b: CELL) -> CELL {
let nil = CELL::strg("nil");
if a == nil && b == nil { nil }
else {
CELL::cons(
CELL::cons(CELL::car(a.clone()), CELL::car(b.clone())),
mkassoc(CELL::cdr(a.clone()), CELL::cdr(b.clone())))
}
}
fn assoc(k: CELL, vs: CELL) -> CELL {
let nil = CELL::strg("nil");
if vs == nil { nil }
else {
if CELL::car(CELL::car(vs.clone())) == k {
CELL::car(vs.clone())
} else {
assoc(k, CELL::cdr(vs.clone()))
}
}
}
fn main() {
let alk = CELL::cons(CELL::strg("hoge"),
CELL::cons(CELL::strg("hage"),
CELL::cons(CELL::strg("hige"),
CELL::strg("nil"))));
println!("alk = {}", alk);
let alv = CELL::cons(CELL::strg("10"),
CELL::cons(CELL::strg("20"),
CELL::cons(CELL::strg("30"),
CELL::strg("nil"))));
println!("alv = {}", alv);
let al = mkassoc(alk, alv);
println!("al = mkassoc(alk, alv) = {}", al);
let r = assoc(CELL::strg("hage"), al);
println!("r = assoc(CELL::strg(\"hage\"), al) = {}", r);
println!("car(r) = {}", CELL::car(r.clone()));
println!("cdr(r) = {}", CELL::cdr(r.clone()));
}
#Scalaの実装例
コンスセルはAny型のペア要素のタプルで定義．NULL相当のNoneは比較演算子の対象外のため，空リストは文字列"nil"を使用．コンスセルによるデータ構造の見やすさのため，S式出力s_stringを併せて作成．
listproc.scala
// Cons cells are created by using tuple.
// All of atoms are string and the null value is "nil".
def cons(x: Any, y: Any) = (x, y)
def car(s: Any) = s match { case (x, _) => x }
def cdr(s: Any) = s match { case (_, y) => y }
def eq_(s1: Any, s2: Any) = { s1 == s2 }
def atom(s: Any) = s match {
case _: String => true
case _: Boolean => true
case _ => false
}
// S-expreesion output: s_string
def s_strcons(s: Any): Any = {
val sa_r = s_string(car(s))
val sd = cdr(s)
if (eq_(sd, "nil")) {
sa_r
} else if (atom(sd)) {
sa_r + " . " + sd
} else {
sa_r + " " + s_strcons(sd)
}
}
def s_string(s: Any): Any =
if (eq_(s, "nil")) {
"()"
} else if (eq_(s, true)) {
"t"
} else if (eq_(s, false)) {
"nil"
} else if (atom(s)) {
s
} else {
"(" + s_strcons(s) + ")"
}
利用例は次の通り．Scala 2.11.12＋Java 11で確認．
def mkassoc(a: Any, b: Any): Any =
if (eq_(a, "nil") || eq_(b, "nil")) {
"nil"
} else {
cons(cons(car(a), car(b)), mkassoc(cdr(a), cdr(b)))
}
def assoc(k: Any, vs: Any): Any =
if (eq_(vs, "nil")) {
return "nil"
} else {
if (eq_(car(car(vs)), k)) {
return car(vs)
} else {
return assoc(k, cdr(vs))
}
}
$ scala -i listproc.scala
Welcome to Scala 2.11.12 (OpenJDK Server VM, Java 11.0.8).
Type in expressions for evaluation. Or try :help.
scala> val al_k = cons("hoge", cons("hage", cons("hige", "nil")))
al_k: (Any, Any) = (hoge,(hage,(hige,nil)))
scala> s_string(al_k)
res4: Any = (hoge hage hige)
scala> val al_v = cons("10", cons("20", cons("30", "nil")))
al_v: (Any, Any) = (10,(20,(30,nil)))
scala> s_string(al_v)
res5: Any = (10 20 30)
scala> val al = mkassoc(al_k, al_v)
al: Any = ((hoge,10),((hage,20),((hige,30),nil)))
scala> s_string(al)
res0: Any = ((hoge . 10) (hage . 20) (hige . 30))
scala> s_string(assoc("hage", al))
res1: Any = (hage . 20)
scala> s_string(car(assoc("hage", al)))
res2: Any = hage
scala> s_string(cdr(assoc("hage", al)))
res3: Any = 20
#R言語の実装例
コンスセルはペア要素のリストで定義．空リストはNULLを使用．コンスセルによるデータ構造の見やすさのため，S式出力s_stringを併せて作成．
listproc.r
# Cons cells are created by using list.
# All of atoms are string and the null value is NULL.
cons <- function(x, y) { list(x, y) }
car <- function(s) { s[[1]] }
cdr <- function(s) { s[[2]] }
eq <- function(s1, s2) {
if (is.null(s1) && is.null(s2)) { TRUE }
else if (is.character(s1) && is.character(s2)) { s1 == s2 }
else if (is.logical(s1) && is.logical(s2)) { s1 == s2 }
else { FALSE }
}
atom <- function(s) { is.character(s) || is.null(s) || is.logical(s) }
# S-expression output: s_string
s_strcons <- function(s) {
sa_r = s_string(car(s))
sd = cdr(s)
if (eq(sd, NULL)) {
sa_r
} else if (atom(sd)) {
paste(sa_r, " . ", sd, sep="")
} else {
paste(sa_r, " ", s_strcons(sd), sep="")
}
}
s_string <- function(s) {
if (eq(s, NULL)) {
"()"
} else if (eq(s, TRUE)) {
"t"
} else if (eq(s, FALSE)) {
"nil"
} else if (atom(s)) {
s
} else {
paste("(", s_strcons(s), ")", sep="")
}
}
利用例は次の通り．R 3.5.2で確認．
mkassoc <- function(a, b) {
if (eq(a, NULL) || eq(b, NULL)) {
NULL
} else {
cons(cons(car(a), car(b)), mkassoc(cdr(a), cdr(b)))
}
}
assoc <- function(k, vs) {
if (eq(vs, NULL)) {
NULL
} else {
if (eq(car(car(vs)), k)) {
car(vs)
} else {
assoc(k, cdr(vs))
}
}
}
$ R
（起動時のメッセージは省略）
> source("listproc.r")
> al_k = cons("hoge", cons("hage", cons("hige", NULL)))
> s_string(al_k)
[1] "(hoge hage hige)"
> al_v = cons("10", cons("20", cons("30", NULL)))
> s_string(al_v)
[1] "(10 20 30)"
> al = mkassoc(al_k, al_v)
> s_string(al)
[1] "((hoge . 10) (hage . 20) (hige . 30))"
> s_string(assoc("hage", al))
[1] "(hage . 20)"
> car(assoc("hage", al))
[1] "hage"
> cdr(assoc("hage", al))
[1] "20"
#Prologの実装例
LISPと全く同じリスト構造・操作が利用可能であるため，実装不要．利用例は次の通り．SWI-Prolog 8.0.2で確認．
% Cons cells are created by using conscell list.
% All of atoms are string and the null value is [].
%cons(X, Y, [X|Y]).
%car([X|_], X).
%cdr([_|X], X).
%eq(S, S) :- string(S).
%eq([], []) :- true.
%s_atom(X) :- string(X).
%s_atom([]).
mkassoc([], _, []) :- !.
mkassoc( _, [], []) :- !.
mkassoc([A1|A], [B1|B], [[A1|B1]|R]) :- mkassoc(A, B, R).
assoc(_, [], []) :- !.
assoc(K, [[K|V]|_], [K|V]) :- !.
assoc(K, [_|VS], R) :- assoc(K, VS, R).
run(KS, VS, K, R) :- mkassoc(KS, VS, AL), assoc(K, AL, R).
$ swipl -s listproc.swi
%（起動時のメッセージは省略）
?- run(["hoge","hage","hige"], ["10","20","30"], "hage", [X|Y]).
X = "hage",
Y = "20".
#Javaの実装例
コンスセルは，Object型のペアをフィールドとしてもつクラスpairとして定義し，car部とcdr部を返すメソッドを定義．基本5関数は，メインクラスlistprocのメソッドとして定義．空リストは文字列"nil"を使用．コンスセルによるデータ構造の見やすさのため，S式出力s_stringをメインクラスlistprocのメソッドとして併せて作成．
listproc.java
// Cons cells are created by class.
// All of atoms are string and the null value is "nil".
class pair {
private Object x, y;
public pair(Object car, Object cdr) {
x = car; y = cdr;
}
public Object car() { return x; }
public Object cdr() { return y; }
}
public class listproc {
private static Object cons(Object s1, Object s2) {
return new pair(s1, s2);
}
private static Object car(Object s) { return ((pair)s).car(); }
private static Object cdr(Object s) { return ((pair)s).cdr(); }
private static Boolean eq(Object s1, Object s2) {
if (s1 instanceof String && s2 instanceof String) {
return ((String)s1).equals((String)s2);
} else {
return false;
}
}
private static Boolean atom(Object s) { return (s instanceof String); }
private static Object s_strcons(Object s) {
Object sa_r = s_string(car(s));
Object sd = cdr(s);
if (eq(sd, "nil")) { return sa_r; }
else if (atom(sd)) {
return (String)sa_r + " . " + (String)sd;
} else {
return (String)sa_r + " " + (String)s_strcons(sd);
}
}
private static Object s_string(Object s) {
if (eq(s, "nil")) { return "()"; }
else if (atom(s)) { return s; }
else { return "(" + (String)s_strcons(s) + ")"; }
}
}
利用例は次の通り．Java 11.0.8で確認．main関数を含め，上記実装例のメインクラスlistprocのメソッドとして追加することを想定．
private static Object mkassoc(Object a, Object b) {
if (eq(a, "nil") || eq(b, "nil")) {
return (Object)"nil";
} else {
return cons(cons(car(a), car(b)), mkassoc(cdr(a), cdr(b)));
}
}
private static Object assoc(String k, Object vs) {
if (eq(vs, "nil")) { return (Object)"nil"; }
else if (eq(car(car(vs)), k)) {
return car(vs);
} else {
return assoc(k, cdr(vs));
}
}
public static void main(String[] args) {
Object al_k0 = cons("hige", "nil");
Object al_k1 = cons("hage", al_k0);
Object al_k = cons("hoge", al_k1);
System.out.printf("al_k = %s\n", s_string(al_k));
Object al_v0 = cons("30", "nil");
Object al_v1 = cons("20", al_v0);
Object al_v = cons("10", al_v1);
System.out.printf("al_v = %s\n", s_string(al_v));
Object al = mkassoc(al_k, al_v);
System.out.printf("al = (mkassoc al_k al_v) = %s\n", s_string(al));
Object r = assoc("hage", al);
System.out.printf("r = assoc(\"hage\", al) = %s\n", s_string(r));
System.out.printf("(car r) = %s\n", s_string(car(r)));
System.out.printf("(cdr r) = %s\n", s_string(cdr(r)));
}
$ javac listproc.java
$ java listproc
al_k = (hoge hage hige)
al_v = (10 20 30)
al = (mkassoc al_k al_v) = ((hoge . 10) (hage . 20) (hige . 30))
r = assoc("hage", al) = (hage . 20)
(car r) = hage
(cdr r) = 20
#C++17の実装例
コンスセルは，variantによる文字列・コンスセル双方を参照可能な構造体CELLのインスタンスをvectorのペアでもつ構造体CONSを定義して利用．基本5関数の他，文字列とCELLを相互変換する関数，空リストを示す文字列"nil"を生成する関数をユーティリティとして定義．更に，定義したコンスセルによるデータ構造の見やすさのため，S式出力s_displayを併せて作成．
listproc.cpp
// Cons cells are created by using struct, vector and variant.
// All of atoms are string and the null value is "nil".
#include <iostream>
#include <string> // for string
#include <functional> // for vector
#include <variant> // for variant
using namespace std;
struct CELL;
struct CONS {
vector<CELL> pair;
CONS() : pair(2) { }
};
struct CELL {
variant<string, CONS> node;
};
CELL cons(CELL x, CELL y)
{
CONS c; c.pair[0] = x; c.pair[1] = y;
CELL s; s.node = c;
return s;
}
CELL car(CELL x) { return get<1>(x.node).pair[0]; }
CELL cdr(CELL x) { return get<1>(x.node).pair[1]; }
bool atom(CELL s) { return s.node.index() == 0; }
bool eq(CELL x, CELL y) {
if (atom(x) && atom(y))
return get<0>(x.node) == get<0>(y.node);
else
return false;
}
string c2s(CELL s) { return get<0>(s.node); }
CELL s2c(string s) { CELL r; r.node = s; return r; }
CELL nil(void) { return s2c("nil"); }
void s_display(CELL s);
void s_strcons(CELL s) {
s_display(car(s));
CELL sd = cdr(s);
if (eq(sd, nil())) { cout << ""; }
else if (atom(sd)) { cout << " . " << c2s(sd); }
else { cout << " "; s_strcons(sd); }
}
void s_display(CELL s) {
if (eq(s, nil())) { cout << "()"; }
else if (atom(s)) { cout << c2s(s); }
else { cout << "("; s_strcons(s); cout << ")"; }
}
利用例は次の通り．GCC 8.3.0（--std=c++17オプション付き）で確認．
CELL mkassoc(CELL a, CELL b)
{
if (eq(a, nil()) || eq(b, nil())) {
return nil();
} else {
return cons(cons(car(a), car(b)), mkassoc(cdr(a), cdr(b)));
}
}
CELL assoc(string k, CELL vs) {
if (eq(vs, nil())) { return nil(); }
else if (eq(car(car(vs)), s2c(k))) { return car(vs); }
else { return assoc(k, cdr(vs)); }
}
int main(void) {
CELL al_k = cons(s2c("hoge"),
cons(s2c("hage"),
cons(s2c("hige"), nil())));
cout << "al_k = "; s_display(al_k); cout << "\n";
CELL al_v = cons(s2c("10"),
cons(s2c("20"),
cons(s2c("30"), nil())));
cout << "al_v = "; s_display(al_v); cout << "\n";
CELL al = mkassoc(al_k, al_v);
cout << "al = (mkassoc al_k al_v) = "; s_display(al); cout << "\n";
CELL r = assoc("hage", al);
cout << "r = (assoc \"hage\" al) = "; s_display(r); cout << "\n";
cout << "(car r) = "; s_display(car(r)); cout << "\n";
cout << "(cdr r) = "; s_display(cdr(r)); cout << "\n";
return (0);
}
$ c++ listproc.cpp --std=c++17
$ ./a.out
al_k = (hoge hage hige)
al_v = (10 20 30)
al = (mkassoc al_k al_v) = ((hoge . 10) (hage . 20) (hige . 30))
r = (assoc "hage" al) = (hage . 20)
(car r) = hage
(cdr r) = 20
#Perlの実装例
コンスセルは無名多次元配列で実装．空リストは文字列"nil"を設定（undefだと比較判定等で不便であるため）．また，文字列比較演算子として既にeqがあるため，今回の基本関数はeq_として定義．更に，無名多次元配列はそのままではprint等では表示できないため，s式出力s_stringを併せて作成．
listproc.pl
# Cons cells are created by using anonymous arrays.
# All of atoms are string and the null value is "nil".
sub cons { [$_[0], $_[1]]; }
sub car { my $r = $_[0]; $$r[0]; }
sub cdr { my $r = $_[0]; $$r[1]; }
sub atom { !(ref $_[0]); }
sub eq_ {
if (atom($_[0]) && atom($_[0])) {
$_[0] eq $_[1];
} else { 0; }
}
# S-expression output: s_string
sub s_strcons {
my $sa_r = s_string(car($_[0]));
my $sd = cdr($_[0]);
if (eq_($sd, "nil")) {
$sa_r;
} elsif (atom($sd)) {
$sa_r . " . " . $sd;
} else {
$sa_r . " " . s_strcons($sd);
}
}
sub s_string {
if (eq_($_[0], "nil")) {
"()";
} elsif (atom($_[0])) {
$_[0];
} else {
"(" . s_strcons($_[0]) . ")";
}
}
利用例は次の通り．Perl 5.28.1で確認．
sub mkassoc {
if (eq_($_[0], "nil") || eq_($_[1], "nil")) {
"nil";
} else {
cons(cons(car($_[0]), car($_[1])),
mkassoc(cdr($_[0]), cdr($_[1])));
}
}
sub assoc {
if (eq_($_[0], "nil")) {
"nil";
} elsif (eq_(car(car($_[1])), $_[0])) {
car($_[1]);
} else {
assoc($_[0], cdr($_[1]));
}
}
$al_k = cons("hoge", cons("hage", cons("hige", "nil")));
print "\$al_k = ", s_string($al_k), "\n";
$al_v = cons("10", cons("20", cons("30", "nil")));
print "\$al_v = ", s_string($al_v), "\n";
$al = mkassoc($al_k, $al_v);
print "\$al = ", s_string($al), "\n";
$r = assoc("hage", $al);
print "\$r = assoc(\"hage\", \$al) = ", s_string($r), "\n";
print "car(\$r) = ", s_string(car($r)), "\n";
print "cdr(\$r) = ", s_string(cdr($r)), "\n";
$ perl listproc.pl
$al_k = (hoge hage hige)
$al_v = (10 20 30)
$al = ((hoge . 10) (hage . 20) (hige . 30))
$r = assoc("hage", $al) = (hage . 20)
car($r) = hage
cdr($r) = 20
#シェルスクリプトの実装例
##テキストファイル版
- コンスセルはテキストファイルで実装．1行目をcar部，2行目をcdr部とする．
- 基本コマンド
conscarcdratomeqをシェルスクリプトとして作成． -
cons実行のたびに連番でXX.consというファイル名でコンスセルを作成． - 連番管理もテキストファイル
CONSNUMで行う． - car部やcdr部がコンスセルを示す場合は，
XX.consというファイル名をそのまま記述． -
carはコンスセルファイルの1行目をhead -1で，cdrは2行目をtail -1で返す． - 新規処理実行の前に
XX.consを削除し，CONSNUMも0で初期化する． - コンスセル構造をS式表示する
s_display（＋s_strcons）をシェルスクリプトとして作成．
cons
#!/bin/sh
CN=`cat CONSNUM`
CONS=$CN.cons
echo $1 > $CONS
echo $2 >> $CONS
echo $((CN+1)) > CONSNUM
echo $CONS
car
#!/bin/sh
head -1 $1
cdr
#!/bin/sh
tail -1 $1
atom
#!/bin/sh
if [ -e $1 ]; then
echo "nil"
else
echo "t"
fi
eq
#!/bin/sh
if [ `atom $1` = "nil" -o `atom $2` = "nil" ]; then
echo "nil"
elif [ $1 = $2 ]; then
echo "t"
else
echo "nil"
fi
s_strcons
#!/bin/sh
sa=`car $1`
s_display $sa
sd=`cdr $1`
if [ `eq $sd "nil"` = "t" ]; then
echo -n
elif [ `atom $sd` = "t" ]; then
echo -n " . "
echo -n $sd
else
echo -n " "
echo -n `s_strcons $sd`
fi
s_display
#!/bin/sh
if [ $1 = "nil" ]; then
echo -n "()"
elif [ `atom $1` = "t" ]; then
echo -n $1
else
echo -n "("
echo -n `s_strcons $1`
echo -n ")"
fi
利用例は次の通り．Ubuntu 18.04（dash 0.5.8）で確認．
example.sh
#!/bin/sh
PATH=$PATH:./
rm -f *.cons
echo 0 > CONSNUM
al_k2=`cons "hige" "nil"`
al_k1=`cons "hage" $al_k2`
al_k0=`cons "hoge" $al_k1`
echo -n "\$al_k = "
s_display $al_k0
echo
al_v2=`cons "30" "nil"`
al_v1=`cons "20" $al_v2`
al_v0=`cons "10" $al_v1`
echo -n "\$al_v = "
s_display $al_v0
echo
al=`mkassoc $al_k0 $al_v0`
echo -n "\$al = mkassoc \$al_k \$al_v = "
s_display $al
echo
r=`assoc "hage" $al`
echo -n "\$r = assoc \"hage\" \$al = "
s_display $r
echo
echo "car \$r = " `car $r`
echo "cdr \$r = " `cdr $r`
$ sh example.sh
$al_k = (hoge hage hige)
$al_v = (10 20 30)
$al = mkassoc $al_k $al_v = ((hoge . 10) (hage . 20) (hige . 30))
$r = assoc "hage" $al = (hage . 20)
car $r = hage
cdr $r = 20
##大域変数版
- コンスセルはCAR部・CDR部それぞれを格納する大域変数で実装．
- 変数名には，同じく大域変数の連番変数を付加，コンスセルを作成するたびにインクリメント．
-
CAR＋連番変数，CDR＋連番変数にそれぞれ値を格納するため，cons関数でevalを使用． -
cons関数では更に値として連番変数.consを生成，cons関数の戻り値とする． -
car関数，cdr関数でも，連番変数付与の大域変数から値を取り出すためevalを使用． -
atom関数では，引数の値が連番変数.consの形式だった場合はnilを返し，それ以外はtを返す． -
eq関数では，どちらの引数もアトム（文字列のみ）＆同一であればtを，それ以外はnilを返す． - コンスセル構造をS式表示する
s_display（＋s_strcons）を関数として作成． - 全ての関数の戻り値も大域変数を経由（サブシェル経由で大域変数修正が破棄されないようにするため）．
listproc.sh
#!/bin/sh
# Cons cells are created by using vars with numbers.
# All of atoms are string and the null value is "nil".
CNUM=0
cons () {
eval CAR$CNUM=$1
eval CDR$CNUM=$2
CONSR=${CNUM}.cons
CNUM=$((CNUM+1))
}
car () { eval CARR="\$CAR${1%%.*}"; }
cdr () { eval CDRR="\$CDR${1%%.*}"; }
atom () {
if [ ${1##*.} = cons ]; then
ATOMR=nil
else
ATOMR=t
fi
}
eq () {
atom $1 && eq_a1=ATOMR
atom $2 && eq_a2=ATOMR
if [ $eq_a1 = nil -o eq_a2 = nil ]; then
EQR=nil
elif [ $1 = $2 ]; then
EQR=t
else
EQR=nil
fi
}
# S-expression output: s_display
s_strcons () {
car $1 && s_display $CARR
cdr $1
eq $CDRR nil
if [ $EQR = t ]; then
echo -n
else
atom $CDRR
if [ $ATOMR = t ]; then
echo -n " . "$CDRR
else
echo -n " " && s_strcons $CDRR
fi
fi
}
s_display () {
eq $1 nil
if [ $EQR = t ]; then
echo -n "()"
else
atom $1
if [ $ATOMR = t ]; then
echo -n $1
else
echo -n "("
s_strcons $1
echo -n ")"
fi
fi
}
利用例は次の通り．Ubuntu 18.04（dash 0.5.8）で確認．
mkassoc () {
eq $1 nil && mka_e1=$EQR
eq $2 nil && mka_e2=$EQR
if [ $mka_e1 = t -o $mka_e2 = t ]; then
MKASSOCR=nil
else
cdr $1 && mka_d1=$CDRR
cdr $2 && mka_d2=$CDRR
mkassoc $mka_d1 $mka_d2
mka_r=$MKASSOCR
car $1 && mka_a1=$CARR
car $2 && mka_a2=$CARR
cons $mka_a1 $mka_a2
cons $CONSR $mka_r
MKASSOCR=$CONSR
fi
}
assoc () {
eq $2 nil
if [ $EQR = t ]; then
ASSOCR=nil
else
car $2 && car $CARR && eq $CARR $1
if [ $EQR = t ]; then
car $2 && ASSOCR=$CARR
else
cdr $2 && assoc $1 $CDRR
fi
fi
}
cons hige nil && al_k2=$CONSR
cons hage $al_k2 && al_k1=$CONSR
cons hoge $al_k1 && al_k=$CONSR
echo -n "\$al_k = " && s_display $al_k && echo
cons 30 nil && al_v2=$CONSR
cons 20 $al_v2 && al_v1=$CONSR
cons 10 $al_v1 && al_v=$CONSR
echo -n "\$al_v = " && s_display $al_v && echo
mkassoc $al_k $al_v && al=$MKASSOCR
echo -n "\$al = " && s_display $al && echo
assoc hage $al
r=$ASSOCR
echo -n "\$r = assoc hage \$al = " && s_display $r && echo
car $r && echo -n "car \$r = " && s_display $CARR && echo
cdr $r && echo -n "cdr \$r = " && s_display $CDRR && echo
$ sh listproc.sh
$al_k = (hoge hage hige)
$al_v = (10 20 30)
$al = ((hoge . 10) (hage . 20) (hige . 30))
$r = assoc hage $al = (hage . 20)
car $r = hage
cdr $r = 20
Luaの実装例
コンスセルは多次元配列で実装．空リストはnilを使用．また，そのままでは配列構造が確認できないため，S式出力s_stringも併せて定義．
listproc.lua
-- Cons cells are created by using Array.
-- All of atoms are string and the null value is nil.
function cons(x, y) return { x, y } end
function car(s) return s[1] end
function cdr(s) return s[2] end
function eq(s1, s2) return s1 == s2 end
function atom(s)
return type(s) == "string"
or type(s) == "nil"
or type(s) == "boolean"
end
-- S-expression output: s_string
function s_strcons(s)
sa_r = s_string(car(s))
sd = cdr(s)
if eq(sd, nil) then
return sa_r
elseif atom(sd) then
return sa_r.." . "..sd
else
return sa_r.." "..s_strcons(sd)
end
end
function s_string(s)
if eq(s, nil) then return "()"
elseif eq(s, true) then return "t"
elseif eq(s, false) then return "nil"
elseif atom(s) then return s
else return "("..s_strcons(s)..")"
end
end
利用例は次の通り．Lua 5.3.3で確認．
listproc.lua
function mkassoc(a, b)
if eq(a, nil) or eq(b, nil) then
return nil
else
return cons(cons(car(a), car(b)),
mkassoc(cdr(a), cdr(b)))
end
end
function assoc(k, vs)
if eq(vs, nil) then
return nil
else
if eq(car(car(vs)), k) then
return car(vs)
else
return assoc(k, cdr(vs))
end
end
end
$ lua -i listproc.lua
Lua 5.3.3 Copyright (C) 1994-2016 Lua.org, PUC-Rio
> al_k = cons("hoge", cons("hage", cons("hige", nil)))
> al_v = cons("10", cons("20", cons("30", nil)))
> s_string(al_k)
(hoge hage hige)
> s_string(al_v)
(10 20 30)
> al = mkassoc(al_k, al_v)
> s_string(al)
((hoge . 10) (hage . 20) (hige . 30))
> s_string(assoc("hage", al))
(hage . 20)
> s_string(car(assoc("hage", al)))
hage
> s_string(cdr(assoc("hage", al)))
20
Standard MLの実装例
コンスセルはdatatypeで定義．空リストはNONEを使用．また，そのままでは構成子の指定が残ったままの表示となり大変見にくいため，S式出力s_stringも併せて定義．
listproc.sml
(* Cons cells are created by using datatype. *)
(* All of atoms are string and the null value is NONE. *)
datatype CELL = NONE | Bool of bool | Sybl of string | Pair of CELL * CELL
fun cons (x : CELL) (y : CELL) = Pair (x, y);
fun car (Pair (a, _)) = a | car _ = NONE;
fun cdr (Pair (_, d)) = d | cdr _ = NONE;
fun eq (Sybl s1) (Sybl s2) = Bool (s1 = s2)
| eq NONE NONE = (Bool true) | eq _ _ = (Bool false);
fun atom (Sybl s) = (Bool true) | atom NONE = (Bool true)
| atom _ = (Bool false);
fun s_strcons x y =
case y of
NONE => s_string x
| (Sybl y) => (s_string x) ^ " . " ^ y
| (Pair (a, d)) => (s_string x) ^ " " ^ (s_strcons a d)
| _ => ""
and s_string x =
case x of
NONE => "()"
| (Bool x) => if x then "t" else "nil"
| (Sybl x) => x
| (Pair (a, d)) => "(" ^ (s_strcons a d) ^ ")";
利用例は次の通り．Moscow ML 2.10，SML/NJ v110.79で確認（実行例はMoscow ML）．
listproc.sml
fun mkassoc NONE _ = NONE
| mkassoc _ NONE = NONE
| mkassoc a b = (cons (cons (car a) (car b))
(mkassoc (cdr a) (cdr b)));
fun assoc _ NONE = NONE
| assoc k vs =
case (eq (car (car vs)) k) of
(Bool true) => (car vs)
| (Bool false) => (assoc k (cdr vs))
| _ => NONE
$ mosml listproc.sml
Moscow ML version 2.10
Enter `quit();' to quit.
[opening file "listproc.sml"]
（読み込み時の表示は省略）
- val al_k = (cons (Sybl "hoge") (cons (Sybl "hage") (cons (Sybl "hige") NONE)));
> val al_k = Pair(Sybl "hoge", Pair(Sybl "hage", Pair(Sybl "hige", NONE))) : CELL
- val al_v = (cons (Sybl "10") (cons (Sybl "20") (cons (Sybl "30") NONE)));
> val al_v = Pair(Sybl "10", Pair(Sybl "20", Pair(Sybl "30", NONE))) : CELL
- s_string al_k;
> val it = "(hoge hage hige)" : string
- s_string al_v;
> val it = "(10 20 30)" : string
- val al = mkassoc al_k al_v;
> val al =
Pair(Pair(Sybl "hoge", Sybl "10"),
Pair(Pair(Sybl "hage", Sybl "20"),
Pair(Pair(Sybl "hige", Sybl "30"), NONE))) : CELL
- s_string al;
> val it = "((hoge . 10) (hage . 20) (hige . 30))" : string
- s_string (assoc (Sybl "hage") al);
> val it = "(hage . 20)" : string
- s_string (car (assoc (Sybl "hage") al));
> val it = "hage" : string
- s_string (cdr (assoc (Sybl "hage") al));
> val it = "20" : string
Clojureの実装例
ClojureはS式を採用しているLISP系言語ですが，リスト構造がコンスセルに対応していないため，要素がふたつのリスト構造をコンスセルとして定義し直し，ドット対対応のS式出力s_outputを併せて定義．
listproc.clojure
;;;; Cons cells are created by using list.
;;;; All of atoms are symbol and the null value is nil.
(defn cons_ [x y] (list x y))
(defn car_ [x] (first x))
(defn cdr_ [x] (second x))
(defn eq_ [s1 s2] (= s1 s2))
(defn atom_ [x] (not (seq? x)))
;;;; S-expression output: s_output
(declare s_output)
(defn s_strcons [s]
(let [sa_r (s_output (car_ s)) sd (cdr_ s)]
(cond (eq_ sd nil) (cons sa_r nil)
(atom_ sd) (cons sa_r (cons '. (cons sd nil)))
:else (cons sa_r (s_strcons sd)))))
(defn s_output [s]
(cond (eq_ s nil) '()
(eq_ s true) 't
(eq_ s false) 'nil
(atom_ s) s
:else (s_strcons s)))
利用例は次の通り．Clojure 1.10.0で確認．
listproc.clojure
(defn s_mkassoc [a b]
(if (or (eq_ a nil) (eq_ b nil)) nil
(cons_ (cons_ (car_ a) (car_ b))
(s_mkassoc (cdr_ a) (cdr_ b)))))
(defn s_assoc [k vs]
(if (eq_ vs nil) nil
(if (eq_ (car_ (car_ vs)) k)
(car_ vs)
(s_assoc k (cdr_ vs)))))
$ clojure
Clojure 1.10.0
user=> (load-file "listproc.clojure")
#'user/s_assoc
user=> (def al_k (cons_ 'hoge (cons_ 'hage (cons_ 'hige nil))))
#'user/al_k
user=> (s_output al_k)
(hoge hage hige)
user=> (def al_v (cons_ 10 (cons_ 20 (cons_ 30 nil))))
#'user/al_v
user=> (s_output al_v)
(10 20 30)
user=> (def al (s_mkassoc al_k al_v))
#'user/al
user=> (s_output al)
((hoge . 10) (hage . 20) (hige . 30))
user=> (def r (s_assoc 'hage al))
#'user/r
user=> (s_output r)
(hage . 20)
user=> (s_output (car_ r))
hage
user=> (s_output (cdr_ r))
20
Excel（2021-06-25時点ベータ版）の実装例
コンスセルはLAMBDA式のクロージャで実現．既存類似関数名と区別するため，S_CONS S_CAR S_CDR S_EQ S_ATOMの名前で関数登録．空リストは""を使用．
数式の名前管理にて関数登録
S_CONS
=LAMBDA(x,y, LAMBDA(f, f(x, y)))
S_CAR
=LAMBDA(c, c(LAMBDA(x,y, x)))
S_CDR
=LAMBDA(c, c(LAMBDA(x,y, y)))
S_ATOM
=LAMBDA(s, OR(ISTEXT(s), ISNUMBER(s)))
S_EQ
=LAMBDA(x,y, IF(AND(S_ATOM(x), S_ATOM(y)), x=y, FALSE))
利用例は次の通り．2021-06-25時点ベータチャネルのバージョン2107で確認．
数式の名前管理にて関数登録
S_MKASSOC
=LAMBDA(a,b,
IF(OR(S_EQ(a, ""), S_EQ(b, "")), "",
S_CONS(S_CONS(S_CAR(a), S_CAR(b)),
S_MKASSOC(S_CDR(a), S_CDR(b)))))
S_ASSOC
=LAMBDA(k,vs,
IF(S_EQ(vs, ""), "",
IF(S_EQ(S_CAR(S_CAR(vs)), k), S_CAR(vs),
S_ASSOC(k, S_CDR(vs)))))
al_k
=S_CONS("hoge", S_CONS("hage", S_CONS("hige", "")))
al_v
=S_CONS("10", S_CONS("20", S_CONS("30", "")))
al
=S_MKASSOC(al_k, al_v)
各セルに入力
セルB1:（キーワード逐次入力）
セルB2：=S_CAR(S_ASSOC(B1, al))
セルB2：=S_CDR(S_ASSOC(B1, al))
コンスセルとcar/cdr/cons/eq/atomの実装完了．コンスセルは #クロージャ で実現．あらためて #ラムダ式 万能説．#LISP #Excel #lambda #programming #プログラミング pic.twitter.com/M3joGvuxQ7
— 滝沢陽三 / TAKIZAWA Yozo (@ytaki0801) June 25, 2021
#備考
##記事に関する補足
- 参照用を想定していることもあり，エラーチェックもモジュール化もガーベジコレクションもなにそれおいしいの状態．実用のS式パーサとかは既にたくさんあるしなあ．
-
現バージョンのlistだと，Common Lisp版を含めて『リストのリスト』が作れない…cons使えばいっか（いいかげん）．listなくしてconsによるリスト作成例に変更． - そして，純LISP的にはむしろ
eqだろということでそちらを追加．うむ． - 型定義が必要な言語の実装例で，
CELLとNODE，CONSとPAIRが混在しているのは整理が必要かな．CELLとCONSは型，NODEとPAIRは構成要素を示すものとして統一した方が良さそう．
##変更履歴
- 2021-06-25：Excel（2021-06-25時点ベータ版）の実装例を追加
- 2020-12-15：Clojureの実装例を追加
- 2020-12-02：Standard MLの実装例を追加
- 2020-11-09：Luaの実装例を追加
- 2020-10-17：『UNIXシェル』を『シェルスクリプト』に変更し，大域変数版を追加．
- 2020-10-14：UNIXシェルの実装例を追加
- 2020-10-12：Perlの実装例を追加
- 2020-10-08：C++17の実装例を追加
- 2020-10-07：Javaの実装例を追加
- 2020-10-05：Prologの利用例を追加
- 2020-10-02：Rustのコピーセマンティクス版を追加
- 2020-09-26：R言語の実装例を追加
- 2020-09-25：Scalaの実装例を追加
- 2020-09-25：Rustの実装例を追加
- 2020-09-25：クラス定義版のPython実装例を追加
- 2020-09-21：PHPの実装例を追加
- 2020-09-19：Juliaの実装例を追加
- 2020-09-19：Go言語の実装例を追加
- 2020-09-19：仕様欄に実装上のポイントを追記
- 2020-09-19：『ドット対』ではなく『コンスセル』に呼称変更（S式処理ではないため）
- 2020-09-13：Haskellの実装例を追加
- 2020-09-11：JavaScriptの実装例について，
eqの定義で==ではなく===を使用（別記事コメントより） - 2020-09-10：C言語の実装例について，64ビット仕様の場合を注記
- 2020-09-05：真偽値もアトムと判断するよう修正
- 2020-09-03：
list定義削除，eq実装例追加，利用例のリスト作成をconsのみに変更． - 2020-09-03：PythonのS式入出力記述例を削除（趣旨を変更して別記事に移動）
- 2020-09-01：PythonのS式入出力記述例の一部を修正
- 2020-08-31：JavaScriptの実装例を追加
- 2020-08-30：利用例を連想リスト実装に統一
- 2020-08-30：Rubyの実装例を追加
- 2020-08-30：初版公開（Python，C，Common Lisp）