Module name should be Capitalize

diff --git a/OMakefile b/OMakefile
index ab9ba0f..d4a1d84 100644 (file)
--- a/OMakefile
+++ b/OMakefile
@@ -19,7 +19,7 @@ else
 
 Shell. +=
     ounit-postproc(argv) =
-      (grep "FAIL\|ERROR\|Fail" && exit 1) || exit 0
+      (grep "FAIL\|ERROR\|Error\|Fail" && exit 1) || exit 0
     ocaml-clean(argv) =
       rm -f *.cm[iox] *.o *.omc *.opt *.run *~ $(argv) *.cmxa *.a *.spot *.annot
 

diff --git a/scm/example/module.scm b/scm/example/module.scm
index 3f4e656..760325c 100644 (file)
--- a/scm/example/module.scm
+++ b/scm/example/module.scm
@@ -3,24 +3,24 @@
 ;;; 42
 ;;; 12
 
-(module foo ()
+(module Foo ()
        (define-class Foo (Object) (x y))
         (define-method init ([self Foo] x)
-          (print x)
+          (trace x)
           (let ((t 10))
             (let ((t 12))
-              (print t))))
+              (trace t))))
 
         (define-method f ((self Foo) x)
-          (print x))
+          (trace x))
         (define x 10)
-        (define (g) foo.x)
+        (define (g) Foo.x)
         (define x 12))
 
 ;; scope
-(print foo.x)
-(print (foo.g))
+(trace Foo.x)
+(trace (Foo.g))
 
 ;; class
-(define obj (new foo.Foo 42))
+(define obj (new Foo.Foo 42))
 ;;(f obj 1)

diff --git a/scm/src/lisp.ml b/scm/src/lisp.ml
index 8cbc021..60ae39c 100644 (file)
--- a/scm/src/lisp.ml
+++ b/scm/src/lisp.ml
@@ -135,6 +135,24 @@ let define_func =
 let define =
   (try_ define_value) <|> define_func
 
+let is_valid_module xs =
+  if  xs = "" then
+    false
+  else
+    match xs.[0] with
+       'A' .. 'Z' ->
+         true
+      | _ ->
+         false
+
+let module_name =
+  parser
+      [< name = symbol >] ->
+       if is_valid_module @@ Node.value name then
+         name
+       else
+         raise (Stream.Error "invalid module name")
+
 let rec p_stmt : Sexp.t Stream.t -> ClosTrans.stmt =
   parser
       [< def = define >] ->
@@ -166,7 +184,7 @@ let rec p_stmt : Sexp.t Stream.t -> ClosTrans.stmt =
          args = args;
          body = body
        }
-    | [< _ = kwd "module"; name = symbol; exports = list @@ many symbol; stmts = many stmt>] ->
+    | [< _ = kwd "module"; name = module_name; exports = list @@ many symbol; stmts = many stmt>] ->
        if exports = [] then
          (* exports nothing must not be happened. *)
          `Module {ModuleTrans.module_name=name;

diff --git a/scm/test/astUtil.ml b/scm/test/astUtil.ml
index 0954238..e7388fd 100644 (file)
--- a/scm/test/astUtil.ml
+++ b/scm/test/astUtil.ml
@@ -110,8 +110,8 @@ let module_ name exports xs =
           stmts=xs}
 
 let foo_mod xs =
-  module_ "foo" ModuleTrans.All xs
+  module_ "Foo" ModuleTrans.All xs
 
 let bar_mod xs =
-  module_ "bar" ModuleTrans.All xs
+  module_ "Bar" ModuleTrans.All xs
 

diff --git a/scm/test/bindcheckTest.ml b/scm/test/bindcheckTest.ml
index b66416b..54c78b7 100644 (file)
--- a/scm/test/bindcheckTest.ml
+++ b/scm/test/bindcheckTest.ml
@@ -5,7 +5,7 @@ open AstUtil
 
 let table =
   let x =
-    InterCode.add InterCode.empty "foo" @@
+    InterCode.add InterCode.empty "Foo" @@
       InterCode.of_program
       [define (`Public (global "x")) (int 42);
        klass (`Public (global "Bar")) (global "Object") [] [
@@ -38,11 +38,11 @@ let _ =
      "external" >::: [
        "external module bind x" >::
         (fun () ->
-           ignore @@ BindCheck.check table [`Expr (var (qname "foo" "x"))]);
+           ignore @@ BindCheck.check table [`Expr (var (qname "Foo" "x"))]);
        "external module bind class Bar" >::
         (fun () ->
            ignore @@ BindCheck.check table
-             [`Expr (new_klass (qname "foo" "Bar") [])]);
+             [`Expr (new_klass (qname "Foo" "Bar") [])]);
        "external module bind method f" >::
         (fun () ->
            ignore @@ BindCheck.check table
@@ -101,7 +101,7 @@ let _ =
            ok_s [foo_mod [
                    foo_mod [
                      define (sname "x") @@ `Block []]];
