10行LISP評価器の実装例（各言語まとめ）
132329 ワード
筆者いつもの各言語お遊び記事です．【関連記事】その1，その2，その3
目的
（表）様々なプログラミング言語によるラムダ式（静的スコープ）実装のリファレンスとするため．
（裏）ラムダ式プログラミングを実装レベルで布教するため．難解プログラミングじゃないやい．
【参考】ラムダ式プログラミング一時間体験講座（Python/Ruby/JavaScript同時並行版）
LISP評価器の仕様
- 基本構文：
lambda，if．Lisp-1のレキシカルスコープ．シンボルとして文字列を使用．
- 基本関数：
=，+，-．値として整数が利用可能．
- 実行コードはJSONの配列構造．カレントディレクトリの
sample.jsonから読み込み．
- 評価器本体で10行程度（1行80字以下目安，基本関数適用やユーティリティ関数定義は除く）．
lambda，if．Lisp-1のレキシカルスコープ．シンボルとして文字列を使用．=，+，-．値として整数が利用可能．sample.jsonから読み込み．実行コードは基本的にS式表現と同じであり，構文・関数名と共にSchemeのサブセット仕様となります．
実行コードサンプル
※21番目のフィボナッチ数を求める再帰処理です（Uコンビネータ使用）．
fib21.json
[[["lambda",["u"],["u","u"]],
["lambda",["u"],
["lambda",["n","a","b"],
["if",["=","n",0],"a",
[["u","u"],["-","n",1],"b",["+","a","b"]]]]]],
21,0,1]
評価器の大まかな流れ
$ev$：評価器関数名，$s$：実行コード（リスト構造），$e$：環境（初期値は空リスト），$g$：大域環境
$pm(k, v)$：文字列リストと値リストからの環境生成，$ap(x, y)$：$x$を優先検索とする環境合成
- $ev(s,e)=$
- $s$が文字列ならば，$ap(e,g)$から$s$に対応する値を返す．
- $s$が整数ならば，$s$をそのまま返す．
- $s_1$が
ifならば，$ev(s_2,e)$が真の時$ev(s_3,e)$を返し偽の時$ev(s_4,e)$を返す． - $s_1$が
lambdaならば，$e$をラムダ式評価時の環境として追加した$[s_1,s_2,s_3,e]$を返す． - 上記以外は関数適用とみなし，$f=ev(s_1,e)$，$a=[ev(s_2,e),ev(s_3,e)...]$とする．
- もし$f$が文字列（基本関数名）ならば，$a$を$f$の引数として実行した結果を返す．
- 上記以外はラムダ式適用とみなし，$ev(f_3,ap(pm(f_2,a),f_4))$を返す．
実装例
Scheme（SRFI-180/Gauche使用）
ev10.scm
#!/usr/bin/env gosh
(define (pm k v) (map cons (vector->list k) (vector->list v)))
(define (L1 s) (vector-ref s 0))
(define (L2 s) (vector-ref s 1))
(define (L3 s) (vector-ref s 2))
(define (L4 s) (vector-ref s 3))
(define (LN s) (vector-copy s 1))
(define (ea a e) (vector-map (lambda (x) (ev x e)) a))
(define g `(("=" . ,=) ("+" . ,+) ("-" . ,-)))
(define (ev s e)
(cond ((string? s) (cdr (assoc s (append e g))))
((integer? s) s)
((equal? (L1 s) "if") (if (ev (L2 s) e) (ev (L3 s) e) (ev (L4 s) e)))
((equal? (L1 s) "lambda") (vector-append s (list->vector `(,e))))
(else (let ((f (ev (L1 s) e)) (a (ea (LN s) e)))
(if (vector? f) (ev (L3 f) (append (pm (L2 f) a) (L4 f)))
(apply f (vector->list a)))))))
(use srfi.180)
(display (ev (call-with-input-file "sample.json" json-read) '()))
(newline)
Gauche0.9.10で確認
$ chmod 755 ev10.scm
$ ./ev10.scm
10946
Python 3
ev10.py
g = {'=': lambda x,y: x == y, '+': lambda x,y: x + y, '-': lambda x,y: x - y}
def ev(s, e):
if isinstance(s, str): return {**e, **g}[s]
elif isinstance(s, int): return s
elif s[0] == 'if': return ev(s[2], e) if ev(s[1], e) else ev(s[3], e)
elif s[0] == 'lambda': return s + [e]
else:
f = ev(s[0], e); a = [ev(x, e) for x in s[1:]]
if callable(f): return f(*a)
else: return ev(f[2], {**f[3], **dict(zip(f[1], a))})
import sys
sys.setrecursionlimit(10 ** 5)
print(ev(eval(''.join(list(open('sample.json')))), {}))
3.7.3で確認
$ python3 ev10.py
10946
Ruby
ev10.rb
$g = {"=" => ->x,y{x===y}, "+" => ->x,y{x+y}, "-" => ->x,y{x-y}}
def ev(s, e)
return e.merge($g)[s] if s.is_a?(String)
return s if s.is_a?(Integer)
return (ev(s[1], e) ? ev(s[2], e) : ev(s[3], e)) if s[0] == "if"
return s + [e] if s[0] == "lambda"
f = ev(s[0], e); a = s.slice(1..-1).map{|x|ev(x, e)}
return f[*a] if f.is_a?(Proc)
ev(f[2], f[3].merge(Hash[[f[1], a].transpose]))
end
p ev(eval(IO.read("sample.json")), {})
2.5.5で確認
$ ruby ev10.rb
10946
JavaScript
ev10.js
g = {'=': (x, y) => x === y, '+': (x, y) => x + y, '-': (x, y) => x - y};
function ev(s, e) {
if (typeof s == 'string') { var r = {...e, ...g}; return r[s]; }
else if (Number.isInteger(s)) return s;
else if (s[0] == 'if') return ev(s[1], e) ? ev(s[2], e) : ev(s[3], e);
else if (s[0] == 'lambda') return s.concat([e]);
else { var f = ev(s[0], e); var a = s.slice(1).map((x)=>ev(x, e));
if (typeof f == 'function') return f(...a);
else { var r = {}, d = {}; Object.assign(d, f[3]);
for (let i = 0; i < f[1].length; i++) r[f[1][i]] = a[i];
return ev(f[2], Object.assign(d, r)); } } }
const fs = require('fs');
console.log(ev(eval(fs.readFileSync('sample.json', 'utf8')), {}));
Node.js10.24で確認
$ node ev10.js
10946
Prolog
ev10.swi
ev(_,S,S) :- integer(S) ; S="=" ; S="+" ; S="-", !.
ev(E,S,R) :- string(S), av(S,E,R), !.
ev(E,["if",C,T,F],R) :- ev(E,C,true), ev(E,T,R) ; ev(E,F,R), !.
ev(E,S,R) :- S = ["lambda"|_], append(S,[E],R), !.
ev(E,[X|Y],R) :- ev(E,X,F), maplist(ev(E),Y,A), ef(F,A,R).
ef(F,A,R) :- ay(F,A,R) ; F = [_,V,B,L], mk(V,A,O), append(O,L,E), ev(E,B,R).
mk(A,B,R) :- assert(pr(X,Y,[X|Y])), maplist(pr,A,B,R).
av(K,V,R) :- V=[], R=false ; V=[[K|R]|_] ; V=[_|W], av(K,W,R).
ay(O,[X,Y],R) :- O="=", X=Y, R = true ; O="+", R is X+Y ; O="-", R is X-Y, !.
:- use_module([library(http/json)]).
:- open("sample.json",read,S,[]), json_read_dict(S,D,[]),
ev([],D,R), write(R), nl.
:- halt.
SWI-Prolog7.6.4で確認
$ swipl -s ev10.swi
10946
C（parson使用）
ev10.c
#include <stdio.h>
#include "parson.h"
#define ARRAY(s) (json_type(s) == JSONArray)
#define STRING(s) (json_type(s) == JSONString)
#define NUMBER(s) (json_type(s) == JSONNumber)
#define NULLP(s) (json_array_get_count(json_array(s)) == 0)
#define ATOMP(s) (!ARRAY(s) || NULLP(s))
#define TRUE (json_parse_string("\"#t\""))
#define FALSE (json_parse_string("\"#f\""))
#define JNULL (json_parse_string("[]"))
#define IF (json_parse_string("\"if\""))
#define LAMBDA (json_parse_string("\"lambda\""))
#define EQV (json_parse_string("\"=\""))
#define ADD (json_parse_string("\"+\""))
#define SUB (json_parse_string("\"-\""))
#define GE (json_parse_string("[\"=\",\"=\",\"+\",\"+\",\"-\",\"-\"]"))
JSON_Value *LI(JSON_Value *s, int i)
{
return json_array_get_value(json_array(s), i);
}
#define L1(s) (LI(s, 0))
#define L2(s) (LI(s, 1))
#define L3(s) (LI(s, 2))
#define L4(s) (LI(s, 3))
JSON_Value *LN(JSON_Value *s)
{
JSON_Array *d = json_array(json_value_deep_copy(s));
json_array_remove(d, 0);
return json_array_get_wrapping_value(d);
}
JSON_Value *LL(JSON_Value *a, JSON_Value *d)
{
JSON_Array *r = json_array(JNULL);
json_array_append_value(r, json_value_deep_copy(a));
JSON_Value *d1;
for (int i = 0; i < json_array_get_count(json_array(d)); i++) {
d1 = json_value_deep_copy(json_array_get_value(json_array(d), i));
json_array_append_value(r, d1);
}
return json_array_get_wrapping_value(r);
}
int eq(JSON_Value *a, JSON_Value *b)
{
if(ATOMP(a) && ATOMP(b)) return json_value_equals(a,b); else return 0;
}
JSON_Value *ap(JSON_Value *a, JSON_Value *b)
{
JSON_Array *r = json_array(json_value_deep_copy(a));
JSON_Value *b1;
for (int i = 0; i < json_array_get_count(json_array(b)); i++) {
b1 = json_value_deep_copy(json_array_get_value(json_array(b), i));
json_array_append_value(r, b1);
}
return json_array_get_wrapping_value(r);
}
JSON_Value *pm(JSON_Value *a, JSON_Value *b)
{
if (NULLP(a)) return JNULL; else if (NULLP(b)) return JNULL;
else return LL(L1(a), LL(L1(b), pm(LN(a), LN(b))));
}
JSON_Value *pq(JSON_Value *k, JSON_Value *v)
{
if (NULLP(v)) return JNULL; else if (eq(k, L1(v))) return L2(v);
else return pq(k, LN(LN(v)));
}
JSON_Value *ay(JSON_Value *f, JSON_Value *a)
{
double x = json_number(L1(a)), y = json_number(L2(a));
if (eq(f, EQV)) { if (x == y) return TRUE; else FALSE; }
else if (eq(f, ADD)) return json_value_init_number(x + y);
else if (eq(f, SUB)) return json_value_init_number(x - y);
else return FALSE;
}
JSON_Value *ev(JSON_Value *s, JSON_Value *e);
JSON_Value *ea(JSON_Value *a, JSON_Value *e)
{
if (NULLP(a)) return JNULL; else return LL(ev(L1(a),e), ea(LN(a),e));
}
JSON_Value *ev(JSON_Value *s, JSON_Value *e)
{
if (STRING(s)) return pq(s, ap(e, GE));
else if (NUMBER(s)) return s;
else if (eq(L1(s), IF))
if (eq(ev(L2(s), e), TRUE)) return ev(L3(s), e); else return ev(L4(s), e);
else if (eq(L1(s), LAMBDA)) return ap(s, LL(e, JNULL));
else {
JSON_Value *f = ev(L1(s), e), *a = ea(LN(s), e);
if (STRING(f)) return ay(f, a);
else return ev(L3(f), ap(pm(L2(f), a), L4(f)));
}
}
int main(void) {
JSON_Value *r = ev(json_parse_file("./sample.json"), JNULL);
printf("%s\n", json_serialize_to_string(r));
return (0);
}
TinyCC0.9.27で確認
C:\Users\TAKIZAWA Yozo\ev10>dir
ドライブ C のボリューム ラベルがありません。
ボリューム シリアル番号は 9402-DDE1 です
C:\Users\TAKIZAWA Yozo\ev10 のディレクトリ
2021/07/26 05:01 <DIR> .
2021/07/26 05:01 <DIR> ..
2021/07/26 04:51 3,186 ev10.c
2021/07/26 04:51 74,217 parson.c
2021/07/26 04:51 13,270 parson.h
2021/07/26 04:53 176 sample.json
4 個のファイル 90,849 バイト
2 個のディレクトリ 215,663,902,720 バイトの空き領域
C:\Users\TAKIZAWA Yozo\ev10>tcc ev10.c parson.c
C:\Users\TAKIZAWA Yozo\ev10>ev10
10946
C:\Users\TAKIZAWA Yozo\ev10>
Go
ev10.go
package main
import (
"encoding/json"
"fmt"
"io/ioutil"
"reflect"
)
type JExp interface{}
var JNull = []interface{}{}
func ap(a, b JExp) JExp {
return append(append(JNull, a.([]interface{})...), b.([]interface{})...)
}
func L1(s JExp) JExp { return s.([]interface{})[0] }
func L2(s JExp) JExp { return s.([]interface{})[1] }
func L3(s JExp) JExp { return s.([]interface{})[2] }
func L4(s JExp) JExp { return s.([]interface{})[3] }
func LN(s JExp) JExp { return s.([]interface{})[1:] }
func LL(a, d JExp) JExp { return ap(append(JNull, a), d) }
func pm(k, v JExp) JExp {
r := JNull
for i := 0; i < len(k.([]interface{})); i++ {
r = append(r, k.([]interface{})[i])
r = append(r, v.([]interface{})[i])
}
return r
}
func pq(k string, p JExp) JExp {
r := p.([]interface{})
for len(r) < 0 || k != r[0].(string) { r = r[2:] }
if k == r[0].(string) { return r[1] } else { return false }
}
func ay(f, a JExp) JExp {
x := L1(a).(int); y := L2(a).(int)
switch f {
case "=": return x == y
case "+": return x + y
case "-": return x - y
default: return false
}
}
func ea(a, e JExp) JExp {
r := JNull; as := a.([]interface{})
for i := 0; i < len(as); i++ { r = append(r, ev(as[i], e)) }
return r
}
func strp(s JExp) bool { return reflect.ValueOf(s).Kind() == reflect.String }
func f64p(s JExp) bool { return reflect.ValueOf(s).Kind() == reflect.Float64 }
func str(s JExp) string { return s.(string) }
func i64(s JExp) int { return int(s.(float64)) }
func streq(s JExp, t string) bool {
if strp(s) && str(s) == t { return true } else { return false }
}
var g = []interface{}{"=","=", "+","+", "-","-"}
func ev(s, e JExp) JExp {
if strp(s) { return pq(str(s), ap(e, g)) } else
if f64p(s) { return i64(s) } else
if streq(L1(s), "if") { if ev(L2(s), e).(bool) {
return ev(L3(s), e) } else { return ev(L4(s), e) } } else
if streq(L1(s), "lambda") { return ap(s, LL(e, JNull)) } else
{ f := ev(L1(s), e); a := ea(LN(s), e);
if strp(f) { return ay(str(f), a) } else
{ return ev(L3(f), ap(pm(L2(f), a), L4(f))) }
}
}
func main() {
f, _ := ioutil.ReadFile("sample.json")
var s JExp
json.Unmarshal([]byte(f), &s)
fmt.Println(ev(s, JNull))
}
1.11.6で確認
$ go run ev10.go
10946
Julia
ev10.jl
g = Dict("="=>==, "+"=>+, "-"=>-)
function ev(s, e)
s isa String && return merge(g, e)[s]
s isa Int && return s
s[1] == "if" && return ev(s[2], e) ? ev(s[3], e) : ev(s[4], e)
s[1] == "lambda" && return vcat(s, [e])
f, a = ev(s[1], e), ev.(s[2:end], Ref(e))
f isa Function && return f(a...)
return ev(f[3], merge(f[4], Dict(zip(f[2], a))))
end
print(ev(include("sample.json"), Dict()), "\n")
1.5.2で確認
$ julia ev10.jl
10946
Lua 5.3 (cjson使用)
ev10.lua
function pm(k, v)
local r = {}
for i = 1, #k do r[k[i]] = v[i] end
return r
end
function ap(x, y)
local r = {}
for k, v in pairs(y) do r[k] = v end
for k, v in pairs(x) do r[k] = v end
return r
end
function ea(a, e)
local r = {}
for i = 2, #a do r[i - 1] = ev(a[i], e) end
return r
end
function ay(f, a)
if f == "=" then return a[1] == a[2]
elseif f == "+" then return a[1] + a[2]
elseif f == "-" then return a[1] - a[2]
else return nil
end
end
g = {}; g["="]="="; g["+"]="+"; g["-"]="-"
function ev(s, e)
if type(s) == "string" then return ap(e, g)[s]
elseif type(s) == "number" then return math.tointeger(s)
elseif s[1] == "if" then return ev(s[2], e) and ev(s[3], e) or ev(s[4], e)
elseif s[1] == "lambda" then r = ap(s, {}); r[4] = e; return r
else
local f = ev(s[1], e); local a = ea(s, e)
if type(f) == "string" then return ay(f, a)
else return ev(f[3], ap(pm(f[2], a), f[4]))
end
end
end
f = io.open("sample.json", "r")
s = ""; for s1 in f:lines() do s = s .. s1 end
f:close()
json = require 'cjson'
print(ev(json.decode(s), {}))
5.3.3で確認
$ lua ev10.lua
10946
Common Lisp（CL-JSON/roswell使用）
ev10.lisp
(defparameter g '(("=" . =) ("+" . +) ("-" . -)))
(defun ev (s e)
(cond ((stringp s) (cdr (assoc s (append e g) :test #'equal)))
((integerp s) s)
((equal (car s) "if") (if (ev (cadr s) e) (ev (caddr s) e) (ev (cadddr s) e)))
((equal (car s) "lambda") (append s `(,e)))
(t (let ((f (ev (car s) e)) (a (mapcar (lambda (x) (ev x e)) (cdr s))))
(if (listp f) (ev (caddr f) (append (mapcar 'cons (cadr f) a) (cadddr f)))
(apply f a))))))
(defparameter s "")
(with-open-file (j "sample.json")
(loop (let ((l (read-line j nil)))
(if (not l) (return)
(setf s (concatenate 'string s l))))))
(ql:quickload :cl-json :silent t)
(princ (ev (json:decode-json-from-string s) '()))
(terpri)
SBCL1.4.16/roswell21.06.14.110で確認
$ ros -l ev10.lisp
10946
その他の実行コードサンプル
アッカーマン関数：Ack(3, 7)
ev10.scm
#!/usr/bin/env gosh
(define (pm k v) (map cons (vector->list k) (vector->list v)))
(define (L1 s) (vector-ref s 0))
(define (L2 s) (vector-ref s 1))
(define (L3 s) (vector-ref s 2))
(define (L4 s) (vector-ref s 3))
(define (LN s) (vector-copy s 1))
(define (ea a e) (vector-map (lambda (x) (ev x e)) a))
(define g `(("=" . ,=) ("+" . ,+) ("-" . ,-)))
(define (ev s e)
(cond ((string? s) (cdr (assoc s (append e g))))
((integer? s) s)
((equal? (L1 s) "if") (if (ev (L2 s) e) (ev (L3 s) e) (ev (L4 s) e)))
((equal? (L1 s) "lambda") (vector-append s (list->vector `(,e))))
(else (let ((f (ev (L1 s) e)) (a (ea (LN s) e)))
(if (vector? f) (ev (L3 f) (append (pm (L2 f) a) (L4 f)))
(apply f (vector->list a)))))))
(use srfi.180)
(display (ev (call-with-input-file "sample.json" json-read) '()))
(newline)
Gauche0.9.10で確認
$ chmod 755 ev10.scm
$ ./ev10.scm
10946
ev10.py
g = {'=': lambda x,y: x == y, '+': lambda x,y: x + y, '-': lambda x,y: x - y}
def ev(s, e):
if isinstance(s, str): return {**e, **g}[s]
elif isinstance(s, int): return s
elif s[0] == 'if': return ev(s[2], e) if ev(s[1], e) else ev(s[3], e)
elif s[0] == 'lambda': return s + [e]
else:
f = ev(s[0], e); a = [ev(x, e) for x in s[1:]]
if callable(f): return f(*a)
else: return ev(f[2], {**f[3], **dict(zip(f[1], a))})
import sys
sys.setrecursionlimit(10 ** 5)
print(ev(eval(''.join(list(open('sample.json')))), {}))
3.7.3で確認
$ python3 ev10.py
10946
ev10.rb
$g = {"=" => ->x,y{x===y}, "+" => ->x,y{x+y}, "-" => ->x,y{x-y}}
def ev(s, e)
return e.merge($g)[s] if s.is_a?(String)
return s if s.is_a?(Integer)
return (ev(s[1], e) ? ev(s[2], e) : ev(s[3], e)) if s[0] == "if"
return s + [e] if s[0] == "lambda"
f = ev(s[0], e); a = s.slice(1..-1).map{|x|ev(x, e)}
return f[*a] if f.is_a?(Proc)
ev(f[2], f[3].merge(Hash[[f[1], a].transpose]))
end
p ev(eval(IO.read("sample.json")), {})
2.5.5で確認
$ ruby ev10.rb
10946
ev10.js
g = {'=': (x, y) => x === y, '+': (x, y) => x + y, '-': (x, y) => x - y};
function ev(s, e) {
if (typeof s == 'string') { var r = {...e, ...g}; return r[s]; }
else if (Number.isInteger(s)) return s;
else if (s[0] == 'if') return ev(s[1], e) ? ev(s[2], e) : ev(s[3], e);
else if (s[0] == 'lambda') return s.concat([e]);
else { var f = ev(s[0], e); var a = s.slice(1).map((x)=>ev(x, e));
if (typeof f == 'function') return f(...a);
else { var r = {}, d = {}; Object.assign(d, f[3]);
for (let i = 0; i < f[1].length; i++) r[f[1][i]] = a[i];
return ev(f[2], Object.assign(d, r)); } } }
const fs = require('fs');
console.log(ev(eval(fs.readFileSync('sample.json', 'utf8')), {}));
Node.js10.24で確認
$ node ev10.js
10946
ev10.swi
ev(_,S,S) :- integer(S) ; S="=" ; S="+" ; S="-", !.
ev(E,S,R) :- string(S), av(S,E,R), !.
ev(E,["if",C,T,F],R) :- ev(E,C,true), ev(E,T,R) ; ev(E,F,R), !.
ev(E,S,R) :- S = ["lambda"|_], append(S,[E],R), !.
ev(E,[X|Y],R) :- ev(E,X,F), maplist(ev(E),Y,A), ef(F,A,R).
ef(F,A,R) :- ay(F,A,R) ; F = [_,V,B,L], mk(V,A,O), append(O,L,E), ev(E,B,R).
mk(A,B,R) :- assert(pr(X,Y,[X|Y])), maplist(pr,A,B,R).
av(K,V,R) :- V=[], R=false ; V=[[K|R]|_] ; V=[_|W], av(K,W,R).
ay(O,[X,Y],R) :- O="=", X=Y, R = true ; O="+", R is X+Y ; O="-", R is X-Y, !.
:- use_module([library(http/json)]).
:- open("sample.json",read,S,[]), json_read_dict(S,D,[]),
ev([],D,R), write(R), nl.
:- halt.
SWI-Prolog7.6.4で確認
$ swipl -s ev10.swi
10946
ev10.c
#include <stdio.h>
#include "parson.h"
#define ARRAY(s) (json_type(s) == JSONArray)
#define STRING(s) (json_type(s) == JSONString)
#define NUMBER(s) (json_type(s) == JSONNumber)
#define NULLP(s) (json_array_get_count(json_array(s)) == 0)
#define ATOMP(s) (!ARRAY(s) || NULLP(s))
#define TRUE (json_parse_string("\"#t\""))
#define FALSE (json_parse_string("\"#f\""))
#define JNULL (json_parse_string("[]"))
#define IF (json_parse_string("\"if\""))
#define LAMBDA (json_parse_string("\"lambda\""))
#define EQV (json_parse_string("\"=\""))
#define ADD (json_parse_string("\"+\""))
#define SUB (json_parse_string("\"-\""))
#define GE (json_parse_string("[\"=\",\"=\",\"+\",\"+\",\"-\",\"-\"]"))
JSON_Value *LI(JSON_Value *s, int i)
{
return json_array_get_value(json_array(s), i);
}
#define L1(s) (LI(s, 0))
#define L2(s) (LI(s, 1))
#define L3(s) (LI(s, 2))
#define L4(s) (LI(s, 3))
JSON_Value *LN(JSON_Value *s)
{
JSON_Array *d = json_array(json_value_deep_copy(s));
json_array_remove(d, 0);
return json_array_get_wrapping_value(d);
}
JSON_Value *LL(JSON_Value *a, JSON_Value *d)
{
JSON_Array *r = json_array(JNULL);
json_array_append_value(r, json_value_deep_copy(a));
JSON_Value *d1;
for (int i = 0; i < json_array_get_count(json_array(d)); i++) {
d1 = json_value_deep_copy(json_array_get_value(json_array(d), i));
json_array_append_value(r, d1);
}
return json_array_get_wrapping_value(r);
}
int eq(JSON_Value *a, JSON_Value *b)
{
if(ATOMP(a) && ATOMP(b)) return json_value_equals(a,b); else return 0;
}
JSON_Value *ap(JSON_Value *a, JSON_Value *b)
{
JSON_Array *r = json_array(json_value_deep_copy(a));
JSON_Value *b1;
for (int i = 0; i < json_array_get_count(json_array(b)); i++) {
b1 = json_value_deep_copy(json_array_get_value(json_array(b), i));
json_array_append_value(r, b1);
}
return json_array_get_wrapping_value(r);
}
JSON_Value *pm(JSON_Value *a, JSON_Value *b)
{
if (NULLP(a)) return JNULL; else if (NULLP(b)) return JNULL;
else return LL(L1(a), LL(L1(b), pm(LN(a), LN(b))));
}
JSON_Value *pq(JSON_Value *k, JSON_Value *v)
{
if (NULLP(v)) return JNULL; else if (eq(k, L1(v))) return L2(v);
else return pq(k, LN(LN(v)));
}
JSON_Value *ay(JSON_Value *f, JSON_Value *a)
{
double x = json_number(L1(a)), y = json_number(L2(a));
if (eq(f, EQV)) { if (x == y) return TRUE; else FALSE; }
else if (eq(f, ADD)) return json_value_init_number(x + y);
else if (eq(f, SUB)) return json_value_init_number(x - y);
else return FALSE;
}
JSON_Value *ev(JSON_Value *s, JSON_Value *e);
JSON_Value *ea(JSON_Value *a, JSON_Value *e)
{
if (NULLP(a)) return JNULL; else return LL(ev(L1(a),e), ea(LN(a),e));
}
JSON_Value *ev(JSON_Value *s, JSON_Value *e)
{
if (STRING(s)) return pq(s, ap(e, GE));
else if (NUMBER(s)) return s;
else if (eq(L1(s), IF))
if (eq(ev(L2(s), e), TRUE)) return ev(L3(s), e); else return ev(L4(s), e);
else if (eq(L1(s), LAMBDA)) return ap(s, LL(e, JNULL));
else {
JSON_Value *f = ev(L1(s), e), *a = ea(LN(s), e);
if (STRING(f)) return ay(f, a);
else return ev(L3(f), ap(pm(L2(f), a), L4(f)));
}
}
int main(void) {
JSON_Value *r = ev(json_parse_file("./sample.json"), JNULL);
printf("%s\n", json_serialize_to_string(r));
return (0);
}
TinyCC0.9.27で確認
C:\Users\TAKIZAWA Yozo\ev10>dir
ドライブ C のボリューム ラベルがありません。
ボリューム シリアル番号は 9402-DDE1 です
C:\Users\TAKIZAWA Yozo\ev10 のディレクトリ
2021/07/26 05:01 <DIR> .
2021/07/26 05:01 <DIR> ..
2021/07/26 04:51 3,186 ev10.c
2021/07/26 04:51 74,217 parson.c
2021/07/26 04:51 13,270 parson.h
2021/07/26 04:53 176 sample.json
4 個のファイル 90,849 バイト
2 個のディレクトリ 215,663,902,720 バイトの空き領域
C:\Users\TAKIZAWA Yozo\ev10>tcc ev10.c parson.c
C:\Users\TAKIZAWA Yozo\ev10>ev10
10946
C:\Users\TAKIZAWA Yozo\ev10>
ev10.go
package main
import (
"encoding/json"
"fmt"
"io/ioutil"
"reflect"
)
type JExp interface{}
var JNull = []interface{}{}
func ap(a, b JExp) JExp {
return append(append(JNull, a.([]interface{})...), b.([]interface{})...)
}
func L1(s JExp) JExp { return s.([]interface{})[0] }
func L2(s JExp) JExp { return s.([]interface{})[1] }
func L3(s JExp) JExp { return s.([]interface{})[2] }
func L4(s JExp) JExp { return s.([]interface{})[3] }
func LN(s JExp) JExp { return s.([]interface{})[1:] }
func LL(a, d JExp) JExp { return ap(append(JNull, a), d) }
func pm(k, v JExp) JExp {
r := JNull
for i := 0; i < len(k.([]interface{})); i++ {
r = append(r, k.([]interface{})[i])
r = append(r, v.([]interface{})[i])
}
return r
}
func pq(k string, p JExp) JExp {
r := p.([]interface{})
for len(r) < 0 || k != r[0].(string) { r = r[2:] }
if k == r[0].(string) { return r[1] } else { return false }
}
func ay(f, a JExp) JExp {
x := L1(a).(int); y := L2(a).(int)
switch f {
case "=": return x == y
case "+": return x + y
case "-": return x - y
default: return false
}
}
func ea(a, e JExp) JExp {
r := JNull; as := a.([]interface{})
for i := 0; i < len(as); i++ { r = append(r, ev(as[i], e)) }
return r
}
func strp(s JExp) bool { return reflect.ValueOf(s).Kind() == reflect.String }
func f64p(s JExp) bool { return reflect.ValueOf(s).Kind() == reflect.Float64 }
func str(s JExp) string { return s.(string) }
func i64(s JExp) int { return int(s.(float64)) }
func streq(s JExp, t string) bool {
if strp(s) && str(s) == t { return true } else { return false }
}
var g = []interface{}{"=","=", "+","+", "-","-"}
func ev(s, e JExp) JExp {
if strp(s) { return pq(str(s), ap(e, g)) } else
if f64p(s) { return i64(s) } else
if streq(L1(s), "if") { if ev(L2(s), e).(bool) {
return ev(L3(s), e) } else { return ev(L4(s), e) } } else
if streq(L1(s), "lambda") { return ap(s, LL(e, JNull)) } else
{ f := ev(L1(s), e); a := ea(LN(s), e);
if strp(f) { return ay(str(f), a) } else
{ return ev(L3(f), ap(pm(L2(f), a), L4(f))) }
}
}
func main() {
f, _ := ioutil.ReadFile("sample.json")
var s JExp
json.Unmarshal([]byte(f), &s)
fmt.Println(ev(s, JNull))
}
1.11.6で確認
$ go run ev10.go
10946
ev10.jl
g = Dict("="=>==, "+"=>+, "-"=>-)
function ev(s, e)
s isa String && return merge(g, e)[s]
s isa Int && return s
s[1] == "if" && return ev(s[2], e) ? ev(s[3], e) : ev(s[4], e)
s[1] == "lambda" && return vcat(s, [e])
f, a = ev(s[1], e), ev.(s[2:end], Ref(e))
f isa Function && return f(a...)
return ev(f[3], merge(f[4], Dict(zip(f[2], a))))
end
print(ev(include("sample.json"), Dict()), "\n")
1.5.2で確認
$ julia ev10.jl
10946
ev10.lua
function pm(k, v)
local r = {}
for i = 1, #k do r[k[i]] = v[i] end
return r
end
function ap(x, y)
local r = {}
for k, v in pairs(y) do r[k] = v end
for k, v in pairs(x) do r[k] = v end
return r
end
function ea(a, e)
local r = {}
for i = 2, #a do r[i - 1] = ev(a[i], e) end
return r
end
function ay(f, a)
if f == "=" then return a[1] == a[2]
elseif f == "+" then return a[1] + a[2]
elseif f == "-" then return a[1] - a[2]
else return nil
end
end
g = {}; g["="]="="; g["+"]="+"; g["-"]="-"
function ev(s, e)
if type(s) == "string" then return ap(e, g)[s]
elseif type(s) == "number" then return math.tointeger(s)
elseif s[1] == "if" then return ev(s[2], e) and ev(s[3], e) or ev(s[4], e)
elseif s[1] == "lambda" then r = ap(s, {}); r[4] = e; return r
else
local f = ev(s[1], e); local a = ea(s, e)
if type(f) == "string" then return ay(f, a)
else return ev(f[3], ap(pm(f[2], a), f[4]))
end
end
end
f = io.open("sample.json", "r")
s = ""; for s1 in f:lines() do s = s .. s1 end
f:close()
json = require 'cjson'
print(ev(json.decode(s), {}))
5.3.3で確認
$ lua ev10.lua
10946
ev10.lisp
(defparameter g '(("=" . =) ("+" . +) ("-" . -)))
(defun ev (s e)
(cond ((stringp s) (cdr (assoc s (append e g) :test #'equal)))
((integerp s) s)
((equal (car s) "if") (if (ev (cadr s) e) (ev (caddr s) e) (ev (cadddr s) e)))
((equal (car s) "lambda") (append s `(,e)))
(t (let ((f (ev (car s) e)) (a (mapcar (lambda (x) (ev x e)) (cdr s))))
(if (listp f) (ev (caddr f) (append (mapcar 'cons (cadr f) a) (cadddr f)))
(apply f a))))))
(defparameter s "")
(with-open-file (j "sample.json")
(loop (let ((l (read-line j nil)))
(if (not l) (return)
(setf s (concatenate 'string s l))))))
(ql:quickload :cl-json :silent t)
(princ (ev (json:decode-json-from-string s) '()))
(terpri)
SBCL1.4.16/roswell21.06.14.110で確認
$ ros -l ev10.lisp
10946
アッカーマン関数：Ack(3, 7)
※膨大な再帰呼び出しが発生します．実行環境によっては，処理が途中で止まったり，コンピュータ本体に高負荷がかかったりする場合があります（特にC版）．
ack3-7.json
[[["lambda",["u"],["u","u"]],
["lambda",["u"],
["lambda",["m","n"],
["if",["=","m",0],["+","n",1],
["if",["=","n",0],[["u","u"],["-","m",1],1],
[["u","u"],["-","m",1],
[["u","u"],"m",["-","n",1]]]]]]]],
3,7]
階乗：10!
※掛け算を行う基本関数がないため，足し算を用いて限定的な掛け算を行うラムダ式（同じくUコンビネータ）を組み込んでいます．
fact10.json
[[["lambda",["u"],["u","u"]],
["lambda",["u"],
["lambda",["x","r"],
["if",["=","x",0],"r",
[["u","u"],["-","x",1],
[[["lambda",["u"],["u","u"]],
["lambda",["u"],
["lambda",["x","y","r"],
["if",["=","y",0],"r",
[["u","u"],"x",["-","y",1],["+","r","x"]]]]]],
"r","x",0]]]]]],
10,1]
素数判定：997
※こちらも%（$modulo$）がないため，* / <などと共に限定的な機能の関数を不動点コンビネータ等で定義した上で，親ラムダ式経由で引数による無名再帰式持ち回りで実現しています．ということもあって，遅いです．真偽値も設定していないため，素数の場合は1，素数ではない場合は0が返るようにしています．
prime997.json
[["lambda",["sub","les","div","mul","mod","prime","x"],
["prime","x",2,"mod","mul","div","les","sub"]],
[["lambda",["u"],["u","u"]],
["lambda",["u"],
["lambda",["x","y"],
["if",["=","x",0],0,
["if",["=","y",0],"x",[["u","u"],["-","x",1],["-","y",1]]]]]]],
[["lambda",["u"],["u","u"]],
["lambda",["u"],
["lambda",["x","y","sub"],
["if",["=",["sub",["+","x",1],"y"],0],1,0]]]],
[["lambda",["u"],["u","u"]],
["lambda",["u"],
["lambda",["x","y","les","sub"],
["if",["=",["les","x","y","sub"],1],0,["+",[["u","u"],["-","x","y"],"y","les","sub"],1]]]]],
[["lambda",["u"],["u","u"]],
["lambda",["u"],
["lambda",["x","y"],
["if",["=","y",0],0,["+",[["u","u"],"x",["-","y",1]],"x"]]]]],
[["lambda",["u"],["u","u"]],
["lambda",["u"],
["lambda",["x","y","mul","div","les","sub"],
["-","x",["mul",["div","x","y","les","sub"],"y"]]]]],
[["lambda",["u"],["u","u"]],
["lambda",["u"],
["lambda",["x","i","mod","mul","div","les","sub"],
["if",["=","x","i"],1,
["if",["=",["mod","x","i","mul","div","les","sub"],0],0,
[["u","u"],"x",["+","i",1],"mod","mul","div","les","sub"]]]]]],
997]
ユーティリティ関数の実装
今回の評価器についてはどの言語についても，先の大まかな流れに沿って実際に10行程度で収まるよう記述しています．そのために行っているのが各種ユーティリティ関数の別途実装ですが，言語によって必要なユーティリティ関数はまちまちで，ほとんど不要な言語もあれば，ほぼ全て実装しなければならない言語もあります．
次は，どのようなユーティリティ関数が必要かをリストアップしたものです．なお，記述の前にある名前は，評価器の流れや実際に必要な言語で使用している関数名です．
-
pmpqap：変数束縛環境の構築・検索・結合 -
L?LNLL：リスト／配列構造のアクセス・構築 -
ea：評価器による引数リスト評価
上記以外にも，文字列や整数の判定，JSON配列構造の読込・評価など，必要に応じたユーティリティ作成が必要となります．
ダイナミックスコープ版
初期のLISPやデフォルトのEmacs Lispはダイナミックスコープであり，ラムダ式本体の変数の値は，ラムダ式の適用時に決まります（レキシカルスコープはラムダ式の評価時）．ラムダ式適用時の環境しかないため，同じ変数名でもラムダ式ごとに区別されるラムダ計算と同じ性質を有しておらず，不動点コンビネータなどが機能しません．
ただ，ダイナミックスコープではラムダ式の適用時に変数を共有でき，引数として渡したラムダ式の本体で引数名を参照することで，再帰処理が容易に実現可能です．次は，ダイナミックスコープの場合のラムダ式で21番目のフィボナッチ数を求める再帰処理を表現した例です．
fib21-ds.json
[["lambda",["fib"],["fib",21,0,1]],
["lambda",["n","a","b"],
["if",["=","n",0],"a",
["fib",["-","n",1],"b",["+","a","b"]]]]]
このラムダ式を実行する（すなわち，ダイナミックスコープ版とする）ために必要な評価器の修正は，次の2箇所です（実際には後者のみでOKです）．
$s_1$が
lambdaならば，$\underline{s}$をそのまま返す．
⇒ラムダ式に評価時の環境を含めない．上記以外はラムダ式適用とみなし，$ev(f_3,ap(pm(f_2,a),\underline{e})$を返す．
⇒ラムダ式適用時は（ラムダ式評価時の環境ではなく）その時点の環境を参照する．
Python版の修正例は次のようになります．
--- ev10.py 2021-07-28 03:29:52.580000000 +0900
+++ ev10-ds.py 2021-07-29 21:02:25.650000000 +0900
@@ -4,13 +4,13 @@
if isinstance(s, str): return {**e, **g}[s]
elif isinstance(s, int): return s
elif s[0] == 'if': return ev(s[2], e) if ev(s[1], e) else ev(s[3], e)
- elif s[0] == 'lambda': return s + [e]
+ elif s[0] == 'lambda': return s
else:
f = ev(s[0], e); a = [ev(x, e) for x in s[1:]]
if callable(f): return f(*a)
- else: return ev(f[2], {**f[3], **dict(zip(f[1], a))})
+ else: return ev(f[2], {**e, **dict(zip(f[1], a))})
import sys
sys.setrecursionlimit(10 ** 5)
-print(ev(eval(''.join(list(open('sample.json')))), {}))
+print(ev(eval(''.join(list(open('sample-ds.json')))), {}))
備考
記事に関する補足
- JavaScript版が10行規定で危なかった．ハッシュテーブルの結合関数が見つからない…．
- 実行コードをJSON限定にしたのはやり過ぎかな？でも，字句・構文解析まわりは避けたいし．
-
<を導入すればたらい回し関数も動くけど，それ言ったら%導入すれば素数判定ができるし，*があれば階乗計算もっと簡単になるし…とキリがないのでこのまま．
- C版はこれで勘弁して下さい…10行…．
- Go版は
interface{}型あるし連想配列もあるしで楽勝だぜーと思ったら，型アサーションが厳しくて…．謎のユーティリティ関数オンパレードにしないと評価器本体が型アサーションだらけになるという．
- 後で気づいたのだけれど，配列構造記述がJSONと同じJavaScript/Python/Ruby/Juliaは，JSONライブラリすら要らないな…．ということで，ちょこちょこ書き換え．
更新履歴
- 2021-08-04：Common Lisp版を追加
- 2021-08-04：Scheme版をSRFI-180使用に修正
- 2021-08-03：ユーティリティ関数の解説を追加
- 2021-08-03：Lua版を追加
- 2021-07-29：ダイナミックスコープ版の解説を追加
- 2021-07-29：評価器の大まかな流れを追加
- 2021-07-29：Julia版の修正（Twitterより）
- 2021-07-27：素数判定の実行コードサンプルを追加
- 2021-07-27：JSONライブラリ不要の言語処理系の記述例を修正
- 2021-07-27：Julia版を追加
- 2021-07-27：Go版を追加
- 2021-07-27：評価器の大まかな流れを追加
- 2021-07-26：C版追加
- 2021-07-26：実行コード周りを修正・追加
- 2021-07-25：参考記事リンク追加
- 2021-07-25：Prolog版追加
- 2021-07-23：目的（裏）を記載
- 2021-07-23：初版公開（Scheme，Python，Ruby，JavaScript）
<を導入すればたらい回し関数も動くけど，それ言ったら%導入すれば素数判定ができるし，*があれば階乗計算もっと簡単になるし…とキリがないのでこのまま．interface{}型あるし連想配列もあるしで楽勝だぜーと思ったら，型アサーションが厳しくて…．謎のユーティリティ関数オンパレードにしないと評価器本体が型アサーションだらけになるという．Author And Source
この問題について(10行LISP評価器の実装例（各言語まとめ）), 我々は、より多くの情報をここで見つけました https://qiita.com/ytaki0801/items/fc785de02eb45cde94fa著者帰属：元の著者の情報は、元のURLに含まれています。著作権は原作者に属する。
Content is automatically searched and collected through network algorithms . If there is a violation . Please contact us . We will adjust (correct author information ,or delete content ) as soon as possible .