.Net字节码转换到Lua字节码的实现方式

最近做了个将.Net的字节码文件转换成Lua5.3官方版本字节码的小项目,这样用C#, F#等编程语言编写的代码就可以运行在Lua虚拟机上和Lua互调用了(虽然这种需求不常见,不过Lua虚拟机实现简单方便定制对运行时比较可控也算一个微不足道的优势)。
先不管为什么会有这个奇怪的需求,考虑到将性能差的动态编程语言编译到JVM, CLR等性能好的平台的字节码比较常见,但是反过来将静态编程语言编译到性能差的动态脚本语言的虚拟机上情况比较少见,所以记录这篇文章分享一下。

先简单介绍下.Net和Lua5.3的虚拟机的堆栈结构,因为这两种虚拟机的堆栈结构不一样,字节码指令也差别较大,不能简单对应转换。

.Net字节码的读取可以使用Mono.Cecil库,Lua字节码生成我是写了个assembler来根据伪汇编生成Lua5.3字节码。

.Net虚拟机有Evaluation Stack(指令下文简称eval stack), Call Stack, 参数区,堆,本质是一个基于堆栈的虚拟机
Lua5.3官方的虚拟机有Slots, 堆,本质是一个基于寄存器的虚拟机

首先因为两种虚拟机的堆栈结构都不一样,.Net的字节码指令基于操作栈和内存堆还有eval stack,而Lua的字节码指令都是操作Slots,类似操作一个个寄存器(不是CPU中的寄存器概念)的,所以要实现两种字节码的转换,我采用的方式是目标Lua字节码序列需要实现模拟.Net虚拟机的堆栈结构,下文有具体描述实现方式。

主要实现流程:
1. 实现.Net方法到Lua proto的映射
2. 实现.Net操作指令到Lua指令的映射
3. 实现.Net的控制流指令到Lua指令的映射
4. 实现.Net的函数调用,函数参数,函数调用的返回值到Lua字节码的映射
5. 实现.Net常用函数和类库到Lua的映射(只实现能关联到Lua中的函数和类库)
6. .Net中提供Lua内置库的mock类,从而实现C#写代码,最终编译到Lua字节码后可以使用Lua内置库
7. .Net中提供Lua的table类型等类型的内置库
8. 精简生成的字节码指令,去除因为堆栈结构不一样导致的生成过程中一些无用操作(比如刚压栈就出栈)

将.Net的一个method映射成为Lua中的一个proto,同样有maxstacksize, numOfLocalVariables, 另外有numOfUpvalues。将.Net的非基本对象(数字,布尔类型,字符串等)映射为Lua的table类型对象和proto,.Net中一个有若干方法和属性的对象,映射为Lua中的table和proto, proto中有若干个slots分别通过Lua的closure指令指向不同的其他proto(.Net类型的methods映射的结果),.Net对象的属性放入table中。

然后最关键的是实现.Net的method方法转换到Lua的proto的实现。

对于.Net虚拟机中的eval stack概念,可以通过在目标Lua字节码的proto中头部固定设置一个slot,存储一个table来模拟.Net中的eval stack,另外提供几个固定slot用来存放计算时临时用的对象(比如存储eval stack长度等)

对于.Net中的call stack概念,在目标Lua字节码的proto中专门开辟一段slot区域用来存储,这段slot区域的开始和结束位置,可以根据.Net中method的maxstacksize和指令操作的最大call stack loc计算出来。

然后就是.Net各种指令到Lua指令的翻译了,是一个苦力活,下面简单举例说下一些指令转换的方式

每个proto头部先加入指令 newtable %0 0 0;  %0表示slot 0, @0表示upvalue 0, upvalue的处理有空再说

以下不少翻译后指令结合起来后没必要可以去重精简掉


.Net的IL指令(用一些基本常用指令介绍)                                                   Lua指令(简要描述)

stloc 从eval stack 弹出栈顶数据复制到call stack                 len %1 %0; gettable %(callStackSlotStart+loc) %0 %1; loadnil %3 0; settable %0 %1 %3;
ldloc 从当前函数栈的call stack把某个数据复制到eval stack         len %1 %0; add %1 %1 const 1; settable %0 %1 %(callStackSlotStart+loc)
ldc_i4 加载4字节int常量到eval stack                             loadk %1 const ConstValue; len %2 %0; settable %0 %2 %1
add    消耗eval stack的顶部2个值, 计算结果存入eval stack         len %1 %0; gettable %4 %0 %1; loadnil %3 0; settable %0 %1 %3; len %1 %0; gettable %5 %0 %1; settable %0 %1 %3;
                                                                         add %2 %4 %5; len %1 %0; add %1 %1 const 1; settable %0 %1 %2
