ホワット・ア・ワンダフル・ワールド ET

(fizzbuzz) ==> (generator *msgQ), // 生産者
(take 100 *msgQ *x), // 消費者
(fizzbuzz *x *fizzbuzz), // 加工者
(printList *fizzbuzz). // 表示者

// 1 から数を生産開始
(generator *msg)
==> {(= *msg (1 | *msg1))}, (generator 1 *msg1).
// 要求メッセージがきたら生産
(generator *n (need | *msg))
==> {(add *n 1 *n1), (= *msg (*n1 | *msg1))}, (generator *n1 *msg1).
// 停止メッセージがきたら生産終了
(generator *n (halt | ?)) ==>.

// 生産済みだったら取るだけ
(take *n (*m | *msg) *x)
==> {(= *x (*m | *x1)),(sub *n 1 *n1)}, (take *n1 *msg *x1).
// 取り終わったら終了メッセージを送る
(take 0 *msg *x),{(pvar *msg)}
==> {(= *msg (halt)), (= *x ())}.
// メッセージを送って生産してもらう
(take *n *msg *x), {(> *n 0), (pvar *msg), (= *msg (need | *msg1))}
==> (take *n *msg1 *x).

// できたそばから表示
(printList (*x | *xs))
==> {(format "/a " (*x))}, (printList *xs).
(printList ()) ==> {(format "/n" ())}.

// fizzbuzz filter
(fizzbuzz (*x | *xs) *fizzbuzz), {(:= 0 (mod *x 3)), (:= 0 (mod *x 5))}
==> {(= *fizzbuzz (FizzBuzz | *fizzbuzz1))}, (fizzbuzz *xs *fizzbuzz1).
(fizzbuzz (*x | *xs) *fizzbuzz), {(:= 0 (mod *x 3)), (not (:= 0 (mod *x 5)))}
==> {(= *fizzbuzz (Fizz | *fizzbuzz1))}, (fizzbuzz *xs *fizzbuzz1).
(fizzbuzz (*x | *xs) *fizzbuzz), {(not (:= 0 (mod *x 3))), (:= 0 (mod *x 5))}
==> {(= *fizzbuzz (Buzz | *fizzbuzz1))}, (fizzbuzz *xs *fizzbuzz1).
(fizzbuzz (*x | *xs) *fizzbuzz), {(not (:= 0 (mod *x 3))), (not (:= 0 (mod *x 5)))}
==> {(= *fizzbuzz (*x | *fizzbuzz1))}, (fizzbuzz *xs *fizzbuzz1).
(fizzbuzz () *fizzbuzz) ==> {(= *fizzbuzz ())}.

(fizzbuzz *n) ==> (gen 1 *x), (take *n), (filter *x *l), (printer *l).

(gen *i *x), (take *n)
==> {(> *n 0), (= *x (*i | *x1)), (add *i 1 *i1), (sub *n 1 *n1)},(gen *i1 *x1), (take *n1).
(gen *i *x), (take 0) ==> {(= *x ())}.

// 以下，同じ
(filter (*x | *xs) *filter), {(:= 0 (mod *x 3)), (:= 0 (mod *x 5))}
==> {(= *filter (filter | *filter1))}, (filter *xs *filter1).
(filter (*x | *xs) *filter), {(:= 0 (mod *x 3)), (not (:= 0 (mod *x 5)))}
==> {(= *filter (Fizz | *filter1))}, (filter *xs *filter1).
(filter (*x | *xs) *filter), {(not (:= 0 (mod *x 3))), (:= 0 (mod *x 5))}
==> {(= *filter (Buzz | *filter1))}, (filter *xs *filter1).
(filter (*x | *xs) *filter), {(not (:= 0 (mod *x 3))), (not (:= 0 (mod *x 5)))}
==> {(= *filter (*x | *filter1))}, (filter *xs *filter1).
(filter () *filter) ==> {(= *filter ())}.
(printer (*x | *xs))
==> {(format "/a " (*x))}, (printer *xs).
(printer ()) ==> {(format "/n" ())}.

" Vim syntax file
" Language: ET
" Maintainer: aloha (WAKATSUKI toshihiro) <alohakun@gmail.com>

if version < 600
syntax clear
elseif exists("b:current_syntax")
finish
endif

syn clear

