camlspotter avatar camlspotter committed bb9c24a

oo interface!

Comments (0)

Files changed (18)

 PY_PREFIX=/usr
 PY_VERSION=2.7
 CFLAGS+= -fPIC -I $(OCAML_WHERE) -I $(PY_PREFIX)/include/python$(PY_VERSION)
+OCAMLFLAGS+= -warn-error A-31
 
 # I (jfuruse) install camlidl using findlib, but not for the others.
 CAMLIDL_FINDLIB=$(OCAMLFIND_DESTDIR)/camlidl
 
 api.auto.mli: api.cmi api.ml
 
-OOApi.ml: api.auto.mli oowrap/oowrap.cmo
+OOApiauto.ml: api.auto.mli oowrap/oowrap.cmo
     camlp4o ./oowrap/oowrap.cmo api.auto.mli -printer Camlp4OCamlPrinter > $@
 
 auto_stubs.o: auto_stubs.c auto.h api_ml.h autoclasses.h
   rm -f $(filter-proper-targets $(ls R, .))
 
 MyOCamlPackageExtras[] = opycaml_python.o from_python_c.o
-MyOCamlPackage(opycaml, utils type autoapi api autoapioo OOApi, auto_stubs api_ml, -lpython$(PY_VERSION) -L$(PREFIX)/lib/ocaml $(L_CAMLIDL_FINDLIB) -lcamlidl)
+MyOCamlPackage(opycaml, utils type autoapi api OOApiauto OOApi, auto_stubs api_ml, -lpython$(PY_VERSION) -L$(PREFIX)/lib/ocaml $(L_CAMLIDL_FINDLIB) -lcamlidl)
 
 opycaml_python.o: opycaml.cmx libopycaml.a dllopycaml.so
 	$(OCamlOpt) -output-obj -o $@ opycaml.cmx -cclib -lopycaml -ccopt -L$(OCAML_WHERE) $(CCOPT_L_CAMLIDL_FINDLIB) -ccopt -Wl,-rpath,$(OCAML_WHERE) -cclib -lpython$(PY_VERSION) -cclib -lcamlidl
 OCamlProgram(test, test)
 OCamlProgram(test_bug1, test_bug1)
 
-.SUBDIRS: tests pa oowrap
+.SUBDIRS: tests oowrap
 
+module OPy = struct
+  include OOApiauto
+end
+
+open OPy
+module Slice = Slice
+module Mapping = Mapping
+module Tuple = Tuple
+module Err = Err
+module Number = Number
+module ByteArray = ByteArray
+module Index = Index
+(* module String = *)
+module CObject = CObject
+module Base = Base
+module Import = Import
+module Eval = Eval
+module Run = Run
+module Closure = Closure
+module Mutable = Mutable
+(* module List =  *)
+module Sequence = Sequence
+module Module = Module
+module Object = Object
+module Float = Float
+module Type = Type
+module Class = Class
+module Long = Long
+module Iter = Iter
+module Dict = Dict
+module Int = Int
+module Integral = Integral
+module Unicode = Unicode
+module DictProxy = DictProxy
+module Callable = Callable
+module None = None

example/OMakefile

-USE_OCAMLFIND=true
-
-OCAMLPACKS = opycaml
-
-.DEFAULT: $(OCamlProgram test, test)
-.DEFAULT: $(OCamlProgram module_new, module_new)
-
-.PHONY: clean
-clean:
-  rm -f $(filter-proper-targets $(ls R, .))

example/OMakeroot

