supporting for swf

diff --git a/example/class.scm b/example/class.scm
index 2549347..e43e811 100644 (file)
--- a/example/class.scm
+++ b/example/class.scm
@@ -5,10 +5,7 @@
 ;;; 10
 
 (define-class Foo Object
-  ((init x) (print x))
+  ((init x) (let ((t 10) (print t))))
   ((f    x) (print x)))
 
-(print Foo)
 (define foo (new Foo 42))
-(print foo)
-(invoke foo f 10)
\ No newline at end of file

diff --git a/src/ast.ml b/src/ast.ml
index 3ab7e9d..78336f3 100644 (file)
--- a/src/ast.ml
+++ b/src/ast.ml
@@ -16,7 +16,7 @@ type expr =
   | Let    of (string*expr) list * expr
   | LetRec of (string*expr) list * expr
   | Block  of expr list
-  | New    of string * expr list
+  | New    of name * expr list
   | Invoke of expr   * string * expr list (* (invoke <object> <method-name> <arg1> <arg2>...)*)
 
 (** statement has side-effect *)
@@ -105,8 +105,8 @@ let rec to_string =
          Printf.sprintf "LetRec (%s,%s)" decl' body'
     | Block exprs ->
        Printf.sprintf "Block [%s]" @@ String.concat "; " @@ List.map to_string exprs
-    | New (name,args) ->
-       Printf.sprintf "New (%s,[%s])" name @@
+    | New ((ns,name),args) ->
+       Printf.sprintf "New (%s:%s,[%s])" ns name @@
          String.concat "; " @@ List.map to_string args
     | Invoke (obj,name,args) ->
        Printf.sprintf "Invoke (%s,%s,[%s])"

diff --git a/src/ast.mli b/src/ast.mli
index 0153896..557d140 100644 (file)
--- a/src/ast.mli
+++ b/src/ast.mli
@@ -16,7 +16,7 @@ type expr =
   | Let    of (string*expr) list * expr
   | LetRec of (string*expr) list * expr
   | Block  of expr list
-  | New    of string * expr list
+  | New    of name * expr list
   | Invoke of expr   * string * expr list (* (invoke <object> <method-name> <arg1> <arg2>...)*)
 
 (** A type of statement. Statement has side-effect *)

diff --git a/src/codegen.ml b/src/codegen.ml
index b837654..35f72d4 100644 (file)
--- a/src/codegen.ml
+++ b/src/codegen.ml
@@ -7,7 +7,7 @@ type bind = Scope of int | Register of int | Global
 type env  = {depth:int; binding: (string * bind) list }
 
 let empty_env =
-  {depth=0; binding=[]}
+  {depth=0; binding=[("this",Register 0)]}
 
 let add_scope names {depth=n;binding=xs} =
   let names' =
@@ -25,6 +25,9 @@ let add_register names env =
     ExtList.List.mapi (fun i name-> name,Register (i+1)) names in
     {env with binding = names'@env.binding}
 
+let add_this env =
+  {env with binding = ("this",Register 0)::env.binding}
+
 let get_bind name {binding=xs} =
   List.assoc name xs
 
@@ -84,9 +87,9 @@ let rec generate_expr expr env =
     | Int n when 0 <= n && n <= 0xFF -> [PushByte n]
     | Int n      -> [PushInt n]
     | Block xs   -> List.concat @@ interperse [Pop] @@ (List.map gen xs)
-    | New (name,args) -> 
+    | New ((ns,name),args) ->
        let qname =
-         make_qname name in
+         make_qname ~ns:ns name in
        List.concat [
          [FindPropStrict qname];
          HList.concat_map gen args;
@@ -112,6 +115,7 @@ let rec generate_expr expr env =
                [GetGlobalScope;
                 GetProperty qname]
            | _ ->
+               print_endline ("NotFound: " ^ name);
                [GetLex qname]
          end
     | Let (vars,body) ->
@@ -233,7 +237,7 @@ let generate_stmt env stmt =
          env',body'
     | Class (name,(ns,sname),body) ->
        let env' = 
-         add_global name env in
+         add_this @@ add_global name env in
        let name' =
          make_qname name in
        let sname' = 

diff --git a/src/lisp.ml b/src/lisp.ml
index d8e6f36..af1c98f 100644 (file)
--- a/src/lisp.ml
+++ b/src/lisp.ml
@@ -48,7 +48,7 @@ let rec make_expr =
                List.map make_expr body in
              Ast.Lambda (List.map ensure_symbol args,Ast.Block body')
          | Symbol "new"::Symbol name::args ->
-             Ast.New (name,List.map make_expr args)
+             Ast.New (split_ns name,List.map make_expr args)
          | Symbol "invoke"::obj::Symbol name::args ->
              Ast.Invoke ((make_expr obj),name,(List.map make_expr args))
          | _ ->

diff --git a/test/test_lisp.ml b/test/test_lisp.ml
index 8390087..cbf826a 100644 (file)
--- a/test/test_lisp.ml
+++ b/test/test_lisp.ml
@@ -90,11 +90,11 @@ test lammda_with_args =
       compile_string "(lambda (a b c) 42)"
 
 test new_klass =
-  assert_equal (result (New ("Foo",[]))) @@
+  assert_equal (result (New (("","Foo"),[]))) @@
     compile_string "(new Foo)"
 
 test new_klass_args =
-  assert_equal (result (New ("Foo",[Int 1;Int 2]))) @@
+  assert_equal (result (New (("","Foo"),[Int 1;Int 2]))) @@
     compile_string "(new Foo 1 2)"
 
 test invoke =