From df7b2c79dea61c035b8617e3a6337896f64d2dfd Mon Sep 17 00:00:00 2001 From: MIZUNO Hiroki Date: Sat, 23 Aug 2008 12:43:04 +0900 Subject: [PATCH] Fix: script(toplevel) returns no value. --- example/class.scm | 4 +--- src/codegen.ml | 13 +++++++------ test/test_codegen.ml | 37 ++++++++++++++++++++----------------- 3 files changed, 28 insertions(+), 26 deletions(-) diff --git a/example/class.scm b/example/class.scm index 77be679..4ee2f26 100644 --- a/example/class.scm +++ b/example/class.scm @@ -1,8 +1,6 @@ ;; Example for class definition -;;; [class Foo] -;;; 42 +;;; 12 ;;; [object Foo] -;;; 10 (define-class Foo Object ((init x) (let ((t 10)) diff --git a/src/codegen.ml b/src/codegen.ml index 6efae37..49499ce 100644 --- a/src/codegen.ml +++ b/src/codegen.ml @@ -212,10 +212,11 @@ and generate_expr expr env = gen alt; [Label l_if]] + let generate_stmt env stmt = match stmt with Expr expr -> - env,(generate_expr expr env) + env,(generate_expr expr env)@[Pop] | Define (name,body) when not @@ is_bind name env -> let env' = add_current_scope name env in @@ -241,7 +242,7 @@ let generate_stmt env stmt = env',body' | Class (name,(ns,sname),body) -> let env' = - add_this @@ add_global name env in + add_global name env in let name' = make_qname name in let sname' = @@ -253,7 +254,7 @@ let generate_stmt env stmt = List.fold_left (fun (init',cinit',methods') (name,args,body) -> let args',body' = - generate_lambda args body env' in + generate_lambda args body (add_global name empty_env) in match name with "init" -> (Asm.make_proc ~args:args' name (prefix@body'), @@ -263,7 +264,8 @@ let generate_stmt env stmt = Asm.make_proc ~args:args' name body', methods') | _ -> - (init',cinit',(Asm.make_meth ~args:args' name body')::methods')) + (init',cinit', + (Asm.make_meth ~args:args' name body')::methods')) (make_proc "init" prefix,make_proc "cinit" [],[]) body in let klass = { @@ -288,7 +290,6 @@ let generate_stmt env stmt = Swap; InitProperty name'] - let generate_program xs env = List.concat @@ snd @@ map_accum_left generate_stmt env xs @@ -297,7 +298,7 @@ let generate_method xs = add_scope ["this"] empty_env in let program = generate_program xs init_env in - Asm.make_meth "" ([GetLocal_0;PushScope] @ program) + Asm.make_proc "" ([GetLocal_0;PushScope] @ program) let generate program = let m = diff --git a/test/test_codegen.ml b/test/test_codegen.ml index 53b600d..df17d37 100644 --- a/test/test_codegen.ml +++ b/test/test_codegen.ml @@ -35,8 +35,11 @@ let make_meth args inst = { traits=[]; exceptions=[]} +let expr inst = + make_meth [] ([GetLocal_0;PushScope]@inst@[Pop;ReturnVoid]) + let toplevel inst = - make_meth [] ([GetLocal_0;PushScope]@inst@[ReturnValue]) + make_meth [] ([GetLocal_0;PushScope]@inst@[ReturnVoid]) let inner args inst = make_meth args (inst@[ReturnValue]) @@ -50,7 +53,7 @@ let compile x = (** test *) test lib_call = assert_equal - (toplevel [FindPropStrict (qname "print"); + (expr [FindPropStrict (qname "print"); PushString "Hello"; CallPropLex ((qname "print"),1)]) (compile (Call [Var "print";String "Hello"])) @@ -58,37 +61,37 @@ test lib_call = (* literal *) test int = assert_equal - (toplevel [PushByte 42]) + (expr [PushByte 42]) (compile (Int 42)) test int_opt = assert_equal - (toplevel [PushByte 42]) + (expr [PushByte 42]) (compile (Int 42)); assert_equal - (toplevel [PushInt 300]) + (expr [PushInt 300]) (compile (Int 300)) test string = assert_equal - (toplevel [PushString "Thanks for All the Fish"]) + (expr [PushString "Thanks for All the Fish"]) (compile (String "Thanks for All the Fish")) (* builtin operator *) test add = assert_equal - (toplevel [PushByte 1;PushByte 2;Add_i;]) + (expr [PushByte 1;PushByte 2;Add_i;]) (compile (Call [Var "+";Int 1;Int 2])) test boolean = assert_equal - (toplevel [PushByte 1;PushByte 2;Equals]) + (expr [PushByte 1;PushByte 2;Equals]) (compile (Call [Var "=";Int 1;Int 2])) (* complex expression *) test block = assert_equal - (toplevel [PushByte 1;Pop;PushByte 2]) + (expr [PushByte 1;Pop;PushByte 2]) (compile (Block [Int 1;Int 2])) test if_ = @@ -96,7 +99,7 @@ test if_ = Label.peek 0 in let b = Label.peek 1 in assert_equal - (toplevel [PushByte 10; PushByte 20; + (expr [PushByte 10; PushByte 20; IfNe a; PushByte 0; Jump b; Label a;PushByte 1; Label b]) (compile (If ((Call [Var "=";Int 10;Int 20]),Int 0,Int 1))) @@ -104,7 +107,7 @@ test if_ = (* scope *) test let_ = assert_equal - (toplevel [PushString "x"; PushByte 1; + (expr [PushString "x"; PushByte 1; PushString "y"; PushByte 2; NewObject 2; PushWith; @@ -119,7 +122,7 @@ test let_ = test letrec = assert_equal - (toplevel [NewObject 0; + (expr [NewObject 0; PushWith; GetScopeObject 1; PushByte 42; @@ -159,27 +162,27 @@ test closure = (* function call *) test call = assert_equal - (toplevel [NewFunction (inner [] [PushByte 42]) ]) + (expr [NewFunction (inner [] [PushByte 42]) ]) (compile (Lambda ([],Block [Int 42]))) test call_with_args = assert_equal - (toplevel [NewFunction (inner [0;0] [GetLocal 2])]) + (expr [NewFunction (inner [0;0] [GetLocal 2])]) (compile (Lambda (["x";"y"],Block [Var "y"]))) test new_ = assert_equal - (toplevel [FindPropStrict (make_qname "Foo");ConstructProp (make_qname "Foo",0)]) + (expr [FindPropStrict (make_qname "Foo");ConstructProp (make_qname "Foo",0)]) (generate_method @@ Lisp.compile_string "(new Foo)") test new_ = assert_equal - (toplevel [FindPropStrict (make_qname "Foo");PushByte 42;ConstructProp (make_qname "Foo",1)]) + (expr [FindPropStrict (make_qname "Foo");PushByte 42;ConstructProp (make_qname "Foo",1)]) (generate_method @@ Lisp.compile_string "(new Foo 42)") test invoke = assert_equal - (toplevel [GetLex (make_qname "x");PushByte 10;CallProperty (make_qname "foo",1)]) + (expr [GetLex (make_qname "x");PushByte 10;CallProperty (make_qname "foo",1)]) (generate_method @@ Lisp.compile_string "(invoke x foo 10)") -- 2.11.0