OSDN Git Service

update scope checker
authormzp <mzpppp@gmail.com>
Sun, 31 May 2009 23:22:13 +0000 (08:22 +0900)
committermzp <mzpppp@gmail.com>
Sun, 31 May 2009 23:22:13 +0000 (08:22 +0900)
scm/src/checker/.ocamlinit [new file with mode: 0644]
scm/src/checker/binding.ml
scm/test/checker/bindingTest.ml

diff --git a/scm/src/checker/.ocamlinit b/scm/src/checker/.ocamlinit
new file mode 100644 (file)
index 0000000..1378eb1
--- /dev/null
@@ -0,0 +1,12 @@
+#use "topfind";;
+#require "extlib";;
+#require "str";;
+#camlp4o;;
+
+#directory "../../../base/";;
+#load "base.cma";;
+#directory "../type";;
+#load "type.cma";;
+
+#load "checker.cma";;
+#load "../../../camlp4/pa_oo.cmo";;
\ No newline at end of file
index 50459dd..3d24f5f 100644 (file)
@@ -46,17 +46,23 @@ let add_local xs env =
     { env with
        vars = vars @ env.vars }
 
-let check_access {vars=vars; current=current; table=table} var =
+let is_access {vars=vars; current=current; table=table} var =
   match (maybe @@ List.assoc var.value) vars with
       Some Public | Some Local ->
-       ()
+       true
     | Some Internal when fst var.value = current ->
-       ()
+       true
     | Some Internal ->
        raise (Forbidden_var var)
     | None ->
-       if not (table#mem_symbol var.value) then
-         raise (Unbound_var var)
+       table#mem_symbol var.value
+
+let check_access env ({ value = (ns,name)} as var) =
+  env.current
+  +> HList.scanl (fun x y -> x @ [y] ) []
+  +> List.map (fun ns' -> {var with value=(ns' @ ns, name)})
+  +> List.exists (is_access env)
+  +> (fun b -> if not b then raise (Unbound_var var))
 
 let check_expr env expr  =
   ignore @@ Ast.fix_fold Ast.fold
index c3d8976..b5569a6 100644 (file)
@@ -135,6 +135,18 @@ let _ =
                invoke (var [] "hoge") "f" []))
      ];
      "module" >::: [
+       "scope" >::
+        (fun () ->
+           ok_s [AstUtil.module_ "foo" (`Only []) [
+                   define "x" @@ block [];
+                   expr (var [] "x")]]);
+       "deep scope" >::
+        (fun () ->
+           ok_s [foo_mod [
+                   bar_mod [
+                     define "x" @@ block []
+                   ];
+                   expr (var ["bar"] "x")]]);
        "internal should be accessed from inner moudle" >::
         (fun () ->
            ok_s [AstUtil.module_ "foo" (`Only []) [