call/cc in Lua

http://stackoverflow.com/questions/2827620/call-cc-in-lua-possible
であったネタ。

前提知識(?)
[1]Coroutines in Lua
http://www.inf.puc-rio.br/~roberto/docs/corosblp.pdf

[2]Revisiting Coroutines
http://www.inf.puc-rio.br/~roberto/docs/MCC15-04.pdf

[3]Some Proofs about Coroutines
http://www.dbd.puc-rio.br/depto_informatica/08_04_ierusalimschy.pdf

[1]~[3]で言われてるのは、
asymmetric coroutine(Luaのcoroutine,semi-coroutine)=symmetric coroutine=one-shot continuation
は全部等価とかいう話。

あと、"one-shot delimited continuation"とも一緒だよみたいなことが書いてあるけど、実際に使ってるのは、subcontinuationとかいうよく知らない代物。論文では、spawn/controllerとか使ってるけど、これはprompt/controlと同じっぽい?が、これらが、shift/resetと同等なのかとか、知らない。

call/1ccは実装してるScheme処理系がChezSchemeしかないし、使ってるコードとかも全然ないので、なんかよく分からないけど、

(call/1cc (lambda (k) (k 0)))

などはOKだけど、

(define cont #f)
(begin (display "hoge")
       (call/1cc (lambda(c) (set! cont c)))
       (display "fuga")
       (display "piyo"))
(cont)

とかやると、Exception: attempt to invoke shot one-shot continuationといわれる。Luaによるcall/1ccの実装は[2]に書かれてる。

で、じゃあcall/ccと、こいつらの差は何?みたいな疑問があって、coroutineの複製が作れれば、call/cc作れるんじゃねという話。

coroutineの複製をできるようにしたというLua処理系のpatchが
http://lua-users.org/lists/lua-l/2006-01/msg00652.html
らへんにあって、これを使って作ったというcall/ccが
https://github.com/torus/lua-call-cc/blob/master/callcc.lua

複製できるというのは、

local co = coroutine.create(function () for i=1,100 do
                                          print(i)
                                          coroutine.yield(i) end end)
coroutine.resume(co)
coroutine.resume(co)

local co2 = coroutine.clone(co)

coroutine.resume(co)
coroutine.resume(co)
coroutine.resume(co2)
coroutine.resume(co2)

とか実行すると、1,2,3,4,3,4が返ってくるという意味。

pythonのitertools.teeは似たようなことができるけど、あれは結果をキャッシュしているだけらしいので、

import itertools
x = 0
def gen():
   for i in xrange(1,100):
     yield (i+x)

co = gen()
co.next()  #yield 1
co.next()  #yield 2
co,co2 = itertools.tee(co)
co.next()  #yield 3
co.next()  #yield 4
x=10
co2.next() #!?
co2.next() #!?

とかいうケースで困る。

で、以下のようなコードが動く。

require "callcc"

function add(x,y) return x+y end

--(display (call/cc (lambda (c) (+ 2 (c 3)))))
function test()
  local r = callcc (function (cont) add(2,cont(3)) end)
  print(r)
end

--(display (+ 2 (call/cc (lambda (k) (k (k 0))))))
function test2()
  local r = callcc(function (k) k(k(3)) end)
  print (2+(r))
end


--(call/cc (lambda (c) ((c 0) (c 1))))
function test3()
  local r = callcc(function(k) k(0)(k(1)) end)
  print(r)
end


callcc_run(test)
callcc_run(test2)
callcc_run(test3)

callcc_runとかどうなの?っていうのと、それを除いてもほんとにこれがcall/ccと等価って言ってよいのか確信がない。実際のとこ
http://d.hatena.ne.jp/m-a-o/20060915#p3
にあるような
(let ((f (call/cc call/cc))) (f (lambda (x) 1)))
というコードは動かないっぽい。どこで死んでるか真面目に調べてはいないけど。

callcc_runをなくすには、VMの実体であるlua_Stateをthreadにしてやれば、ほんとのcurrent continuationを取ることができて、それで同じようなことをしてやればよい気がする(けど、それが実際に動くのかは試してない)。そういうのなしには、callcc_runを消すことは多分できない

実用的な観点からすると、もし本当にcall/ccがcoroutine+cloneと等価なら、後者のほうがずっと標準的な頭脳の人類に優しいsemanticsになる。等価でないなら(後者のほうが強力ということはないだろうから)call/ccに届くには、何が足りないのか知りたい。ていうか、call/ccをprimitiveにしようとか、最初に思いついた人は、どうかしてる

ちなみに処理系を改変するのは気分的に避けたかったので、Luaのソースから、lstate.hだけ持ってきて、以下のようなコードを書いてテストした

#include <stdio.h>
#ifdef  __cplusplus
extern "C"{
#endif
  #include "lua.h"
  #include "lauxlib.h"
  #include "lualib.h"
  //illegal
  #include "lstate.h"
#ifdef  __cplusplus
}
#endif


int clonethread(lua_State *L){
   lua_State *src,*dst;
   if(!lua_isthread(L,1)){
      luaL_argerror(L , 1 , "coroutine expected");
   }
   src = lua_tothread(L , 1);
   lua_lock(L);
   if(!(src->status==LUA_YIELD || (src->status==0 && src->ci==src->base_ci))){
      luaL_error(L , "attempt to clone uncloneable coroutine");
   }
   lua_unlock(L);

   dst = lua_newthread(L);
   lua_lock(dst);
   luaD_reallocstack(dst , src->stacksize - EXTRA_STACK - 1);
   luaD_reallocCI(dst , src->size_ci);

   /* Copy stack slots */
   {
      TValue *f,*t;
      for(f = src->stack,t=dst->stack ; f < src->top ; f++,t++)
         setobj2s(dst , t, f);
      dst->top = t;
      for(; f < src->ci->top ; f++,t++)
         setnilvalue(t);
      dst->base = (src->base - src->stack) + dst->stack;
   }


   /* Copy stack slots */
   {
      TValue *f,*t;
      for(f = src->stack,t=dst->stack ; f < src->top ; f++,t++)
         setobj2s(dst , t, f);
      dst->top = t;
      for(; f < src->ci->top ; f++,t++)
         setnilvalue(t);
      dst->base = (src->base - src->stack) + dst->stack;
   }

   /* Copy Frames */
   {
      CallInfo *f,*t;
      for(f = src->base_ci,t=dst->base_ci ; f <= src->ci ; f++,t++){
         t->base = (f->base - src->stack) + dst->stack;
         t->func = (f->func - src->stack) + dst->stack;
         t->top = (f->top - src->stack) + dst->stack;
         t->nresults = f->nresults;
         t->savedpc = f->savedpc;
         t->tailcalls = f->tailcalls;
      }
      dst->ci = (src->ci - src->base_ci) + dst->base_ci;
   }

   /* Copy misc fields. Hooks are deliberately not copied. */
   dst->status = src->status;
   dst->savedpc = src->savedpc;
   lua_unlock(dst);
   return 1;
}


static const struct luaL_Reg _coroutineLib [] = {
  {"clone" , clonethread},
  {NULL,NULL}
};




int main(int argc, char **argv){
  if(argc==1)return 0;
  lua_State *L = luaL_newstate();
  luaL_openlibs(L);
  luaL_register(L , "coroutine" , _coroutineLib);
  luaL_dofile(L , argv[1]);
  lua_close(L);
  return 0;
}