Commits

camlspotter committed 19cb24f Merge

merge

Comments (0)

Files changed (4)

0scripts/0MAKERELEASE

 #!/usr/bin/perl
 
-$VERSION="0.1.1";
+$VERSION="0.2.0";
 $PURE_OCAML="ocaml3112";
 
 `/bin/cp ocamlspot/INSTALL-ocamlspot.txt ocamlspot/BRAIN_DEAD_INSTALL.sh .`;

dcamlexamples/ex003_plus_submodules.ml

+module Plus = struct
+
+  type 'a t = 'a -> 'a -> 'a
+
+  let (+) $:t = t
+
+end
+
+module Int = struct
+
+  let (+) = Pervasives.(+)
+
+end
+
+module Float = struct
+
+  let (+) = Pervasives.(+.)
+
+end
+
+(* To overload things, we need compose the class and instances *)
+
+module Overloaded : sig
+    
+  type 'a t (* must be abstract! *)
+      
+  val (+) : $:'a t -> 'a -> 'a -> 'a
+
+  module Int : sig val (+) : int t end
+  module Float : sig val (+) : float t end
+
+end = struct
+
+  include Plus
+
+  (* $'Caml-0.2.0 : sub modules are recursively searched 
+     for instances *) 
+  module Int = Int
+  module Float = Float
+    
+end
+
+open Overloaded
+
+let () = 
+  assert (1 + 2 = 3);
+  assert (1.0 + 2.0 = 3.0)
+;;
+ 
+      
+      

dcamlexamples/ex022_sum_overload.ml

+(* $'Caml 0.2.0 introduces yet another way of overloading *)
+
+module Sum : sig 
+  type 'a t (* It must be abstract *)
+  val sum : $:'a t -> 'a -> int
+  val lift : ('a -> int) -> 'a t
+    (* We need a way to `lift' instance definitions to abstracted values *)
+end = struct
+  type 'a t = 'a -> int
+  let sum $:t = t
+  let lift x = x
+end
+
+module Int = struct
+  let int = Sum.lift (fun x -> x)
+end
+
+module List = struct
+  let rec sum = function
+    | [] -> 0
+    | x::xs -> Sum.sum x + sum xs
+
+  let list = Sum.lift sum
+end
+
+(* Create a module Overload, and just list instances you want to use.
+   The name "Overload" is special to provide a search space 
+   for the overload instance resolution.
+*)
+module Overload = struct
+  include Int
+  include List
+end
+
+let () =
+  assert (Sum.sum 1 = 1);
+  assert (Sum.sum [[]; [1]; [2;3]; [4;5;6]] = 21)
+;;

typing/dispatch.ml

           end
       | _ -> raise Not_found
 
+    (* [candidates env ~mpath_t ~mpath mty] searches values in module [mpath]
+       of signature [mty], whose types have the form $..:.. -> .. -> mpath_t 
+    *)
     let candidates env ~mpath_t ~mpath mty =
       let paths =
         try value_paths env mpath mty with
         try
           (* it may not be a value *)
           let vdesc = Env.find_value path env in
-          (* the value's type must have the form $..:.. -> .. -> mpath.t *)
+          (* the value's type must have the form $..:.. -> .. -> mpath_t *)
           let rec has_mpath_t visited ty =
             let ty = expand_head env ty in
             if List.memq ty visited then raise Not_found;
           (path, vdesc) :: st
         with Not_found -> st) [] paths
 
-(*
-  let candidates env ~mpath_t ~mpath mty =
-      let paths = value_paths env mpath mty in
-      List.fold_left (fun st path ->
-        try
-          (* it may not be a value *)
-          let vdesc = Env.find_value path env in
-          (* the value's type must have the form $..:.. -> .. -> t
-             where mpath.t :> t *)
-          let rec has_mpath_t visited ty =
-            let ty = expand_head env ty in
-            if List.memq ty visited then raise Not_found;
-            match ty.desc with
-            | Tarrow (l, t, u, c) when is_dispatch l -> has_mpath_t (ty :: visited) u
-            | _ ->
-                let _force = subtype env ty (instance vdesc.val_type) in
-                ()
-          in
-          has_mpath_t [] vdesc.val_type;
-          (path, vdesc) :: st
-        with Not_found | Subtype _ -> st) [] paths
-*)
-
     let rec format_expr ppf e =
       match e.exp_desc with
       | Texp_apply (e, args) ->
                   raise Not_found
             in
             Format.eprintf "%a => %s@." Printtyp.type_expr typ (Path.name mpath_t);
-            let candidates = candidates env ~mpath_t ~mpath mty in
+            let candidates_in_mpath = candidates env ~mpath_t ~mpath mty in
+
+            (* It also searches a module named Overload *)
+            let candidates_in_overload = 
+              try
+                let mpath, mty = Env.lookup_module (Longident.Lident "Overload") env in
+                candidates env ~mpath_t ~mpath mty 
+              with
+              | _ -> []
+            in
+
+            let candidates = candidates_in_mpath @ candidates_in_overload in
+
             (* or *)
             List.fold_left (fun st (path, vdesc) ->
               Format.eprintf "Checking %s : %a@." (Path.name path)
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.