call   调用.Net函数                                             先从eval stack取出若干参数放入slot, 然后根据具体情况判断是转换成Lua指令还是全局函数还是某个table的成员函数,
                                                               比如getupval %2 @(被call的func的upvalueIndex) / gettabup %2 @(env的upvalueIndex) const "函数名" 等,
                                                               然后call %(func slot) 参数数量+1 返回值数量+1,如果method有返回值,还需要增加把返回值存入eval stack的指令
br     无条件跳转到目标指令                                      分为跳转到当前指令之前的指令还是之后的指令,如果是之后的指令,需要预先计算出接下来若干.net指令转换到Lua指令后的数量计算偏移量,知道便宜量后就可以在                                                                   proto整体转换完成后在对应位置插入label,本指令转换为jmp $labelName
beq, bgt, bge, blt, ble, bne   比较两个值(eval stacktop-1和top),满足一定条件就jmp到目标指令                  len %1 %0; gettable %arg2 %0 %1; loadnil %3 0; settable %0 %1 %3; len %1 %0; 
                                                                 gettable %arg1 %0 %1; settable %0 %1 %3;lt 0 %arg1 %arg2; jmp 1 $labelOfNextIlInstruction; jmp 1 $targetLabel
brtrue, brfalse 如果eval stack top值是1/0就jmp到目标指令           类似的条件跳转
ret     结束当前函数栈并返回eval stack中的数据,需要根据当前.Net方法的返回类型是否void来判断返回数据
newarr  创建一个空数组放入eval-stack顶                                   newtable替代
newobj  创建一个空的未初始化对象放入eval-stack顶                          newtable替代
dup     把eval stack栈顶元素复制一份到eval-stack顶                    len %1 %0; gettable %2 %0 %1; add %1 %1 const 1; settable %0 %1 %2
cgt, clt, ceq   比较两个值(eval stack top-1 和 top)。如果第一个值大于第二个值(如果是Clt/Clt_Un,则是比较是否小于),则将整数值 1 (int32) 推送到计算堆栈上;反之,将 0 (int32) 推送到计算堆栈上     这里也转换成条件跳转
ldnull 加载null到eval stack
ldstr  加载字符串常量到eval stack
ldarg 从当前函数栈的参数列表中把某个参数复制到eval stack           
等等 

以上描述得虽然还有内容很少,但是足够实现C#的大部分语法对应的字节码转换到Lua5.3字节码了,比如类型,函数定义,函数参数,函数调用和返回值,if, for, while, break, continue, 变量赋值,比较操作符,数值操作,内置函数操作比如字符串连接和print等。以后有空再补充更多细节

Lua的一些坑的记录

