リスト処理関数（cons,car,cdr,eq,atom）実装例まとめ

【追記】簡易LISP処理系の各プログラミング言語実装例の記事作成に伴い，『7行インタプリタ実装まとめ』は更新無期延期としました．

拙作記事『7行インタプリタ実装まとめ』について，そろそろSchemeとPython以外にも対応しないとなあと思っていろいろ整理した結果，『S式入力の実装部分がほとんどじゃないこれ？』→『あと，リスト処理内容に基準を設けてないと言語ごとに実装方針がバラバラになりそう』となり，とりあえず『cons car cdr eq atomが使える』ようにする記述例を先にまとめていくことにした次第．ホスト言語上での純LISP機能実装に近いとでもいいますか．

仕様

• コンスセル（cons cells）を定義
• アトムは全て文字列．空リストは各言語のNULL相当を使用，もしくは，独自定義
• cons car cdrを実装
• アトム同士が等しいかを判定する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__を定義
• car cdrはクラスCELLのメソッドとして定義
• eq相当はCELL CONS双方で==の比較が可能となるよう記述
• atomはCELL CONS双方のメソッドとして定義

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で構成された構造体として定義．
• car cdrは単独実装せず，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部とする．
• 基本コマンドcons car cdr atom eqをシェルスクリプトとして作成．
• 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）