first implements for module trans

diff --git a/src/ast.ml b/src/ast.ml
index 84260f3..f1022f3 100644 (file)
--- a/src/ast.ml
+++ b/src/ast.ml
@@ -2,7 +2,7 @@ open Base
 
 (* name := namespace * symbol *)
 type qname = (string * string) Node.t
-type ident = string Node.t
+type sname = string Node.t
 
 (* expression has no side-effect. *)
 type expr =
@@ -11,20 +11,20 @@ type expr =
     | `Bool    of bool Node.t
     | `Float   of float Node.t
     | `Var     of qname
-    | `Lambda  of ident list * expr
+    | `Lambda  of sname list * expr
     | `Call    of expr list
     | `If      of expr * expr * expr
-    | `Let     of (ident*expr) list * expr
-    | `LetRec  of (ident*expr) list * expr
+    | `Let     of (sname*expr) list * expr
+    | `LetRec  of (sname*expr) list * expr
     | `Block   of expr list
     | `New     of qname * expr list
-    | `Invoke  of expr   * ident * expr list
-    | `SlotRef of expr * ident
-    | `SlotSet of expr * ident * expr ]
+    | `Invoke  of expr   * sname * expr list
+    | `SlotRef of expr * sname
+    | `SlotSet of expr * sname * expr ]
 
 (* statement has side-effect *)
-type attr    = ident
-type method_ = ident * ident list * expr
+type attr    = sname
+type method_ = sname * sname list * expr
 
 type stmt =
     [ `Define of qname * expr
@@ -84,7 +84,7 @@ let rec map f expr =
 let string_of_qname {Node.value=(ns,name)} =
   ns ^ "." ^ name
 
-let string_of_ident {Node.value=name} =
+let string_of_sname {Node.value=name} =
   name
 
 
@@ -105,7 +105,7 @@ let rec to_string : expr -> string =
        string_of_qname n
     | `Lambda (args,expr') ->
        Printf.sprintf "Lambda (%s,%s)"
-         (string_of_list_by string_of_ident args)
+         (string_of_list_by string_of_sname args)
          (to_string expr')
     | `Call exprs ->
        Printf.sprintf "Call %s" @@
@@ -118,7 +118,7 @@ let rec to_string : expr -> string =
          string_of_list_by
            (fun (a,b)->
                 Printf.sprintf "(%s,%s)"
-                  (string_of_ident a)
+                  (string_of_sname a)
                   (to_string b)) decl in
        let body' =
          to_string body in
@@ -128,7 +128,7 @@ let rec to_string : expr -> string =
          string_of_list_by
            (fun (a,b)->
               Printf.sprintf "(%s,%s)"
-                (string_of_ident a)
+                (string_of_sname a)
                 (to_string b)) decl in
        let body' =
          to_string body in
@@ -143,15 +143,15 @@ let rec to_string : expr -> string =
     | `Invoke (obj,name,args) ->
        Printf.sprintf "Invoke (%s,%s,%s)"
          (to_string obj)
-         (string_of_ident name) @@
+         (string_of_sname name) @@
          string_of_list_by to_string args
     | `SlotRef (obj,name) ->
        Printf.sprintf "SlotRef (%s,%s)"
-         (to_string obj) @@ string_of_ident name
+         (to_string obj) @@ string_of_sname name
     | `SlotSet (obj,name,value) ->
        Printf.sprintf "SlotSet (%s,%s,%s)"
          (to_string obj)
-         (string_of_ident name)
+         (string_of_sname name)
          (to_string value)
 
 let to_string_stmt =
@@ -166,12 +166,12 @@ let to_string_stmt =
        Printf.sprintf "Class (%s,%s,%s,%s)"
          (string_of_qname klass)
          (string_of_qname super)
-         (string_of_list_by string_of_ident attrs)
+         (string_of_list_by string_of_sname attrs)
        @@ String.concat "\n"
        @@ List.map (fun (name,args,expr) ->
                       Printf.sprintf "((%s %s) %s)"
-                        (string_of_ident name)
+                        (string_of_sname name)
                         (String.concat " " @@
-                           List.map string_of_ident args)
+                           List.map string_of_sname args)
                         (to_string expr))
          body

diff --git a/src/ast.mli b/src/ast.mli
index 5f0543c..440c636 100644 (file)
--- a/src/ast.mli
+++ b/src/ast.mli
@@ -2,7 +2,7 @@
 
 (** name := namespace * symbol *)
 type qname = (string * string) Node.t
-type ident = string Node.t
+type sname = string Node.t
 
 (** expression has no side-effect. *)
 type expr =
@@ -11,19 +11,19 @@ type expr =
     | `Bool    of bool Node.t
     | `Float   of float Node.t
     | `Var     of qname
-    | `Lambda  of ident list * expr
+    | `Lambda  of sname list * expr
     | `Call    of expr list
     | `If      of expr * expr * expr
-    | `Let     of (ident*expr) list * expr
-    | `LetRec  of (ident*expr) list * expr
+    | `Let     of (sname*expr) list * expr
+    | `LetRec  of (sname*expr) list * expr
     | `Block   of expr list
     | `New     of qname * expr list
-    | `Invoke  of expr   * ident * expr list (** (invoke <object> <method-name> <arg1> <arg2>...)*)
-    | `SlotRef of expr * ident
-    | `SlotSet of expr * ident * expr ]
+    | `Invoke  of expr   * sname * expr list (** (invoke <object> <method-name> <arg1> <arg2>...)*)
+    | `SlotRef of expr * sname
+    | `SlotSet of expr * sname * expr ]
 