-########################################################################
-# Permission is hereby granted, free of charge, to any person
-# obtaining a copy of this file, to deal in the File without
-# restriction, including without limitation the rights to use,
-# copy, modify, merge, publish, distribute, sublicense, and/or
-# sell copies of the File, and to permit persons to whom the
-# File is furnished to do so, subject to the following condition:
-#
-# THE FILE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
-# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
-# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
-# OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE FILE OR
-# THE USE OR OTHER DEALINGS IN THE FILE.
-
-########################################################################
-# The standard OMakeroot file.
-# You will not normally need to modify this file.
-# By default, your changes should be placed in the
-# OMakefile in this directory.
-#
-# If you decide to modify this file, note that it uses exactly
-# the same syntax as the OMakefile.
-#
-
-#
-# Include the standard installed configuration files.
-# Any of these can be deleted if you are not using them,
-# but you probably want to keep the Common file.
-#
-open build/C
-open build/OCaml
-open build/LaTeX
-
-#
-# The command-line variables are defined *after* the
-# standard configuration has been loaded.
-#
-DefineCommandVars()
-
-#
-# Include the OMakefile in this directory.
-#
-.SUBDIRS: .

example/module_new.ml

-open Opycaml.Api
-
-let _ =
-  Base.initialize ();
-  let mdl = Module.new_ "MyModule" in
-  let mdldic = Import.getModuleDict () in
-  Dict.setItemString mdldic "MyModule" mdl;
-  let dic = Module.getDict mdl in
-  Dict.setItemString dic "answer" (Int.fromLong 42);
-  ignore (Base.main []);
-  Base.finalize ()
-;;
-
-
-  

example/test.ml

-(* open Opycaml.Api is recommended. *)
-open Opycaml.Api
-
-let _ =
-  Base.initialize ();
-
-  let string = Import.importModule "string" in (* from string import * *)
-  let dict = Module.getDict string in
-  let lowercase = Dict.getItemString dict "lowercase" in
-  let capitalize = Dict.getItemString dict "capitalize" in
-
-  let res = Object.callObject (Callable.coerce capitalize) [lowercase] in
-
-  (* String class is not accessible by String but Py.String, in order
-     to avoid the name space collision with String in OCaml standard
-     library. *)
-  prerr_endline (Py.String.asString (Py.String.coerce res));
-
-  Base.finalize ()
-;;

examples/OMakefile

+USE_OCAMLFIND=true
+
+OCAMLPACKS = opycaml
+
+.DEFAULT: $(OCamlProgram test, test)
+.DEFAULT: $(OCamlProgram module_new, module_new)
+.DEFAULT: $(OCamlProgram testoo, testoo)
+
+.PHONY: clean
+clean:
+  rm -f $(filter-proper-targets $(ls R, .))

examples/OMakeroot

+########################################################################
+# Permission is hereby granted, free of charge, to any person
+# obtaining a copy of this file, to deal in the File without
+# restriction, including without limitation the rights to use,
+# copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the File, and to permit persons to whom the
+# File is furnished to do so, subject to the following condition:
+#
+# THE FILE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+# OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE FILE OR
+# THE USE OR OTHER DEALINGS IN THE FILE.
+
+########################################################################
+# The standard OMakeroot file.
+# You will not normally need to modify this file.
+# By default, your changes should be placed in the
+# OMakefile in this directory.
+#
+# If you decide to modify this file, note that it uses exactly
+# the same syntax as the OMakefile.
+#
+
+#
+# Include the standard installed configuration files.
+# Any of these can be deleted if you are not using them,
+# but you probably want to keep the Common file.
+#
+open build/C
+open build/OCaml
+open build/LaTeX
+
+#
+# The command-line variables are defined *after* the
+# standard configuration has been loaded.
+#
+DefineCommandVars()
+
+#
+# Include the OMakefile in this directory.
+#
+.SUBDIRS: .

examples/module_new.ml

+open Opycaml.Api
+
+let _ =
+  Base.initialize ();
+  let mdl = Module.new_ "MyModule" in
+  let mdldic = Import.getModuleDict () in
+  Dict.setItemString mdldic "MyModule" mdl;
+  let dic = Module.getDict mdl in
+  Dict.setItemString dic "answer" (Int.fromLong 42);
+  ignore (Base.main []);
+  Base.finalize ()
+;;
+
+
+  
+(* open Opycaml.Api is recommended. *)
+open Opycaml.Api
+
+let _ =
+  Base.initialize ();
+
+  let string = Import.importModule "string" in (* from string import * *)
+  let dict = Module.getDict string in
+  let lowercase = Dict.getItemString dict "lowercase" in
+  let capitalize = Dict.getItemString dict "capitalize" in
+
+  let res = Object.callObject (Callable.coerce capitalize) [lowercase] in
+
+  (* String class is not accessible by String but Py.String, in order
+     to avoid the name space collision with String in OCaml standard
+     library. *)
+  prerr_endline (Py.String.asString (Py.String.coerce res));
+
+  Base.finalize ()
+;;