set iskeyword+=-
set iskeyword+=_
set iskeyword+=?
set iskeyword+=:
set iskeyword+==
set iskeyword+=<
set iskeyword+=>
set iskeyword+=~
set iskeyword+=|

syn match etDelimiter "[(),]"
syn match etOperator "( \|?-\|:\|-->\|==>\| )"

syn keyword etBoolean true false
syn keyword etInclude include
syn region etString start=+"+ skip=+\\"+ end=+"+
syn match etCharacter "\'.\'"
syn match etNumber "[0-9\.]"
syn match etComment "//\s*.*"
syn region etComment start=+/\*+ end=+\*/+
syn match etPVar "\*[^\(\){} ]*"
syn match etPVar "?[^\(\){} ]*"
syn match etIVar "\*[^\(\){} ]*\~[^\(\){} ]+"
syn match etIVar "?[^\(\){} ]*\~[^\(\){} ]+"
syn region etArray start=+{+ end=+}+ contains=ALL

if !exists("did_et_syntax_inits")
let did_et_syntax_inits = 1
hi link etDelimiter Delimiter
hi link etOperator Operator
hi link etComment Comment
hi link etType Type
hi link etKeyword Label
hi link etBRule Keyword
hi link etString String
hi link etCharacter Character
hi link etBoolean Boolean
hi link etNumber Number
hi link etInclude Include
hi link etArray Constant
hi link etPVar Identifier
hi link etIVar Identifier
endif

let b:current_syntax = "et"

set sm

(test) --> (= *F (*X -> *X)), // f:X -> X のつもり．下の式にインラインで書いても良いけど
(= *double (lambda (*F *A) (*F (*F *A)))),
(= *a (*double succ 1)),
(= *b (*double not true)),
(typeInf *a),
(typeInf *b).

(typeInf1 () ()) -->.

(typeInf1 (*F | *rest) (succ | *rest1))
-->
(= *F (Num -> Num)),
(typeInf1 *rest *rest1).

(typeInf1 (*F | *rest) (not | *rest1))
-->
(= *F (Bool -> Bool)),
(typeInf1 *rest *rest1).

(typeInf1 (*A | *rest) (true | *rest1))
-->
(= *A Bool),
(typeInf1 *rest *rest1).

(typeInf1 (*A | *rest) (*n | *rest1)),
{(number *n)}
-->
(= *A Num),
(typeInf1 *rest *rest1).

(typeInf2 ((Num -> Num) *X) *R)
-->
(typeInf2 *X Num),
(= *R Num).

(typeInf2 ((Bool -> Bool) *X) *R)
-->
(typeInf2 *X Bool),
(= *R Bool).

(typeInf2 Bool *R)
-->
(= *R Bool).

(typeInf2 Num *R)
-->
(= *R Num).

(typeInf ((lambda *parm *body) | *args))
-->
// コピーしてフレッシュな変数を使う
(copy (*parm *body) (*parm1 *body1)),
(typeInf1 *parm1 *args),
(print (lambda *parm1 *body1)),
(typeInf2 *body1 *result),
(print (*parm1 => *result)).

[D]>(compile (lambda (*x *y *z) (set! *a (+ *z (+ *x *y)))))
-------------------------D execution ---------------------
/* 変換過程
(lambda (*A *B *C) (set! *D (+ *C (+ *A *B))))
=>
(lambda (*A *B *C) (set! *E (+ *A *B)) (set! *F (+ *C *E)) (set! *D *F) *D)
=>
(lambda ("v0" "v1" "v2") (set! "v3" (+ "v0" "v1")) (set! "v4" (+ "v2" "v3")) (set! "v5" "v4") "v5")
*/
#include <stdio.h>
#include <jit/jit.h>

