Refactoring ast module

diff --git a/example/closure.scm b/example/closure.scm
index 3a36cf9..40326fe 100644 (file)
--- a/example/closure.scm
+++ b/example/closure.scm
@@ -1,7 +1,15 @@
 ;;; 42
+;;; 10
 (define (f)
   (let ([x 42])
     (lambda () x)))
 
+(define (const x)
+  (lambda (y)
+    x))
+
 (define g (f))
-(print (g))
\ No newline at end of file
+(print (g))
+
+(define h (const 10))
+(print (h 20))
\ No newline at end of file

diff --git a/src/ast.ml b/src/ast.ml
index 7c37df7..3b64c85 100644 (file)
--- a/src/ast.ml
+++ b/src/ast.ml
@@ -61,34 +61,27 @@ let rec free_variable =
        StringSet.empty
 
 (** {6 Environment function} *)
-type bind = Scope of int * int | Register of int
-type env  = int * (string * bind) list
+type bind = Scope of int  | Register of int
+type env  = {depth:int; binding: (string * bind) list }
 
 let empty_env =
-  (-1,[])
+  {depth=0; binding=[]}
 
-let add_scope names ((scope,env) : env) =
-  let scope' =
-    scope + 1 in
+let add_scope names {depth=n;binding=xs} =
   let names' =
-    ExtList.List.mapi (fun i name-> name,Scope (scope',i)) names in
-    scope',names' @ env
+    List.map (fun name-> name,Scope n) names in
+    {depth=n+1; binding=names' @ xs}
 
-let add_current_scope name ((scope,env) : env) =
-  let i =
-    try
-      fst @@ ExtList.List.findi (fun _ (_,x) -> match x with Scope _ -> true | _ -> false) env 
-    with Not_found ->
-      -1 in
-    scope,(name,Scope (scope,i+1))::env
+let add_current_scope name {depth=n;binding=xs} =
+    {depth=n; binding=(name,Scope (n-1))::xs}
 
-let add_register names ((scope,env) : env) =
+let add_register names env =
   let names' = 
     ExtList.List.mapi (fun i name-> name,Register (i+1)) names in
-    scope,names' @ env
+    {env with binding = names'@env.binding}
 
-let get_bind name (_,env) =
-  List.assoc name env
+let get_bind name {binding=xs} =
+  List.assoc name xs
 
 let get_bind_sure name state =
   try
@@ -96,13 +89,13 @@ let get_bind_sure name state =
   with Not_found ->
     None
 
-let is_bind name (_,env) =
-  List.mem_assoc name env
+let is_bind name {binding=xs} =
+  List.mem_assoc name xs
 
 let ensure_scope name env =
   match get_bind name env with
-      Scope (x,y) -> 
-       x,y
+      Scope x -> 
+       x
     | _ ->
        failwith ("scope not found:"^name)
 
@@ -162,14 +155,13 @@ let rec generate_expr expr env =
        let qname = 
          make_qname name in
          begin match get_bind_sure name env with
-             Some (Scope (scope,_)) ->
+             Some (Scope scope) ->
                [GetScopeObject scope;
                 GetProperty qname]
            | Some (Register n) ->
-                 [GetLocal n]
+               [GetLocal n]
            | _ ->
-               [FindPropStrict qname;
-                GetProperty qname]
+               [GetLex qname]
          end
     | Let (vars,body) ->
        let env' =
@@ -196,7 +188,7 @@ let rec generate_expr expr env =
        let args' =
          concat_map gen args; in
          begin match get_bind_sure name env with
-             Some (Scope (scope,_)) ->
+             Some (Scope scope) ->
                List.concat [[GetScopeObject scope];
                             args';
                             [CallPropLex (make_qname name,nargs)]]
@@ -240,7 +232,7 @@ let generate_stmt env stmt =
     | Define (name,body) ->    
        let env' =
          add_current_scope name env in
-       let scope,index =
+       let scope = 
          ensure_scope name env' in
        let body' =
          (generate_expr body env)@

diff --git a/test/test_ast.ml b/test/test_ast.ml
index b9ae6bd..839c2a2 100644 (file)
--- a/test/test_ast.ml
+++ b/test/test_ast.ml
@@ -77,3 +77,13 @@ test call_with_args =
   assert_equal 
     (result [NewFunction (result ~args:[0;0] ~prefix:[] [GetLocal 2])])
     (compile (Lambda (["x";"y"],Block [Var "y"])))
+
+test closure_with_arg =
+  let name = 
+    QName ((Namespace ""),"x") in
+    assert_equal 
+      (result [NewFunction (result ~prefix:[] [NewFunction (result ~prefix:[] [FindPropStrict name;GetProperty name])]);
+             GetScopeObject 0;
+             Swap;
+             SetProperty (QName ((Namespace ""),"f"))])
+      (generate_method @@ Lisp.compile_string "(define (f x) (lambda () x))")

diff --git a/util/instruction.txt b/util/instruction.txt
index 3867882..b937983 100644 (file)
--- a/util/instruction.txt
+++ b/util/instruction.txt
@@ -55,7 +55,7 @@ GetSlot of int:op=0x6c; args=const [Bytes.u30 arg0]
 SetSlot of int:op=0x6d; stack= ~-2; args=const [Bytes.u30 arg0]
 GetGlobalSlot of int:op=0x6e; stack=1; args=const [Bytes.u30 arg0]
 SetGlobalSlot of int:op=0x6f; stack= ~-1; args=const [Bytes.u30 arg0]
-GetLex of Cpool.multiname:op=0x60; const=multiname arg0; args=fun (cmap,_) ->[multiname_get arg0 cmap]
+GetLex of Cpool.multiname:op=0x60; stack=1; const=multiname arg0; args=fun (cmap,_) ->[multiname_get arg0 cmap]
 GetProperty of Cpool.multiname: op=0x66; const=multiname arg0; args=fun (cmap,_) ->[multiname_get arg0 cmap]
 SetProperty of Cpool.multiname: op=0x61; stack= ~-2; const=multiname arg0; args=fun (cmap,_) ->[multiname_get arg0 cmap];