-                 `Expr (var @@ qname "foo.foo" "x")])
+                 `Expr (var @@ qname "Foo.Foo" "x")])
      ];
      "invalid phase" >:::
        let x =

diff --git a/scm/test/lispTest.ml b/scm/test/lispTest.ml
index 71e89c7..6b1e952 100644 (file)
--- a/scm/test/lispTest.ml
+++ b/scm/test/lispTest.ml
@@ -226,14 +226,14 @@ let _ =
        "module" >::
         (fun () ->
            ok [`Module {
-                 ModuleTrans.module_name =pos "foo" 0 8 11;
+                 ModuleTrans.module_name =pos "Foo" 0 8 11;
                  exports = ModuleTrans.Restrict [
                    pos "x" 0 13 14;
                    pos "y" 0 15 16
                  ];
                  stmts = []}
               ] @@
-             "(module foo (x y))")
+             "(module Foo (x y))")
      ];
      "empty" >::
        (fun () ->
@@ -357,14 +357,14 @@ let _ =
          ok [foo_mod [
                define (sname "x") @@ `Block [
                  int 42 ] ]]
-           "(module foo () (define x 42))");
+           "(module Foo () (define x 42))");
      "exports-module" >::
        (fun () ->
-         ok [module_ "foo"
+         ok [module_ "Foo"
                (ModuleTrans.Restrict [sname "x";sname "y"]) [
                define (sname "x") @@ `Block [
                  int 42 ] ]]
-           "(module foo (x y) (define x 42))");
+           "(module Foo (x y) (define x 42))");
      "bug" >::
        (fun () ->
          ok [`Expr (int 10);

diff --git a/scm/test/moduleTest.ml b/scm/test/moduleTest.ml
index 15985dc..0cf652e 100644 (file)
--- a/scm/test/moduleTest.ml
+++ b/scm/test/moduleTest.ml
@@ -15,30 +15,30 @@ let _ =
      "define trans" >::
        (fun () ->
          ok
-           [define (`Public (qname "foo" "bar")) (`Block [])]
+           [define (`Public (qname "Foo" "bar")) (`Block [])]
            [foo_mod [
               define (sname "bar") (`Block [])]]);
      "class trans" >::
        (fun () ->
          ok
-           [klass (`Public (qname "foo" "Bar")) (global "Object") [] []]
+           [klass (`Public (qname "Foo" "Bar")) (global "Object") [] []]
            [foo_mod [
               klass (sname "Bar") (global "Object") [] []
             ]]);
      "baz should be internal" >::
        (fun () ->
          ok
-           [define (`Public (qname "foo" "bar")) (`Block []);
-            define (`Internal (qname "foo" "baz")) (`Block [])]
-           [module_ "foo" (Restrict [sname "bar"]) [
+           [define (`Public (qname "Foo" "bar")) (`Block []);
+            define (`Internal (qname "Foo" "baz")) (`Block [])]
+           [module_ "Foo" (Restrict [sname "bar"]) [
               define (sname "bar") (`Block []);
               define (sname "baz") (`Block [])]]);
      "Baz should be internal" >::
        (fun () ->
          ok
-           [klass (`Public (qname "foo" "Bar"))   (global "Object") [] [];
-            klass (`Internal (qname "foo" "Baz")) (global "Object") [] []] @@
-           [module_ "foo" (Restrict [sname "Bar"]) [
+           [klass (`Public (qname "Foo" "Bar"))   (global "Object") [] [];
+            klass (`Internal (qname "Foo" "Baz")) (global "Object") [] []] @@
+           [module_ "Foo" (Restrict [sname "Bar"]) [
               klass (sname "Bar") (global "Object") [] [];
               klass (sname "Baz") (global "Object") [] []]])
    ]) +> run_test_tt