int main(int argc, char **argv) {
jit_context_t context = jit_context_create();
jit_type_t params[3];
jit_type_t signature;
jit_function_t function;
jit_value_t v0, v1, v2, v3, v4, v5;
jit_int arg0, arg1, arg2;
void *args[3];
jit_int result;
jit_context_build_start(context);
params[0] = jit_type_int;
params[1] = jit_type_int;
params[2] = jit_type_int;
signature = jit_type_create_signature(jit_abi_cdecl, jit_type_int, params, 3, 1);

signature = jit_type_create_signature(jit_abi_cdecl, jit_type_int, params, 3, 1);
function = jit_function_create(context, signature);
v3 = jit_insn_add(function, v0, v1);
v4 = jit_insn_add(function, v2, v3);
jit_insn_store(function, v5, v4);
jit_insn_return(function, v5);

jit_function_compile(function);
jit_context_build_end(context);
arg0 = 2;
args[0] = &arg0;
arg1 = 3;
args[1] = &arg1;
arg2 = 4;
args[2] = &arg2;

jit_function_apply(function, args, &result);
puts("/* (lambda (*A *B *C) (set! *D (+ *C (+ *A *B)))) */");
printf("(lambda (1 2 3)) => %d\n", (int)result);
jit_context_destroy(context);
return 0;
}
----------------------------------------------------------
succeeded.


