type program = stmt list
+module Set = Core.Std.Set
+type 'a set = 'a Set.t
+
+let set_of_list xs =
+ List.fold_left (flip Set.add) Set.empty xs
+
(*
Features:
- convert DefineClass & DefineMethod to Ast.Class
());
tbl
-let classize program tbl =
- HList.concat_map
+let methods_set program =
+ set_of_list @@ HList.concat_map
(function
- Plain stmt ->
- [stmt]
- | DefineClass (klass,super,_) ->
- [Ast.Class (klass,super,Hashtbl.find_all tbl klass)]
- | DefineMethod _ ->
+ DefineMethod (name,_,_,_) ->
+ [name]
+ | _ ->
[]) program
+let expr_trans set =
+ function
+ Ast.Call ((Ast.Var f)::obj::args) when Set.mem f set ->
+ Ast.Invoke (obj,f,args)
+ | e ->
+ e
+
+let stmt_trans tbl set =
+ function
+ Plain stmt ->
+ [Ast.lift_stmt (expr_trans set) stmt]
+ | DefineClass (klass,super,_) ->
+ [Ast.Class (klass,super,Hashtbl.find_all tbl klass)]
+ | DefineMethod _ ->
+ []
+
let trans program =
- classize program @@ methods_table program
+ let tbl =
+ methods_table program in
+ let methods =
+ methods_set program in
+ program +> HList.concat_map (stmt_trans tbl methods)
let to_string =
function
Plain (Expr (Int 42));
DefineMethod ("f",("self","Foo"),["x"],Int 42)] in
assert_equal expect @@ trans source
+
+test invoke =
+ let expect =
+ [Class ("Foo",("bar","Baz"),
+ [("f",["self";"x"],Int 42)]);
+ Expr (Invoke (Var "obj","f",[Int 10]))] in
+ let source =
+ [DefineClass ("Foo",("bar","Baz"),[]);
+ DefineMethod ("f",("self","Foo"),["x"],Int 42);
+ Plain (Expr (Call [Var "f";Var "obj";Int 10]))] in
+ assert_equal expect @@ trans source