OSDN Git Service

update binding module implementation
authormzp <mzpppp@gmail.com>
Wed, 12 Aug 2009 23:49:02 +0000 (08:49 +0900)
committermzp <mzpppp@gmail.com>
Wed, 12 Aug 2009 23:49:02 +0000 (08:49 +0900)
scm/src/codegen/binding.ml
scm/src/codegen/binding.mlip
scm/test/codegen/bindingTest.ml

index cc9f464..89ebeca 100644 (file)
@@ -23,8 +23,7 @@ type 'expr expr =
     | `BindVar of bind Node.t]
 
 type ('expr,'stmt) stmt =
-    [ ('expr,'stmt) Module.stmt
-    | `ReDefine of Module.stmt_name * int * 'expr]
+    ('expr,'stmt) Module.stmt
 
 let fold f g fold_rec env =
   function
@@ -33,19 +32,11 @@ let fold f g fold_rec env =
     | #Module.expr as e ->
        Module.fold f g fold_rec env e
 
-let fold_stmt f g env =
-  function
-      `ReDefine _ as s ->
-       g (f env s) s
-    | #Module.stmt as s ->
-       Module.fold_stmt f g env s
+let fold_stmt f g env s =
+  Module.fold_stmt f g env s
 
-let lift f =
-  function
-      `ReDefine (name,slot,expr) ->
-       `ReDefine (name, slot, f expr)
-    | #Module.stmt as s ->
-       Module.lift f s
+let lift f s =
+    Module.lift f s
 
 type expr' =
     expr' expr
@@ -125,30 +116,16 @@ let to_qname =
 let bind_define env (`Define (name,expr)) =
   let qname =
     to_qname name in
-    match get_bind qname env with
-       None ->
-         let id =
-           1 + env.slot_count in
-         let env' =
-           { env with
-               slot_count = id;
-               slots      = (qname,id)::env.slots;
-               binding    =
-                 if env.depth = 1 then
-                   (qname,Slot (Global,id))::env.binding
-                 else
-                   (qname,Slot (Scope (env.depth-1),id))::env.binding
-           } in
-           env',`ReDefine (name,env.depth-1,bind_var env' expr)
-      | Some (Slot (_,id)) ->
-         let env' =
-           { env with
-               depth  = env.depth + 1;
-               binding=(qname,Slot (Scope env.depth,id))::env.binding
-           } in
-           env',`Define (name,bind_var env' expr)
-      | Some _ ->
-         failwith "must not happen"
+  let id =
+    1 + env.slot_count in
+  let env' =
+    { env with
+       slot_count = id;
+       slots      = (qname,id)::env.slots;
+       binding    =
+       (qname,Slot (Global,id))::env.binding
+    } in
+    env',`Define (name,bind_var env' expr)
 
 let bind_stmt env =
   function
index 7e1c338..cf79b9a 100644 (file)
@@ -14,8 +14,8 @@ type 'expr expr =
     | `BindVar of bind Node.t]
 
 type ('expr,'stmt) stmt =
-    ('expr,'stmt) Module.stmt
-    | `ReDefine of Module.stmt_name * int * 'expr]
+    ('expr,'stmt) Module.stmt
+
 
 #include <type.h>
 val fold : FOLD(expr)
index 4d2d0ad..e6d5576 100644 (file)
@@ -75,16 +75,18 @@ let _ =
             [class_ [public_meth "f" ["x"] @@ var [] "x"]]);
      "define" >::
        (fun () ->
-         ok [`ReDefine (`Public (qname [] "x"),0,int 42);
+         ok [`Define (`Public (qname [] "x"),int 42);
              expr @@ `BindVar (slot Global 1)]
            [`Define (`Public (qname [] "x"),int 42);
             expr @@ var [] "x"]);
      "multiple-define" >::
        (fun () ->
-         ok [`ReDefine (`Public (qname [] "x"),0,int 42);
-             `ReDefine (`Public (qname [] "x"),0,int 42);
-             expr @@ `BindVar (slot Global 1)]
+         ok [`Define (`Public (qname [] "x"),int 42);
+             expr @@ `BindVar (slot Global 1);
+             `Define (`Public (qname [] "x"),int 42);
+             expr @@ `BindVar (slot Global 2)]
            [`Define (`Public (qname [] "x"),int 42);
+            expr @@ var [] "x";
             `Define (`Public (qname [] "x"),int 42);
             expr @@ var [] "x"]);
      "class" >::