(as (compile (lambda *parms | *body))
    :
    /* テスト用に式を表示するため */
    (sformat *lambda "/a" ((lambda *parms | *body)))
    (length *parms *arity)
    (emit-signature *arity *typeSig)
    (KNorm *body *body1)
    (sformat *k "/a" ((lambda *parms | *body1)))
    (getAllVar (*parms | *body1) *vars)
    (allocVar *vars)
    (list2cargDecl *vars *paramdecl)
    (emit-get-args *parms *allocCode)
    (makeTestArgs *arity *testargs)
    (list2cargDecl *testargs *argdecl)
    (between 1 *arity *testVals)
    (sformat *testValsStr "/a" (*testVals))
    (compileBody *body1 *code)
    (emit-set-test-args *arity *setcode)
    (format "//* 変換過程/n  /s/n=>/n  /s/n=>/n  /a/n*///n" (*lambda *k (lambda *parms | *body1)))
    (printf
"#include <stdio.h>
#include <jit/jit.h>

int main(int argc, char **argv) {
  jit_context_t context = jit_context_create();
  jit_type_t params[%d];
  jit_type_t signature;
  jit_function_t function;
  jit_value_t %s;
  jit_int %s;
  void *args[%d];
  jit_int result;
  jit_context_build_start(context);
%s
  signature = jit_type_create_signature(jit_abi_cdecl, jit_type_int, params, %d, 1);
  function = jit_function_create(context, signature);
%s
  jit_function_compile(function);
  jit_context_build_end(context);
%s
  jit_function_apply(function, args, &result);
  puts(\"/* %s */\");
  printf(\"(lambda %s) => %%d\\n\", (int)result);
  jit_context_destroy(context);
  return 0;
}
" (*arity *paramdecl *argdecl *arity *typeSig *arity *code *setcode *lambda *testValsStr)))

/* K 正規化 (SSA) */
(as (KNorm (*body) *body1)
    :
    (KNorm *body () *body2 *ret)
    (rev (*ret | *body2) *body1))
    
(as (KNorm *v *s1 *s *ret)
    (var *v)
    :
    (= *s *s1)
    (= *ret *v))

(as (KNorm *n *s1 *s *ret)
    (number *n)
    :
    (= *s *s1)
    (= *ret *n))
    
(as (KNorm (+ *x *y) *Stack1 *Stack *return)
    :
    (KNorm *x *Stack1 *Stack2 *ret1)
    (KNorm *y *Stack2 *Stack3 *ret2)
    (= *Stack ((set! *return (+ *ret1 *ret2)) | *Stack3)))
    
(as (KNorm (set! *v *x) *Stack1 *Stack *return)
    :
    (KNorm *x *Stack1 *Stack2 *ret1)
    (= *return *v)
    (= *Stack ((set! *v *ret1) | *Stack2)))

/* ラムダ式の本体をコンパイル */
(as (compileBody *body *code)
    :
    (compileBody1 *body *codeList)
    (listStr *codeList *code))

(as (compileBody1 () *codeList)
    :
    (= *codeList ("")))

(as (compileBody1 (*b | *bs) *codeList)
    :
    (compileExpr *b *code1)
    (= *codeList (*code1 | *codeList1))
    (compileBody1 *bs *codeList1))

// 引数
(as (compileExpr1 *r *c)
    (string *r)
    :
    (= *c *r))
    
// 定数
(as (compileExpr1 *n *c)
    (int *n)
    :
    (sprintf *c "%d" (*n)))
(as (compileExpr1 *r *c)
    (string *r)
    :
    (= *c *r))

(as (compileExpr *r *c)
    (string *r)
    :
    (sprintf *c "  jit_insn_return(function, %s);\n" (*r)))
(as (compileExpr () *c)
    :
    (= *c ""))
(as (compileExpr (set! *x *y) *c)
    (string *x)(string *y)
    :
    (sprintf *c "  jit_insn_store(function, %s, %s);\n" (*x *y)))
(as (compileExpr (set! *z (+ *x *y)) *c)
    (string *z)
    :
    (compileExpr1 *x *xc)
    (compileExpr1 *y *yc)
    (sprintf *c "  %s = jit_insn_add(function, %s, %s);\n" (*z *xc *yc)))

(as (compileExpr (+ *x *y) *c)
    :
    (compileExpr1 *x *xc)
    (compileExpr1 *y *yc)
    (sprintf *c "  jit_insn_return(function, jit_insn_add(function, %s, %s));\n" (*xc *yc)))
    
/* arity に応じて型シグネチャを組み立てる */
(as (emit-signature *arity *code)
    :
    (emit-params-signature *arity *params)
    (sprintf *code "%s  signature = jit_type_create_signature(jit_abi_cdecl, jit_type_int, params, %d, 1);\n" (*params *arity)))

(as (emit-params-signature *arity *params)
    :
    (emit-params-signature *arity () *params-list)
    (listStr *params-list *params))

(as (emit-params-signature 0 *params1 *params)
    :
    (= *params1 *params))
(as (emit-params-signature *n *params1 *params)
    :
    (:= *n1 (- *n 1))
    (sprintf *param "  params[%d] = jit_type_int;\n" (*n1))
    (emit-params-signature *n1 (*param | *params1) *params))  

/*
   (lambda (*x *y) (+ *x *y)) とかを
   (lambda (v1 v2) (+ v1 v2)) みたいにする
*/
(as (allocVar *args)
    :
    (allocVar *args 0))

(as (allocVar () ?) :)
(as (allocVar (*a | *as) *n)
    :
    (sprintf *a "v%d" (*n))
    (:= *n1 (+ *n 1))
    (allocVar *as *n1))
/*
  
"  v0 = jit_value_get_param(function, 0);
  v1 = jit_value_get_param(function, 1);
  v2 = jit_value_get_param(function, 2);
"
   みたいな文字列を作る．
*/
(as (emit-get-args *args *allocCode)
    :
    (emit-get-args *args 0 *codeStrList)
    (listStr *codeStrList *allocCode))
(as (emit-get-args () ? *prog) (= *prog (""))) 
(as (emit-get-args (*x | *xs) *n *prog)
    (string *x)
    :
    (sprintf *p "  %s = jit_value_get_param(function, %d);\n" (*x *n))
    (:= *n1 (+ *n 1))
    (= *prog (*p | *prog1))
    (emit-get-args *xs *n1 *prog1))

/* 全ての変数を取り出す (逆順に取り出される) */
/* 実行例 : (getAllVar ((*A *B) (set! *C (+ *A *B))) (*C *B *A))) */
(as (getAllVar *lambda *vars)
    :
    (getAllVar1 *lambda *vars1)
    (nuv *vars1 *vars2)
    (rev *vars2 *vars))
    
(as (getAllVar1 ((*x | *xs) | *rest) *vl)
    (getAllVar1 *x *vl1)
    (getAllVar1 *xs *vl2)
    (append *vl1 *vl2 *vl3)
    (append *vl3 *vl4 *vl)
    (getAllVar1 *rest *vl4))
(as (getAllVar1 (*v | *xs) *vl)
    (var *v)
    :
    (= *vl (*v | *vl1))
    (getAllVar1 *xs *vl1))
(as (getAllVar1 (*x | *xs) *vl)
    (not (var *x))
    (not (cont *x))
    :
    (getAllVar1 *xs *vl))
(as (getAllVar1 *v *vl)
    (var *v)
    :
    (= *vl (*v)))
(as (getAllVar1 *x *vl)
    (not (var *x))
    (not (cont *x))
    :
    (= *vl ()))


/* (list2cargDecl ("a" "b" "c") "a, b, c") */
/* C の引数宣言を作る */
(as (list2cargDecl *l *cd)
    :
    (list2cargDecl1 *l *cl)
    (listStr *cl *cd))
(as (list2cargDecl1 () *cargDecl)
    :
    (= *cargDecl ("")))
(as (list2cargDecl1 (*s) *cargDecl)
    (or ((string *s) (symbol *s)))
    :
    (= *cargDecl (*s)))
(as (list2cargDecl1 (*i) *cargDecl)
    (int *i)
    :
    (sprintf *s "%d" (*i))
    (= *cargDecl (*s)))
(as (list2cargDecl1 (*s | *ss) *cargDecl)
    (or ((string *s) (symbol *s)))
    :
    (sprintf *s1 "%s, " (*s))
    (= *cargDecl (*s1 | *cargDecl1))
    (list2cargDecl1 *ss *cargDecl1))

(as (list2cargDecl1 (*i | *ss) *cargDecl)
    (int *i)
    :
    (sprintf *s "%d, " (*i))
    (= *cargDecl (*s | *cargDecl1))
    (list2cargDecl1 *ss *cargDecl1))

/* テスト用の変数を作る */
(as (makeTestArgs *arity *testArgs)
    :
    (makeTestArgs *arity () *testArgs))
(as (makeTestArgs 0 *args1 *args)
    :
    (= *args *args1))
(as (makeTestArgs *n *args1 *args)
    :
    (:= *n1 (- *n 1))
    (sprintf *a "arg%d" (*n1))
    (makeTestArgs *n1 (*a | *args1) *args))

/* テスト用の変数に値をセットするコードを生成 */
(as (emit-set-test-args *arity *setcode)
    :
    (emit-set-test-args *arity () *sets)
    (listStr *sets *setcode))

(as (emit-set-test-args 0 *sets1 *sets)
    :
    (= *sets *sets1))
(as (emit-set-test-args *n *sets1 *sets)
    :
    (:= *n1 (- *n 1)) (:= *n2 (+ *n 1))
    (sprintf *set "  arg%d = %d;\n  args[%d] = &arg%d;\n" (*n1 *n2 *n1 *n1))
    (emit-set-test-args *n1 (*set | *sets1) *sets))

/* library */
/* リストの長さ */
(as (length *l *n)
    :
    (length *l 0 *n))
(as (length () *n *n1)
    :
    (= *n *n1))
(as (length (? | *xs) *n1 *n)
    :
    (:= *n2 (+ *n1 1))
    (length *xs *n2 *n))

/* リスト逆転 */
(as (rev *l *rl)
    :
    (rev *l () *rl))

(as (rev () *s *l) : (= *l *s))

(as (rev (*x | *xs) *s *l)
    :
    (rev *xs (*x | *s) *l))

/* リスト連結 */
(as (append () *y *z)
    :
    (= *y *z))
(as (append (*x | *xs) *y *z)
    :
    (= *z (*x | *z1))
    (append *xs *y *z1))

/* リストの要素の重複排除 */
(as (nuv *L *NL)
    :
    (nuv *L () *NL))

(as (nuv () *Y *Z) : (= *Y *Z))
(as (nuv (*X | *Xs) *Y *Z)
    (member *X *Y)
    :
    (nuv *Xs *Y *Z))

(as (nuv (*X | *Xs) *Y *Z)
    :
    (nuv *Xs (*X | *Y) *Z))

/* リストに *A が含まれているか ? */
(as (member *A (*A|*X)) : )
(as (member *A (*B|*X)) : (member *A *X))

/* どれか一つ成功すれば成功 */
(as (or ()) : (false))
(as (or (*x | *xs))
    (call *x)
    :)
(as (or (? | *xs))
    :
    (or *xs))

/* (between 1 3 (1 2 3)) */
(as (between *x *y *l)
    (> *x *y)
    :
    (= *l ()))
(as (between *x *y *l)
    :
    (:= *x1 (+ *x 1))
    (= *l (*x | *l1))
    (between *x1 *y *l1))

私は知識に何ものかを付け加え，また他の人々がより多くのものを付け加える手助けをした --- G.H.ハーディ

ET Q&A

簡単 ET 講座生産者と消費者問題

ET 用の vim syntax ファイル

はじめてのかたちぇっか

lambda 式の Just-In-Time コンパイラコンパイラ libjit 版