-type attr    = ident
-type method_ = ident * ident list * expr
+type attr    = sname
+type method_ = sname * sname list * expr
 
 (** statement has side-effect *)
 type stmt =

diff --git a/src/bindCheck.ml b/src/bindCheck.ml
index 5774841..6afb80a 100644 (file)
--- a/src/bindCheck.ml
+++ b/src/bindCheck.ml
@@ -5,10 +5,8 @@ exception Unbound_var of (string*string) Node.t
 exception Unbound_class of (string*string) Node.t
 exception Unbound_method of string Node.t
 
-type method_ = Ast.ident
-
 type stmt =
-    [ `ExternalClass of Ast.qname * method_ list
+    [ `ExternalClass of Ast.qname * Ast.sname list
     | `External of Ast.qname
     | Ast.stmt]
 type program = stmt list

diff --git a/src/bindCheck.mli b/src/bindCheck.mli
index beb164c..d6b222f 100644 (file)
--- a/src/bindCheck.mli
+++ b/src/bindCheck.mli
@@ -2,10 +2,8 @@ exception Unbound_var of (string*string) Node.t
 exception Unbound_class of (string*string) Node.t
 exception Unbound_method of string Node.t
 
-type method_ = Ast.ident
-
 type stmt =
-    [ `ExternalClass of Ast.qname * method_ list
+    [ `ExternalClass of Ast.qname * Ast.sname list
     | `External of Ast.qname
     | Ast.stmt]
 

diff --git a/src/moduleTrans.ml b/src/moduleTrans.ml
index ad0d771..8e4ee91 100644 (file)
--- a/src/moduleTrans.ml
+++ b/src/moduleTrans.ml
@@ -1,3 +1,4 @@
+open Base
 (*
 Example:
  (package A :export '(f g h))
@@ -26,10 +27,26 @@ Flow:
 *)
 
 type stmt =
-    [ `Class  of Ast.ident * Ast.qname * Ast.attr list * Ast.method_ list
-    | `Define of Ast.ident * Ast.expr
+    [ `Class  of Ast.sname * Ast.qname * Ast.attr list * Ast.method_ list
+    | `Define of Ast.sname * Ast.expr
     | `Expr   of Ast.expr
-    | `Module of Ast.ident * Ast.ident list * stmt ]
-
-
-let trans x = x
+    | `Module of Ast.sname * (Ast.sname list) * stmt list ]
+
+let to_qname ({Node.value = ns} as loc) ({Node.value=name;end_pos=pos}) =
+  {loc with
+     Node.value = (ns,name);
+     end_pos = pos}
+
+let rec trans_stmt ns : stmt -> Ast.stmt list =
+  function
+      `Class  (klass,super,attrs,methods) ->
+       [`Class (to_qname ns klass,super,attrs,methods)]
+    | `Define (name,body) ->
+       [`Define (to_qname ns name,body)]
+    | `Expr _ as expr ->
+       [expr]
+    | `Module (ns,_,stmts) ->
+       HList.concat_map (trans_stmt ns) stmts
+
+let trans =
+  HList.concat_map (trans_stmt (Node.empty ""))

diff --git a/test/astUtil.ml b/test/astUtil.ml
index ff6379c..5cdc18a 100644 (file)
--- a/test/astUtil.ml
+++ b/test/astUtil.ml
@@ -89,23 +89,22 @@ let eq_clos a b =
     | a,b ->
        eq_bind a b
 
-(* random node *)
-let count =
-  ref 0
-
 let node x =
-  let pos ()=
-    incr count;
-    !count in
-    {(Node.empty x) with
-       Node.filename = "<string>";
-       Node.lineno   = 0;
-       start_pos     = pos ();
-       end_pos       = pos ()}
+  {(Node.empty x) with
+     Node.filename = "<string>";
+     Node.lineno   = 0;
+     start_pos     = 0;
+     end_pos       = 0}
 
 let qname x =
   node ("",x)
 
+let full_qname ns name =
+  node (ns,name)
+
+let sname =
+  node
+
 let string x =
   `String (node x)
 

diff --git a/test/test_module.ml b/test/test_module.ml
index d61b3dc..b94a3a0 100644 (file)
--- a/test/test_module.ml
+++ b/test/test_module.ml
@@ -7,6 +7,9 @@ let ok x y =
   OUnit.assert_equal
     x @@ trans y
 
+let sname =
+  node
+
 let define x y =
   `Define (x,y)
 
@@ -15,15 +18,15 @@ let _ =
      "define trans" >::
        (fun () ->
          ok
-           [define (node ("foo","bar")) @@ `Block []]
-           [`Module (node "foo",[
-                       define (node ("","bar")) @@ `Block []])]);
+           [define (node ("foo","bar")) (`Block [])]
+           [`Module (sname "foo",[],[
+                       define (sname "bar") (`Block []) ] ) ]);
      "class trans" >::
        (fun () ->
          ok
            [`Class (node ("foo","bar"),qname "Object",[],[])]
-           [`Module (node "foo",[
-                       `Class (node ("","bar"),qname "Object",[],[])])])
+           [`Module (sname "foo",[],[
+                       `Class (sname "bar",qname "Object",[],[])])])
    ]) +> run_test_tt