Commits

camlspotter  committed 8d295aa

oo change

  • Participants
  • Parent commits 23d0583
  • Branches dev

Comments (0)

Files changed (2)

 auto.ml auto.mli auto_stubs.c: $(addsuffix .idl, $(IDLS)) $(Installed camlidl) autoclasses.idl autoclasses.h
 	bash -c "camlidl auto.idl"
 
-autoapi.mlp : auto.ml module.pl $(addsuffix .idl.in, $(IDLS))
+autoapi.ml : auto.ml module.pl $(addsuffix .idl.in, $(IDLS))
     ./module.pl *.idl.in > $@
 
-autoapi.ml: autoapi.mlp pa/pa_opycaml.cmo
-    camlp4of ./pa/pa_opycaml.cmo -impl autoapi.mlp -printer Camlp4OCamlPrinter > $@
+autoapioo.ml: autoapi.ml pa/pa_opycaml.cmo
+    camlp4of ./pa/pa_opycaml.cmo -impl autoapi.ml -printer Camlp4OCamlPrinter > $@
 
 auto_stubs.o: auto_stubs.c auto.h api_ml.h autoclasses.h
 

File pa/pa_opycaml.ml

         let sitem = super#str_item sitem in
         match sitem with
         | Ast.StMod (mloc, modname, module_expr) ->
+            let cl_name underscore_name = 
+              "o" ^ underscore_name
+              
+            in
             let rec iter_sitems f = function
               | Ast.StSem (_, sitem1, sitem2) -> iter_sitems f sitem1; iter_sitems f sitem2
               | i -> f i
             in 
             begin match module_expr with
             | Ast.MeStr (x, sitem) ->
+                let non_meths = ref [] in
                 let meths = ref [] in
-                iter_sitems (function
+                iter_sitems (fun si ->
+                  match si with
                   | Ast.StExt (loc, name, <:ctyp< [ > $cls$ ] t -> $ty_rest$>>, _slist) -> 
                       begin match cls with
                       | Ast.TyId (_, Ast.IdLid (_, tname)) ->
                           if tname = "_" ^ modname then meths := (name, loc, ty_rest) :: !meths
-                      | _ -> ()
+                      | _ -> non_meths := si :: !non_meths
                       end
-                  | _ -> ()
+                  | _ -> non_meths := si :: !non_meths
                 ) sitem;
                 let create_meth name loc ty_rest = 
                   let rec args pos (f, st) = function
                               | Ast.TyId (_, Ast.IdLid (_, clsname)) ->
                                   let tnametyp = <:ctyp< $lid: clsname$ >> in
                                   <:expr< ($v$#$clsname$ : $tnametyp$ t) >>
-                              | _ -> <:expr< $v$#hoge >>
+                              | _ -> v
                               end
                           | _ -> v
                         in
                                                                                       Ast.ExNil Ast.Loc.ghost,
                                                                                       e)))), 
                                        <:expr< $st$ $e$ >> ) ty
+                    | <:ctyp@loc< $lid:cls$ t >> ->
+                        let cls = cl_name cls in 
+                        f <:expr@loc< new $lid:cls$ ($st$) >> 
                     | _ -> f st
                   in
                   let lid = Ast.ExId (loc, Ast.IdLid (loc, name)) in
                 let _loc = Ast.Loc.ghost in
                 let tname = "_" ^ modname in
                 let tnametyp = <:ctyp< $lid:tname$ >> in
+(*
                 let sitem' = Ast.StSem (Ast.Loc.ghost, sitem, 
                                         <:str_item< class o t = object
                                           $meths$
                                           method $tname$ = (t :> $tnametyp$ t )
                                         end>>)
                 in
+*)
+                let non_meths = 
+                  List.fold_left (fun st si ->
+                    <:str_item< $si$ $st$ >>)
+                    <:str_item<>>
+                    (List.rev !non_meths)
+                in
+                let sitem' = <:str_item< $non_meths$ 
+                                         class o t = object
+                                           $meths$
+                                           method $tname$ = (t :> $tnametyp$ t )
+                                         end>>
+                in
                 Ast.StMod (mloc, modname, Ast.MeStr (x, sitem'))
             | _ -> sitem
             end