Lua是一门很小巧的编程语言,不过使用过程中发下一些容易出现问题的地方,这里记录一下(API正常使用不记录)。记录时使用的版本是官方Lua 5.3.4版本源码.

  • Lua的table区分数组部分和哈希表部分,数组部分索引从1开始,而不是0-based

  • Lua的C API中的lua_isstring和lua_isnumber有点坑

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
LUA_API int lua_isnumber (lua_State *L, int idx) {
lua_Number n;
const TValue *o = index2addr(L, idx);
return tonumber(o, &n); // 坑,会执行转换成number类型改动栈
}
LUA_API int lua_isstring (lua_State *L, int idx) {
const TValue *o = index2addr(L, idx);
// 坑,这里逻辑是看能否转换成string,之后如果调用lua_tostring会改动栈中值,在遍历table判断key的时候就悲催了
return (ttisstring(o) || cvt2str(o));
}
-- 容易导致错误的使用比如
lua_State *L = luaL_newstate();
luaL_dostring(L, "a={};a[2]=123");
lua_getglobal(L, "a");
lua_pushnil(L);
while(lua_next(L, -2))
{
auto is_string_key = lua_isstring(L, -2);
if (lua_isstring(L, -2))
{
printf("%s=", luaL_checkstring(L, -2));
}
else if(lua_isinteger(L, -2))
{
printf("%d=", luaL_checkinteger(L, -2));
}
printf("%d\n", luaL_checkinteger(L, -1));
lua_pop(L, 1);
}
lua_close(L);
-- 以上这段代码会进程崩溃,因为错误的对int值进行了luaL_checkstring(或lua_tostring)导致当前lua虚拟堆栈被改写,然后lua_next的时候会找不到正确的key,然后报错崩溃
-- 而下面这样写就正常了
lua_State *L = luaL_newstate();
luaL_dostring(L, "a={};a[2]=123");
lua_getglobal(L, "a");
lua_pushnil(L);
while(lua_next(L, -2))
{
auto is_string_key = lua_isstring(L, -2);
if(lua_isinteger(L, -2))
{
printf("%d=", luaL_checkinteger(L, -2));
}
else if (lua_isstring(L, -2))
{
printf("%s=", luaL_checkstring(L, -2));
}
printf("%d\n", luaL_checkinteger(L, -1));
lua_pop(L, 1);
}
lua_close(L);
-- lua_isnumber也有类似问题,实现中是调用lua_tonumber看能否转换成number类型来判断,而这会改动lua虚拟堆栈结构,在遍历lua table的时候有问题
  • Lua的C API中的lua_type函数,得到的类型可以用来判断布尔,nil,字符串类型,比如lua_type(L, -1) == LUA_TSTRING,但是不能用来直接判断整数,不能lua_type(L, -1) == LUA_TNUMINT 因为Lua 5.3中虽然区分了int和number类型,把整数和浮点数区分出来了,但是lua_type的返回类型都是LUA_TNUMBER,LUA_TNUMINT和LUA_TNUMFLT都是LUA_TNUMBER进行偏移后的结果。需要判断类型的时候整数需要使用lua_isinteger(L,-1),浮点数需要使用lua_type(L, -1) == LUA_TNUMBER

  • Lua的一些函数比如#,ipairs, table中一些函数,都是只对Lua table中的数组部分起效果,建议不要对同一个lua table同时使用数组部分和哈希表部分,可能容易出错。我们的做法是对Lua语言做了修改,增加了可选的类型声明和编译期静态类型系统并区分了Array和Map类型,减少混用导致的问题。

  • Lua中的数学操作符,必须参数都是数字,注意使用时候不要错误使用了类型,包括nil也不行,比如+/-/*//还有其他一些数学操作符

  • 注意区分lua_pcall/lua_pcallk和lua_call/lua_callk的使用区分,前者是runproteced模式下运行,也就是会捕获运行时异常并处理,不对使用者再直接抛出异常崩溃.但是也不要乱用lua_pcall,只在最外层使用

  • 暂时就想到这些,以前可能也碰到一些其他问题没记录下来,以后我想起或者又碰到了再补充

一个简单的正则表达式和语法分析引擎的JavaScript实现parser.js

前段时间为了克服拖延症,花了几天时间把以前一直想填的一个小坑填了,就是这个parser.js库了 https://github.com/zoowii/parser.js

懒得写,就把readme.md抄一部分过来

Features

  • 实现了一个基于NFA的正则表达式引擎实现(正则表达式字符串的解析使用自身实现的底层API和下面的语法解析引擎来实现的),支持主要正则功能已经分组捕获等
  • 实现了一个语法解析引擎(支持左递归定义,语法定义简单)
  • 提供一个整合了词法分析和语法分析的API,方便使用,可以直接生成最终满足要求的抽象语法树(直接生成最初定义规则对应的抽象语法树,而不是解析过程中的中间产物)
  • 为了性能考虑,另外提供了一个使用内置正则引擎的快速词法分析实现,并且尽量兼容自己实现的正则API,从而可以在性能有问题时切换
  • 直接浏览器和Node.js环境,且不依赖任何第三方库

Demo

  • 正则表达式引擎demo
1
2
3
4
5
6
7
8
9
10
11
12
13
console.log('-----test regex string reader=====');
var expr1 = RegexReader.read("\"(a{3,})(b+)(([c\\s\\.\\d\\\\\\+\\u1234])*)");
expr1.build();
console.log('regex build done');
var r1 = expr1.match("aabbbc 123+556end");
var r2 = expr1.match("\"aaaabbbc 123+556");
// var expr2 = RegexReader.read("abc");
console.log(expr1.toString());
console.log(r1.toString());
console.log(r2.toString());
assert.equal(false, r1.matched);
assert.equal(true, r2.matched);
console.log('-----end test regex string reader-----');
  • 语法分析demo
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
console.log('-----test parser api-----');
parser.clearVarCache();
var syntaxParserAndTokener = parser.buildSyntaxTreeParser(V('json'), [
[V('bool'),
"(?:true|false)\\s*"],
[V('number'),
"(?:[+-]?(?:(0x[0-9a-fA-F]+|0[0-7]+)|((?:[0-9]+(?:\\.[0-9]*)?|\\.[0-9]+)(?:[eE][+-]?[0-9]+)?|NaN|Infinity)))\\s*"],
[V('string'),
"(?:(?:\"((?:\\.|[^\"])*)\"|'((?:\\.|[^'])*)'))\\s*"],
[V('name'),
V('string')],
[V('value'),
V('bool'), V('number'), V('string'), V('json-object'), V('json-array')],
[V('json-object-pair'),
[V('name'), ":\\s*", V('value')]],
[V('json-object-pairs'),
V('json-object-pair'),
[V('json-object-pair'), ",\\s*", V('json-object-pairs')]
],
[V('json-object'),
["\\{\\s*", V('json-object-pairs'), "\\}\\s*"]],
[V('values'),
V('value'),
[V('value'), ",\\s*", V('values')]],
[V('json-array'),
["\\[\\s*", V('values'), "]\\s*"]],
[V('json'),
V('json-object'), V('json-array'), [V("\\s+"), V('json')]]
]);
var jsonParser = syntaxParserAndTokener.parser;
var tokenPatterns = syntaxParserAndTokener.token_patterns;
var text = '{"name": "zoowii", "age": 24, "position": {"country": "China", "city": "Nanjing"}}';
var tokens = parser.generateTokenListUsingInnerRegex(tokenPatterns, text, console.log);
var json = jsonParser.parse(tokens);
console.log(json.toString());
console.log('-----end test parser api-----');

目前支持的正则表达式特性

  • ‘|’
  • ( … ) group
  • \d digit
  • \w alpha or digit
  • \uabcd unicode char support
  • a-b char range
  • [abc] union
  • [^abc] except union
  • abc concat
  • a+ repeat at least one times
  • a* repeat at least zero times
  • a? repeat one or zero times
  • a{m[,n]} repeat at least m times [and at most n times]
  • . any char
  • \s space
  • \ + * { [ ( | \? . - … escape

一个把hibernate/jpa/jdbc封装成类似ActiveRecord风格API的数据库操作库jpa-utils

本博客系统使用Java Web实现,其中数据库层操作虽然直接写SQL或者使用MyBatis比较可控,
但是我对于快糙猛的项目一向懒得慢慢写,所以挺久之前封装过一个类似ActiveRecord的数据库操作库,
是对Hibernate/JPA/jdbc的封装,从而在上层使用时比较方便,又可以随时fallback到使用下层的Hibernate/JPA/jdbc. 项目名叫做jpa-utils

项目地址: [https://github.com/zoowii/jpa-utils](https://github.com/zoowii/jpa-utils)

目前的特性包括

  • 底层基于JPA或者Hibernate的Session/SessionFactory,基于HQL/SQL,比自己再轮一个类HQL稳定
  • 也提供直接基于jdbc的支持,从而可以不依赖Hibernate等ORM,也方便直接和jdbc Connection, MyBatis, DbUtils, 数据库连接池等库直接集成使用
  • 直接基于jdbc Connection的话,ORM映射部分目前只支持MySQL和H2数据库,其他数据库待支持
  • 可以自动从JPA配置创建管理session,也可以手动指定EntityManagerFactory/EntityManager/SessionFactory(hibernate)/Session(hibernate)来构造jpa-utils中的Session来使用,还可以直接从jdbc Connection构造Session
  • 提供类似ActiveRecord的使用方便友好的API,特别是查询API
  • 查询的核心Finder类可以单独使用,直接使用到现有的使用JPA或Hibernate的代码中,只需要根据现有EntityManager/Session(hibernate)构造一个jpa-utils的session,然后使用Finder类来查询就好了
  • 支持类似MyBatis的执行编程式XML中的SQL(TODO)

因为没有发布到公网maven repo,所以如果要用,要么maven install,要么发布到自己meven repo私服,要么mvn package成jar后自己使用

使用DEMO

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
// maven
!!! First deploy it to you local maven nexus, then.
<dependency>
<groupId>com.zoowii</groupId>
<artifactId>jpa-utils</artifactId>
<version>x.y.z</version>
</dependency>
// create
Session session = EntitySession.currentSession(); // or Session.getSession(persistentUnitName);
session.begin();
try {
for (int i = 0; i < 10; ++i) {
Employee employee = new Employee();
employee.setName("employee_" + StringUtil.randomString(10));
employee.setAge(new Random().nextInt(100));
employee.save(); // or employee.save(session);
logger.info("new employee " + employee.getId());
}
session.commit();
} catch (Exception e) {
e.printStackTrace();
session.rollback();
}
// query
Session session = Session.currentSession();
session.begin();
try {
Query<Employee> query = Employee.find.where().gt("age", 50);
query = query.limit(8);
List<Employee> employees = query.all(); // or query.all(session);
for (int i = 0; i < employees.size(); ++i) {
Employee employee = employees.get(i);
logger.info((i + 1) + ". employee " + employee.getId());
}
logger.info("total: " + query.count()); // or query.count(session);
session.commit();
} catch (Exception e) {
e.printStackTrace();
session.rollback();
}

程序语言的词法作用域中同名变量的rename

TODO

关于在实现程序语言中,如何实现对不同词法作用域中同名变量的rename操作,从而下一步操作更加方便.

比如把如下代码

1
2
3
4
5
6
function func1() {
var name = "zoowii";
function func2(name) {
return "Hello, " + name;
}
}

自动修改为

1
2
3
4
5
6
function func1() {
var name = "zoowii";
function func2(name_unique_2) {
return "Hello, " + name_unique_2;
}
}

先记下来,有空再写

一个js的小玩具ring.js,类似Ring风格的一个web-framework

前段时间一时兴起,弄了个新玩具,ring.js, 项目地址https://github.com/zoowii/ring.js

这是一个非常简陋的类似于Clojure的Ring库的node.js框架

使用Demo

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
function helloHandler(req, name) {
return 'hello, ' + name;
}
function fileTestHandler(req, path) {
return new ring.FileStream('/Users/zoowii/SystemVersion.plist');
}
app = ringMiddlewares.routesMiddleware(app, defroutes(
GET('/', 'index', 'index'),
GET('/hello/:name', helloHandler),
GET("/test/:id/update", "test-handler", "test"),
GET('/test/file/:*path', fileTestHandler, 'file-test'),
context("/user", [
GET("/:id/view/:project/:*path", "view_user_handler", "view_user"),
POST("/:id/view/:project/:*path", "update_user_handler", "update_user")
]),
ANY("/:*path", '404-handler', '404')
));
app = ringMiddlewares.resourceMiddleware(app, '/static', __dirname);
var server = httpAdapter(app, {
port: 3000
});
server.start(function () {
console.log('listening at http://127.0.0.1:3000');
});

ring.js概念

ring.js包括handler, middleware, adapter, request, response这些对象的概念

handler

handler是一个接受request返回response的函数,整个ring.js的webapp就是一个handler

middleware

middleware是一个接受若干个handlers和options配置的函数,返回一个新的handler

adapter

adapter封装底层http库等协议,在adapter上可以运行ring.js的webapp,也就是handler. adapter是一个接受一个handler(暴露的ring.js webapp)和options的函数,options可以包括address, port等信息 当一个新请求到来时,adapter封装这个请求成一个request,交给参数中的handler,然后把返回的response作为http回复

request

request代表一个http请求,是一个javascript object,结构如下:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
{
server_port: (required, int),
upgrade: (required, boolean), // true/false
server_name: (required, string),
remote_addr: (required, string), // 请求发送方或者最后一层代理的地址
uri: (required, string), // 请求uri, 以'/'开头
query_string: (optional, map),
scheme: (required, string), // 传输协议,目前支持http和https, 转换成小写
http_version: (optional, string), // http协议版本,比如1.1
request_method: (required, string), // 请求方法, 转换成小写,包括get, post, head, put, delete等
content_type: (optional, string),
content_length: (optional, int),
character_encoding: (optional, string), // 用来转换request body的编码
ssl_client_cert: (optional, byte[]), // 客户端SSL证书
headers: (required, map), // http头信息, header name都转换成小写
body: (optional, stream) // http请求body
}

response

response代表一个http回复,是一个javascript object,或者是一个future对象,如果response是一个map,结构如下:

1
2
3
4
5
{
status: (required, int), // >= 100, http status code
headers: (required, map), // http回复的头信息
body: (optional, string/其他对象的array/iterator/file/stream/上面对象的future, // http回复的body
}

如果response是一个future对象,则监听这个future对象的data事件和end事件,获取到map形式的response chunk并输出

一个将Chrome中打开的标签页都在Safari中打开的AppleScript脚本

因为我更喜欢使用Chrome作为日常浏览网页的浏览器,但是经常点着点着就打开了一大票标签页,然后一时间有没时间看完,这些东西有些也许就是一次性看完就扔的,保存到pocket感觉太大材小用而且容易让pocket中充满各种”垃圾”,如果关掉的话将来再找也麻烦.

所以我一般喜欢把这些标签页都拷贝到不是最常用的Safari浏览器中,方便下次阅读.

前两天我在QQ群里灌水时说到这个问题,然后听@Dawn提到AppleScript好像可以解决这个问题.以前对AppleScript只听过没见过,今天晚上搜了下,果然神器,于是Google了一下找了几段demo代码对照着写了个,感觉还可以,对于一些小工具性质的软件来说,applescript实在是太方便了.

这个AppleScript脚本虽然只有10几行,但是已经可以完成将当期chrome窗口中打开的标签页都在Safari中打开了,达到了我的目标,很好.

直接上代码:

https://gist.github.com/zoowii/b1818fae22792e4e9bab

tell application "Google Chrome"
 set cur_win to first window
 tell cur_win
  set urls to URL of tabs of cur_win
  set numOfUrls to (count urls)
  -- repeat with i from 1 to (numOfUrls)
  repeat with itemUrl in (urls)
   -- set itemUrl to (item i of urls)
   tell application "Safari" to tell first window to open location itemUrl
  end repeat
  tell application "Safari" to activate
  tell application "Safari" to display dialog "Move tabs from Chrome to Safari successfully"
 end tell
end tell

下载地址: http://pan.baidu.com/s/1sjHHmXJ

Scheme实现的通用尾递归识别算法的demo实现,终于想到来些,拖延症...

几个月前,我有写过一篇博客, /2013/12/21/浅谈尾递归的定义和判定方法/ ,描述了一种用来识别简单和复杂尾递归的通用算法,后来还写了一篇博客描述了尾递归优化算法使用代码变换方式的一种实现算法(通过另外的基于continuation的计算模型也可以直接实现尾递归优化,因为那样没有了栈机制), 之后我一直想写代码去具体实现,终于,今天晚上QQ群灌水到没人在线时我打算来写一下了.

今天晚上只写了尾递归的识别算法的实现,而且没有做什么测试,写得匆忙,加上最近用Clojure,已经忘了scheme API怎么用了,所以,代码质量和鲁棒性不敢恭维,有问题看上面博客吧.

Github项目: https://github.com/zoowii/tail-rec-optimization

先直接上代码(https://gist.github.com/zoowii/6932942e8661f8544ee3)

# lang racket
;; 这里是示例代码,这段代码在Scheme中是可以执行的,因为Scheme标准规定了需要尾递归优化


;; 而对应的JavaScript代码是无法运行的,因为没有做尾递归优化,很快就超过最大调用深度了


(define (foo n)


 (if (> n 20140000)


    (begin


      (display "foo")


       n)


    (bar (+ n 1))))


(define (bar n)


  (if (> n 20130000)


     (begin


        (display "bar")


         n)


     (foo (+ n 2))))


(display (foo 1234))





;; 下面开始实际程序


(define call/cc call-with-current-continuation)





;; 这里是上面的示例代码,program就是实际使用中的程序代码(宏展开后)


(define program '((define (foo n)


 (if (> n 20140000)


    (begin


      (display "foo")


       n)


    (bar (+ n 1))))


(define (bar n)


  (if (> n 20130000)


     (begin


        (display "bar")


         n)


     (foo (+ n 2))))


(foo 1234) ; 这里没有加上display,是为了方便程序找到这个需要尾递归优化的函数foo


  ))





(define (id form)


  ;; 辅助函数,一个返回参数自身的函数


  form)





(define (procedure-definition? form)


  ;; 判断一个form是不是一个函数定义


  (if (and (list? form)


           (> (length form) 2)


           (eq? (car form) 'define)


           (list? (cadr form))


           (> (length (cadr form)) 1)


           )


      #t


      #f))





(define (find-procedure-definitions program)


  ;; 找到一段程序中所有的函数定义的名称


  (filter id


          (map (lambda (form)


                 (if (procedure-definition? form)


                     (caadr form)


                     #f))


               program)))





(define (name-of-proc-definition proc-definition)


  ;; 在一个函数定义的代码中获取函数名称


  (caadr proc-definition))





(define (find-func-calls program)


  ;; 找到一段程序中除了函数定义之外的函数调用,比如(foo 1234)


  (filter id


          (map (lambda (form)


                 (if (procedure-definition? form)


                     #f


                     form)) program)))





(define (func-called program)


  ;; 找到一段程序中所有顶层被调用的函数,除了函数定义这类special form


  (map (lambda (form) (car form))


       (find-func-calls program)))





(define (get-proc-definition program func)


  ;; 在一段程序中找到某个函数的定义代码


  (let ([procs (filter (lambda (f)


                        (equal? (name-of-proc-definition f)


                           func))


                      (filter procedure-definition?


                              program))])


    (car procs)))





(define (merge cols)


  ;; 合并一组列表


  (if (empty? cols)


      '()


      (let ([l1 (car cols)]


            [ll (cdr cols)])


        (if (empty? l1)


            (merge ll)


            (cons (car l1)


                  (merge (cons (cdr l1) ll)))))))





(define (get-last-exprs forms)


  ;; 获取一个form集合中所有可能最后执行的form


  (merge


   (map (lambda (form)


         (cond  ;; 目前只考虑if和begin两种结构化,因为只是demo,如果是具体的编译器/解释器,自行获取最后可能执行的form


           [(not (list? form))


            (list form)]


           [(equal? 'if (car form))


            (if (> (length form) 3)


                (get-last-exprs (list (caddr form)


                      (cadddr form)))


                (get-last-exprs (list (caddr form))))]


           [(equal? 'begin (car form))


            (get-last-exprs (list (last form)))]


           [#t (list form)]))


       forms)))





(define (get-body-of-proc-definition proc-definition)


  ;; 获取一个函数定义代码段中的body部分


  (cddr proc-definition))





(define (base? form)


  ;; 判断一个form是否是基本类型,比如数值,字符串,布尔值,符号symbol


  ;; 也就是是否不是list


  (not (list? form)))





;;; 要记住在一个函数在一个函数集中尾递归依赖的函数


(define (find-tail-rec-required-funcs func program)


  ;; 找到一个函数的尾递归依赖的函数集(就是尾部调用的函数,没有地柜调用)


  ;; 没有考虑更复杂的词法作用域,匿名函数等,这些由具体编译器/解释器的实现来判断


  (let* ([func-body (get-body-of-proc-definition


                    (get-proc-definition program func))]


        [last-exprs (get-last-exprs func-body)]


        [last-exprs-requirements (map


                                  (lambda (form)


                                    (if (base? form)


                                        #t


                                        (let ([item1 (car form)])


                                          (if (list? item1)


                                              #f


                                              item1))))


                                  last-exprs)])


    last-exprs-requirements))





(define (into-set item col)


  ;; 在一个集合中添加一项,如果这个值已经存在,则不添加(也就是当做set)处理


  (if (member item col)


      col


      (cons item col)))





(define (sub-set col1 col2)


  ;; 判断col1是否是col2的子集


  (let* ([diff (filter (lambda (x)


                         (not (member x col2)))


                       col1)])


    (empty? diff)))





(define (find-requirements-col func program col C-col)


  ;; 在一个集合中找到依赖函数集


  ;; 过程就是找到尾部依赖的内容,进行判断,如果是一个函数调用,判断这个函数是否已经加入到col中,以及其他判断和操作


  ;; 如果不是尾递归的,返回#f, 如果是尾递归的, 返回#t, 如果依赖一个函数集,返回这个函数集


  ;; C-col记录依赖集的作用范围, col记录依赖的函数


  (let* ([last-exprs (find-tail-rec-required-funcs func program)])


    (if (member #f last-exprs)


        (list #f C-col)


        (let* ([exprs (filter (lambda (x) (and (not (boolean? x))


                                              (not (member x col))


                                              (not (equal? x func))))


                              last-exprs)]


               [new-col (merge (list col))]


               [C-col (merge (list col exprs))]


               [exprs-require (map (lambda (x)


                                     (find-requirements-col x program new-col C-col))


                                   exprs)]


               [exprs-require (filter (lambda (x)


                                        (not (boolean? x)))


                                      (map car exprs-require))])


          (if (empty? exprs)


              (list #t C-col)


              (if (member #f exprs-require)


              (list #f C-col)


              (let* ([exprs-require (filter (lambda (rs)


                                           (not (sub-set rs new-col)))


                                         exprs-require)]


                     [new-col (merge (list (merge exprs-require) new-col))])


                (if (and (= 1 (length new-col))


                         (equal? func (car new-col)))


                    (list #t C-col)


                    (list new-col C-col)))))))))





(define (find=tail-rec-of-func program func)


  ;; 在一段程序中判断函数func是否是尾递归的,


  ;; 如果是,返回使尾递归成立的最小函数集合(范围),


  ;; 否则,返回nil


  (find-requirements-col func program (list func) (list func)))





(define (println . args)


  (begin


    (map (lambda (x) (display x)) args)


    null))





(define (find-tail-rec program)


  ;; 找到一段程序中的所有尾递归


  ;; 目前为了简单起见,而且demo代码中顶层只有一个函数调用(foo 1234)。所以只考虑最后一个函数调用,作为要判断尾递归优化的目标


  (let* ([funcs (func-called program)]


        [rec-states (map (lambda (func)


                           (find=tail-rec-of-func program func))


                         funcs)])


    (display "函数调用列表(实际被调用了的函数,没被调用的函数不通过转换代码实现尾递归优化):\n=======\n")


    (map (lambda (func)


           (begin


             (display func)


             (newline)))


         funcs)


    (display "=======\n")


    (map (lambda (func answer)


           (begin


             (println "--- 函数 " func " ---\n")


             (if (equal? #t (car answer))


                 (begin


                   (println "可以尾递归优化,在函数集 " (cadr answer) "中\n"))


                 (if (equal? #f (car answer))


                     (println "不可以尾递归优化\n")


                     (begin


                       (println "不可以尾递归优化,依赖函数集 " (cadr answer "\n")))))))


         funcs rec-states)


    null))





;; (display (func-called program))


;; (newline)


;; (define foo-def (get-proc-definition program 'foo))


;; (define foo-body (get-body-of-proc-definition foo-def))


;; (define foo-last-forms (get-last-exprs foo-body))


;; (display foo-last-forms)


;; (newline)





;; (display (find-tail-rec-required-funcs 'foo program))


;; (newline)





;; (display (find-requirements-col 'foo program '(foo) '(foo)))  ;; => '(#t (foo bar))





(println (find-tail-rec program))

代码在Racket下得执行结果如下:

算法的具体描述看上面提到的博客.

在Heroku上部署Clojure worker程序

前几天想起Heroku上可以有worker程序,可以部署在后台一直运行的程序,而不是只可以部署web网站,真好VPS上跑的程序已经够多了,就把一个Clojure写的小程序部署上去了。

在部署这个Clojure程序中,有一些要注意的问题,特此记录。

首先就是,再Clojure项目的Leiningen的project.clj中,需要加入:main 指向起始函数-main所在的Clojure namespace,同时这个clojure namespace需要在ns定义处加上:gen-class限定(起始不一定是-main函数,可以给:gen-class传递参数指定函数前缀,默认是’-‘,会对应生成的Java类中的不带前缀的方法)。其实这不属于和Heroku部署特定相关的,而是所有Leiningen项目打包成可启动jar程序都要做的事。

第二点是,再project.clj中显示指定:uberjar-name指定打包成的jar包名称,方便在Procfile中指定路径,另外还要显示指定:min-lein-version 为”2.0.0”(或者更高),这是因为我使用了Lein 2,而Heroku默认的Lein版本不是,不指定会启动失败

第三点,我开始也没发现错误原因,是再看heroku logs的时候才发现的,直接按上面步骤再git push部署后,heroku logs中会报版本错误,这是因为Heroku现在默认是使用Java 6,而我项目中依赖Java 7,所以也需要显示指定Java版本,返回就是在项目根目录下新建一个名为system.properties的文本文件,内容是 java.runtime.version=1.7

到这一步就差不多了,然后就可以git push部署了。

之后还有一个小问题,也许你会发现git push后的程序无法执行,这是因为再Heroku Apps中的你这个应用的配置还是使用的web role数量为1,worker role数量为0,没有worker role当然无法运行了。所以只需要再Heroku管理界面中将web role设为0,worker role设为1即可。

完成。

感慨一下,Heroku实在是一个很好的PaaS平台,开发和部署都非常方便,文档也很不错,也不像GAE和SAE那样限制多多。最赞的是支持worker role。

可惜在天朝速度实在太慢,好在worker role不在乎这点