Commits

camlspotter committed 4507fbf

wrap for non methods

  • Participants
  • Parent commits ec79085
  • Branches dev

Comments (0)

Files changed (1)

             (* Obtain functions which can be methods or not *)
             let meths, non_meths = fold_sitems (fun (meths, non_meths) si ->
               match si with
-              | StExt (loc, name, <:ctyp< [ > $cls$ ] t -> $ty_rest$>>, _slist) ->
-                  (* <:str_item< external $name$ : [ > $cls$ ] t -> $_$ = $_$>> ->     DOES NOT WORK... *)
-                  begin match cls with
-                  | <:ctyp<$lid:tname$>> when tname = "_" ^ modname ->
-                      (name, loc, ty_rest) :: meths, non_meths
-                  | _ -> meths, si :: non_meths
+              | StExt (loc, name, ty, _slist) ->
+                  let non_meth = name, loc, ty in
+                  begin match ty with
+                  | <:ctyp< [ > $cls$ ] t -> $ty_rest$>> ->
+                      (* <:str_item< external $name$ : [ > $cls$ ] t -> $_$ = $_$>> ->     DOES NOT WORK... *)
+                      begin match cls with
+                      | <:ctyp<$lid:tname$>> when tname = "_" ^ modname ->
+                          (name, loc, ty_rest) :: meths, non_meths
+                      | _ -> meths, non_meth :: non_meths
+                      end
+                  | _ -> meths, non_meth :: non_meths
                   end
-              | _ -> meths, si :: non_meths)
+              | _ -> meths, non_meths (* ignored *))
               ([], [])
               sitems
             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< $lid:name$ >> in
               let poly_type, expr = wrap_oo <:expr@loc<$id$ t>> ty_rest in
               >>
             in
 
-            let non_meths = concat_str_items non_meths in
+            let non_meths = concat_str_items 
+              (List.map (fun (name, loc, ty) -> mk_non_method name loc ty) non_meths)
+            in
 
             let meths =
               concat_class_str_items
             let tnametyp = <:ctyp< $lid:tname$ >> in
             let sitems' = <:str_item<
                       $non_meths$
-                      class $lid:tname$ = object
+                      class $lid:tname$ t = object
                         $meths$
                         method $tname$ = (t :> $tnametyp$  t )
                       end >>