examples/testoo.ml

+(* open Opycaml.Api is recommended. *)
+open Opycaml.OOApi
+
+let _ =
+  Base.initialize ();
+
+  let string = Import.importModule "string" in (* from string import * *)
+  let dict = string#getDict in
+  let lowercase = dict#getItemString "lowercase" in
+  let capitalize = dict#getItemString "capitalize" in
+
+  let res = Object.callObject (Callable.coerce capitalize) [lowercase] in
+
+  (* String class is not accessible by String but OPy.String, in order
+     to avoid the name space collision with String in OCaml standard
+     library. *)
+  prerr_endline (OPy.String.coerce res)#asString;
+
+  Base.finalize ()
+;;

js_of_ocaml/OMakefile

 OCAMLPPFLAGS += -syntax camlp4o -package js_of_ocaml.syntax
 OCAMLFLAGS += -annot
 
-.DEFAULT: $(OCamlProgram test, py_of_ocaml test)
+.DEFAULT: $(OCamlProgram test, py_of_ocaml opy_of_ocaml test)
+.DEFAULT: $(OCamlProgram testoo, py_of_ocaml opy_of_ocaml testoo)
 
 .PHONY: clean
 clean:

js_of_ocaml/opy_of_ocaml.ml

+open Opycaml.OOApi
+
+module OT = Opycaml.Type
+
+module Js : sig
+  type 'a t
+  type 'a gen_prop
+  type 'a readonly_prop = < get : 'a> gen_prop
+  type 'a meth
+  val dict : #OPy.o_Dict -> 'a t
+  module Unsafe : sig
+    val get : 'a t -> string -> 'b
+    val meth_call : 'a t -> string -> #OPy.o_Object array -> 'b
+    val inject : #OPy.o_Object -> OPy.o_Object
+  end
+end = struct
+  type 'a t = OPy.o_Dict
+  type 'a gen_prop
+  let dict = Obj.magic
+  module Unsafe = struct
+    let get (o : 'a t) name = Obj.magic (o#getItemString name)
+    let meth_call (o : OPy.o_Dict) name args = 
+      Obj.magic (Object.callObject (Callable.coerce (o#getItemString name)) (Array.to_list args ))
+    let inject = Obj.magic
+  end
+
+  type 'a readonly_prop = < get : 'a> gen_prop
+  type 'a meth
+end

js_of_ocaml/testoo.ml

+(* open Opycaml.Api is recommended. *)
+open Opycaml.OOApi
+open Opy_of_ocaml
+
+class type module_string = object
+  method lowercase  : OPy.o_String Js.readonly_prop
+  method capitalize : #OPy.o_String -> OPy.o_String Js.meth
+end
+
+let import_module_dict name = Js.dict (Import.importModule name)#getDict
+
+let _ =
+  Base.initialize ();
+
+  let module_string : module_string Js.t = import_module_dict "string" in (* from string import * *)
+  let lowercase = module_string##lowercase in
+  let res = module_string##capitalize( lowercase ) in
+
+  (* String class is not accessible by String but OPy.String, in order
+     to avoid the name space collision with String in OCaml standard
+     library. *)
+  prerr_endline res#asString;
+
+  Base.finalize ()
+;;
     | <:ctyp< `$v$ >> -> [v]
     | _ -> []
 
+  (* CR jfuruse: depend *)
+  let type_path_normalize = function
+    | <:ident< Type.$lid:name$ >> -> <:ident< $lid:name$ >>
+    | id-> id
+
   (* Get class type encoding *)
   let class_type =
     let extract k varpath typath =
       (* CR jfuruse: depend *)
-      let normalize_path = function
-        | <:ident< Type.$lid:name$ >>
+      let normalize_path p = match type_path_normalize p with
         | <:ident< $lid:name$ >> -> Some name
         | _ -> None
       in
 
     let mk_tyvar pos = TyQuo(_loc, Printf.sprintf "a%d" pos) (* No ' required! *)
 
+    let extract_class_from_type = function
+      | <:ctyp< [ > $id:clsname$ ] $id:t$ >> -> Some (`Bigger, clsname, t, None)
+      | <:ctyp< [ > $id:clsname$ ] $id:t$ $id:container$ >> -> Some (`Bigger, clsname, t, Some container)
+      | <:ctyp< $id:clsname$ $id:t$ >> -> Some (`Equal, clsname, t, None)
+      | <:ctyp< $id:clsname$ $id:t$ $id:container$ >> -> Some (`Equal, clsname, t, Some container)
+      | _ -> None
+
+    let rec mk_mapper = function
+      | <:ident< $lid:id$ >> -> <:ident< $lid: id ^ "_map"$ >>
+      | <:ident< $id1$.$id2$ >> -> <:ident< $id1$.$ mk_mapper id2 $ >>
+      | _ -> assert false
+
     (* [> _Cls ] t -> ...   =>    < _Cls : _Cls t; .. > -> ... *)
-    let wrap_in pos v ty =
+    let wrap_in v ty0 =
 
       (* escape label *)
       let ty, recover_label =
-        match ty with
+        match ty0 with
         | TyLab(loc, name, ty) -> ty, fun ty -> TyLab(loc, name, ty)
-        | TyOlb(loc, name, ty) -> ty, fun ty -> TyOlb(loc, name, ty)
-        | _ -> ty, fun ty -> ty
+        | TyOlb(loc, name, ty) -> 
+            <:ctyp< $ty$ option >>, 
+            (fun ty -> 
+              match ty with
+              | <:ctyp< $ty$ option >> -> TyOlb(loc, name, ty)
+              | _ -> assert false)
+        | _ -> ty0, fun ty -> ty
       in
 
-      match ty with
-      | <:ctyp< [ > Type.$lid:clsname$ ] Type.t >> ->
+      let extract_arg_type = function
+        | <:ctyp< [ > $id:clsname$ ] $id:t$ >> -> Some (clsname, t, None)
+        | <:ctyp< [ > $id:clsname$ ] $id:t$ $id:container$ >> -> Some (clsname, t, Some container)
+        | _ -> None
+      in
+
+      let normalize_arg_type ctyp = 
+        match extract_class_from_type ctyp with
+        | None | Some (`Equal, _, _, _) -> None
+        | Some (`Bigger, clsname, t, container) ->
+            let clsname = type_path_normalize clsname in
+            let t = type_path_normalize t in
+            match clsname, t with
+            | <:ident< $lid:clsname$ >>, <:ident< t >> -> Some (clsname, container)
+            | _ -> None
+      in
+
+      match normalize_arg_type ty with
+      | None -> v, ty0
+      | Some (clsname, None) ->
           let oty = recover_label <:ctyp< < $lid:clsname$ : $lid:clsname$ t ; .. > >> in
           <:expr< $v$ # $clsname$ >>, oty
-
-      | <:ctyp< [ > Type.$lid:clsname$ ] Type.t option >> ->
-          let tv = mk_tyvar pos in
-          let oty = recover_label <:ctyp< < $lid:clsname$ : $lid:clsname$ t ; .. > option >> in
-          <:expr< option_map $v$ (fun x -> x# $clsname$) >>, oty
-
-      | _ ->
-          v, ty
+      | Some (clsname, Some cont) ->
+          let oty = recover_label <:ctyp< < $lid:clsname$ : $lid:clsname$ t ; .. > $id:cont$ >> in
+          <:expr< $id:mk_mapper cont$ $v$ (fun x -> x# $clsname$) >>, oty
     ;;
 
     (* ... -> _Cls t   =>   ... -> _Cls *)
     let wrap_out ty =
-      match ty with
-      | <:ctyp@tyloc< Type.$lid:clsname$ Type.t >> ->
+      let normalize_arg_type ctyp =
+        match extract_class_from_type ctyp with
+        | None | Some (`Bigger, _, _, _) -> None
+        | Some (`Equal, clsname, t, container) ->
+            let clsname = type_path_normalize clsname in
+            let t = type_path_normalize t in
+            match clsname, t with
+            | <:ident< $lid:clsname$ >>, <:ident< t >> -> Some (clsname, container)
+            | _ -> None
+      in
+      match normalize_arg_type ty with
+      | None -> (fun e -> e), ty
+      | Some (clsname, None) ->
           (fun e -> <:expr< ! $lid: "new_" ^ class_name clsname$ $e$ >>),
-          <:ctyp@tyloc< $id: m_class_ident clsname$ >>
-      | <:ctyp@tyloc< Type.$lid:clsname$ Type.t option >> ->
-          (fun e -> <:expr< option_map $e$ (! $lid: "new_" ^ class_name clsname$) >>),
-          <:ctyp@tyloc< $id: m_class_ident clsname $ option >>
-      | _ -> (fun e -> e), ty
+          <:ctyp< $id: m_class_ident clsname$ >>
+
+      | Some (clsname, Some cont) ->
+          (fun e -> <:expr< $id: mk_mapper cont$ $e$ (! $lid: "new_" ^ class_name clsname$) >>),
+          <:ctyp< $id: m_class_ident clsname $ $id: cont$ >>
     ;;
 
     let wrap_oo base ty =
       let rec args pos = function
         | <:ctyp< $argty$ -> $ty$ >> ->
 
-            let recover_label, add_pat_label, add_exp_label, argty =
+            (* CR jfuruse: Should move to wrap_in *)
+            let add_pat_label, add_exp_label =
               match argty with
-              | TyLab (_, lab, argty) ->
-                  (fun ty -> TyLab (_loc, lab, ty)),
+              | TyLab (_, lab, _argty) ->
                   (fun p -> PaLab (_loc, lab, p)),
-                  (fun e -> ExLab (_loc, lab, e)),
-                  argty
-              | TyOlb (_, lab, argty) ->
-                  (fun ty -> TyOlb (_loc, lab, ty)),
+                  (fun e -> ExLab (_loc, lab, e))
+              | TyOlb (_, lab, _argty) ->
                   (fun p -> PaOlb (_loc, lab, p)),
-                  (fun e -> ExOlb (_loc, lab, e)),
-                  argty
-              | _ -> let id x = x in id, id, id, argty
+                  (fun e -> ExOlb (_loc, lab, e))
+              | _ -> let id x = x in id, id
             in
 
             let mty, absts, args, mk_return = args (pos+1) ty in
             let v = <:expr<$lid:mk_id pos$>> in
 
             let pat = add_pat_label <:patt< $lid:mk_id pos$ >> in
-            let e, oty = wrap_in pos v argty in
+            let e, oty = wrap_in v argty in
             let e = add_exp_label e in
-            let oty = recover_label oty in
 
             let absts = pat :: absts in
             let args = e :: args in
           match typ with
           | <:ctyp<  $arg$ -> $typ'$  >> ->
               begin match class_type arg with
-              | Some (`Bigger, tyname') when tyname' = tyname ->
+              | Some (`Bigger, tyname') when tyname' = tyname -> (* Make it a method! *)
                   let polytype, exp = A.wrap_oo <:expr< Py.$uid:modname$.$lid:name$ t >> typ' in
                   st, <:class_str_item< method $name$ : $polytype$ = $exp$ >> :: methods
               | _ ->
         | Some v -> Some (f v)
         | None -> None
       ;;
+      let list_map v f = List.map f v
+      ;;
       $mutual_class_types$
       $news$
       $classes$

pa/OMakefile

-.PHONY: all install clean
-
-USE_OCAMLFIND = true
-
-OCAMLPACKS[] =
-	camlp4
-
-OCAMLINCLUDES +=
-
-NATIVE_ENABLED = $(OCAMLOPT_EXISTS)
-BYTE_ENABLED = true
-
-OCAMLCFLAGS   += -annot -w Ae-26
-OCAMLOPTFLAGS   += -annot -w Ae-26
-
-OCAMLPACKAGEFLAGS= 
-
-FILES[] =
-	pa_opycaml
-
-LIB = pa_opycaml
-
-.DEFAULT: $(OCamlLibrary $(LIB), $(FILES))
-
-clean:
-	rm $(filter-proper-targets $(ls R, .))
-
-OCAMLDEPFLAGS=-pp camlp4of
-OCAMLPPFLAGS=-pp camlp4of
-
-# top_test: pa_bind_inline.cma
-# 	ocaml -I +camlp4 dynlink.cma camlp4o.cma pa_bind_inline.cma 
-# 
-# .PHONY: test
-# 
-# test: pa_bind_inline.cma
-# 	camlp4o -printer OCaml -I . pa_bind_inline.cma test_pa_bind_inline.ml  
-
-# It is local use
-
-# install: pa_bind_inline.cma pa_bind_inline.cmxa
-# 	ocamlfind remove bind_inline
-# 	ocamlfind install bind_inline META pa*.cmo pa*.cmx pa*.cmi pa*.cma pa*.cmxa

pa/pa_opycaml.ml

-module Id = struct
-  let name = "pa_opycaml"
-  let version = "1.0"
-end
-
-open Camlp4
-open PreCast
-
-(* See tutorial at
-   http://ambassadortothecomputers.blogspot.com/2010/03/reading-camlp4-part-5-filters.html
-   http://brion.inria.fr/gallium/index.php/Camlp4MapGenerator
-*)
-
-module Make (AstFilters : Sig.AstFilters) = struct
-  open AstFilters
-  open Ast
-
-  let gloc = Loc.ghost
-
-  (** Convert str_item to its normal form, which is consistent with those <:str_item<..>> creates.
-
-      There is a nice entry blog about this:
-      http://ambassadortothecomputers.blogspot.com/2010/03/reading-camlp4-part-5-filters.html
-  *)
-  let rec normalize_str_item sitem = match sitem with
-    | StNil _ -> sitem
-    | StSem (_, _, StNil _) -> sitem
-    | _ ->
-        let loc = Ast.loc_of_str_item sitem in
-        StSem (loc, sitem, StNil gloc)
-
-  (** Iteration over struct item StSem *)
-  let rec iter_str_item f sitem =
-    match sitem with
-    | StNil _ -> ()
-    | StSem (_, sitem1, sitem2) -> iter_str_item f sitem1; iter_str_item f sitem2
-    | _ -> f (normalize_str_item sitem)
-
-  let rec fold_str_item f st sitem =
-    match sitem with
-    | StNil _ -> st
-    | StSem (_, sitem1, sitem2) ->
-        let st1 = fold_str_item f st sitem1 in
-        fold_str_item f st1 sitem2
-    | _ -> f st (normalize_str_item sitem)
-
-  (** Concatenate class str items *)
-  let concat_class_str_items csitems =
-    let _loc = Loc.ghost in
-    List.fold_left (fun st csitem -> <:class_str_item< $st$ $csitem$ >>) <:class_str_item<>> csitems
-
-  (** Concatenate str items *)
-  let concat_str_items sitems =
-    let _loc = Loc.ghost in
-    List.fold_left (fun st sitem -> <:str_item< $st$ $sitem$ >>) <:str_item<>> sitems
-
-  (** Concatenate str items *)
-  let concat_class_exprs es =
-    let _loc = Loc.ghost in
-    StCls (_loc,
-           List.fold_left (fun st e -> <:class_expr< $st$ and $e$ >>) <:class_expr<>> es)
-
-
-  let classes = ref []
-  let modules = ref []
-
-
-  let class_name s = "o" ^ s
-
-  let mk_id pos = Printf.sprintf "v%d" pos
-
-  let mk_tyvar pos = TyQuo(gloc, Printf.sprintf "a%d" pos) (* No ' required! *)
-
-  (* [> _Cls ] t -> ...   =>    _Cls -> ... *)
-  let wrap_in v ty =
-    match ty with
-    | <:ctyp< [ > $ <:ctyp@tyloc< $lid:clsname$ >> $ ] t >> ->
-        <:expr@gloc< $v$#$clsname$ >>,
-        <:ctyp@tyloc< $lid: class_name clsname$ >>
-    | _ -> v, ty
-
-  (* ... -> _Cls t   =>   ... -> _Cls *)
-  let wrap_out ty =
-    match ty with
-    | <:ctyp< $ <:ctyp@tyloc< $lid:clsname$ >> $ t >> ->
-        (fun e -> <:expr@gloc< new $lid: class_name clsname$ $e$ >>), <:ctyp@tyloc< $lid: class_name clsname$ >>
-    | _ -> (fun e -> e), ty
-
-  let wrap = object
-
-    inherit Ast.map as super
-
-    method! str_item sitem =
-      iter_str_item (function
-        | <:str_item@mloc< module $modname$ = $module_expr$ >> ->
-
-            (* Unfortunately we cannot write
-
-               <:str_item@mloc< module $modname$ = struct $sitems$ end >>
-
-               here, since struct $sitems$ end creates a pattern MeStr(_, StSem(_, _, StNil)),
-               which does not match with the actual AST of struct ... end.
-
-               There is no << >> way to write MeStr(_, _)
-
-            *)
-            prerr_endline modname;
-
-            begin match module_expr with
-            | MeStr( _, sitems ) ->
-
-                (* Obtain functions which can be methods or not *)
-                let meths, non_meths = fold_str_item (fun (meths, non_meths) si ->
-                  match si with
-                  | <:str_item@loc< external $name$ : [ > $cls$ ] t -> $ty_rest$ = $_name$ >> ->
-                      begin match cls with
-                      | <:ctyp<$lid:tname$>> when tname = "_" ^ modname ->
-                          (name, loc, ty_rest) :: meths, non_meths
-                      | _ -> meths, (name, loc, <:ctyp@gloc< [ > $cls$ ] t -> $ty_rest$ >>) :: non_meths
-                      end
-                  | <:str_item@loc< external $name$ : $ty$ = $_name$ >> ->
-                      let non_meth = name, loc, ty in
-                      meths, non_meth :: non_meths
-                  | _ -> meths, non_meths (* ignored *))
-                  ([], [])
-                  sitems
-                in
-
-                let wrap_oo base ty =
-
-                  let rec args pos = function
-                    | <:ctyp< $argty$ -> $ty$ >> ->
-
-                        let qvars, mty, absts, args, mk_return = args (pos+1) ty in
-
-                        let v = <:expr@gloc<$lid:mk_id pos$>> in
-                        let pat = mk_id pos in
-                        let e, _ = wrap_in v argty in
-
-                        let absts = pat :: absts in
-                        let args = e :: args in
-
-                        let qvars, mty = match argty with
-                          | <:ctyp< [ > $cls$ ] t >> ->
-                              begin match cls with
-                              | <:ctyp< $lid:clsname$ >> ->  (* X *)
-                                  let tv = mk_tyvar pos in
-                                    (* Strange, but < $ctyp$ : $ctyp$; ..> *)
-                                  let oty = <:ctyp@gloc< < $lid:clsname$ : $lid:clsname$ t ; .. > >> in
-                                  tv :: qvars,
-                                  <:ctyp@gloc< $ TyAli(gloc, oty, tv) $ -> $mty$ >>
-                              | _ -> qvars, <:ctyp@gloc< $argty$ -> $mty$ >>
-                              end
-                          | _ -> qvars, <:ctyp@gloc< $argty$ -> $mty$ >>
-                        in
-                        qvars, mty, absts, args, mk_return
-
-                    | mty ->
-                        let mk_return, mty = wrap_out mty in
-                        [], mty, [], [], mk_return
-                  in
-                  let qvars, mty, absts, args, mk_return = args 0 ty in (* X *)
-                  let q mty = function
-                    | [] -> mty
-                    | qvs ->
-                        let rec qapp = function
-                          | [] -> assert false
-                          | [qv] -> qv
-                          | qv::qvs -> TyApp(gloc, qv, qapp qvs) (* strange but it is as an app *)
-                        in
-                        TyPol (gloc, qapp qvs, mty)
-                  in
-                  let rec mk_app b = function
-                    | [] -> b
-                    | e::es -> mk_app <:expr@gloc< $b$ $e$ >> es
-                  in
-                  let rec mk_abst b = function
-                    | [] -> b
-                    | v::vs -> <:expr@gloc< fun $lid:v$ -> $mk_abst b vs$ >>
-                  in
-                  q mty qvars, mk_abst (mk_return (mk_app base args)) absts
-                in
-
-                let mk_non_method name loc ty =
-                  let id = <:expr@loc< $lid:name$ >> in
-                  let poly_type, expr = wrap_oo id ty in
-                  <:str_item@loc<
-                    let $lid:name$ : $poly_type$ = $expr$
-                  >>
-                in
-
-                let mk_method name loc ty_rest =
-                  let id = <:expr@loc< Autoapi . $uid:modname$.$lid:name$ >> in
-                  let poly_type, expr = wrap_oo <:expr@loc<$id$ t>> ty_rest in
-                      <:class_str_item@loc<
-                          method $name$ : $poly_type$ = $expr$
-                      >>
-                in
-
-                let meths =
-                  concat_class_str_items
-                    (List.map (fun (name, loc, ty_rest) -> mk_method name loc ty_rest) meths)
-                in
-                let tname = "_" ^ modname in
-                let tnametyp = <:ctyp@gloc< $lid:tname$ >> in
-                let sitem_class =
-                      <:str_item@gloc<
-                          class $lid: class_name tname$ t = object
-                            $meths$
-                            method $tname$ = (t :> $tnametyp$  t )
-                          end
-                      >>
-                in
-                let class_expr =
-                  match
-                    fold_str_item (fun st -> function
-                      | <:str_item< class $cle$ >> -> cle :: st
-                      | _ -> st
-                    ) [] sitem_class
-                  with
-                  | [cle] -> cle
-                  | _ -> assert false
-                in
-                classes := class_expr :: !classes;
-
-                begin match non_meths with
-                | [] -> ()
-                | _ ->
-                    let non_meths = concat_str_items
-                      (List.map (fun (name, loc, ty) -> mk_non_method name loc ty) non_meths)
-                    in
-
-                    let sitems' = <:str_item@gloc<
-                                      $non_meths$
-                                  >>
-                    in
-                    let meStr =
-                      <:module_expr@mloc<
-                          struct
-                            open $ <:ident@gloc< Autoapi . $uid:modname$ >> $
-                            $sitems'$
-                          end
-                      >>
-                    in
-                    modules := <:str_item@mloc< module $modname$ = $meStr$ >> :: !modules;
-                end
-            | _ -> ()
-            end
-        | StSem(_, _, StNil _) | StNil _ -> ()
-        | _ -> assert false (* Normalization is not done?!?! *)
-      ) sitem;
-
-      let class_defs = concat_class_exprs (List.rev !classes) in
-      <:str_item@gloc<
-        open Type
-        module Classes = struct $ class_defs $ end
-        open Classes
-        $ concat_str_items (List.rev !modules) $
-      >>
-
-  end
-
-  let _ = AstFilters.register_str_item_filter wrap#str_item
-
-end
-
-let module M = Register.AstFilter(Id)(Make) in ()

pa/test.sh

-camlp4of ./pa_opycaml.cmo -impl ../autoapi.ml 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.