1. camlspotter
  2. mutated_ocaml

Commits

camlspotter  committed af4b9fe

added info where types come from

  • Participants
  • Parent commits bd96827
  • Branches ocamlspot

Comments (0)

Files changed (7)

File ocamlspot/ocamlspot.ml

View file
         (* print "Val: val name : type" if it is a Str: val *)
         let print_sig_entry annots =
           let rec find_type = function
-            | Annot.Type (typ, _) :: _ -> Some typ
+            | Annot.Type (typ, _, _) :: _ -> Some typ
             | _::xs -> find_type xs
             | [] -> None
           in
         (* print_type_decl: if one Type is found *)
         if C.print_type_declaration then begin
           match List.filter (function Annot.Type _ -> true | _ -> false) annots with
-          | [Annot.Type (typ, env)] -> 
+          | [Annot.Type (typ, env, `Expr)] -> 
               printf "Expand: @[%a@]@." Typeexpand.format_as_expr (Typeexpand.expand file.File.load_paths env typ)
+          | [Annot.Type (typ, env, `Pattern)] -> 
+              printf "Expand: @[%a@]@." Typeexpand.format_as_pattern (Typeexpand.expand file.File.load_paths env typ)
+          | [Annot.Type (_typ, _env, `Val)] -> ()
           | [] -> ()
           | _ -> eprintf "More than one Annot.Type found. Disabled --print-type-decl.@."
         end;

File ocamlspot/spotapi.ml

View file
 module Annot = struct
   include Annot
 
+  let string_of_at = function
+    | `Expr -> "Expr"
+    | `Pattern -> "Pattern"
+    | `Val -> "Val"
+
   let format ppf = function
-    | Type (typ, _env) -> 
+    | Type (typ, _env, at) -> 
 	Printtyp.reset ();
 	Printtyp.mark_loops typ;
         (* CR jfuruse: not fancy having @. *)
 	fprintf ppf "Type: %a@ " (Printtyp.type_scheme ~with_pos:false) typ;
-	fprintf ppf "XType: %a" (Printtyp.type_scheme ~with_pos:true) typ
+	fprintf ppf "XType: %a@ " (Printtyp.type_scheme ~with_pos:true) typ;
+        fprintf ppf "At: %s" (string_of_at at)
     | Mod_type mty -> 
 	fprintf ppf "Type: %a@ " (Printtyp.modtype ~with_pos:false) mty;
 	fprintf ppf "XType: %a" (Printtyp.modtype ~with_pos:true) mty
         fprintf ppf "Non_expansive: %b" b
 
   let summary ppf = function
-    | Type (_typ, _env) -> 
+    | Type (_typ, _env, at) -> 
         (* CR jfuruse: not fancy having @. *)
 	fprintf ppf "Type: ...@ ";
-	fprintf ppf "XType: ..."
+	fprintf ppf "XType: ...@ ";
+        fprintf ppf "At: %s" (string_of_at at)
     | Mod_type _mty -> 
 	fprintf ppf "Type: ...@ ";
 	fprintf ppf "XType: ..."

File ocamlspot/spotapi.mli

View file
 module Annot : sig
 
   type t = Spot.Annot.t =
-      | Type              of Types.type_expr * Env.t
+      | Type              of Types.type_expr * Env.t * [`Expr | `Pattern | `Val]
       | Str               of Abstraction.structure_item
       | Use               of Kind.t * Path.t
       | Module            of Abstraction.module_expr

File typing/spot.ml

View file
     
 module Annot = struct
   type t =
-    | Type of Types.type_expr * Env.t (* sub-expression's type *)
+    | Type of Types.type_expr * Env.t * [`Expr | `Pattern | `Val]
     | Str of Abstraction.structure_item 
     | Use of Kind.t * Path.t
     | Module of Abstraction.module_expr
     | Non_expansive of bool
     | Mod_type of Types.module_type
 
-  let equal t1 t2 =
-    match t1, t2 with
-    | Type (t1, _), Type (t2, _) -> t1 == t2
+  let equal t1 t2 = match t1, t2 with
+    | Type (t1, _, _), Type (t2, _, _) -> t1 == t2
     | Mod_type mty1, Mod_type mty2 -> mty1 == mty2
     | Str sitem1, Str sitem2 -> Abstraction.Structure_item.equal sitem1 sitem2
     | Module mexp1, Module mexp2 -> mexp1 == mexp2

File typing/spot.mli

View file
 
 module Annot : sig
   type t =
-    | Type of Types.type_expr * Env.t (* sub-expression's type *)
+    | Type of Types.type_expr * Env.t * [`Expr | `Pattern | `Val]
     | Str of Abstraction.structure_item 
     | Use of Kind.t * Path.t
     | Module of Abstraction.module_expr

File typing/typecore.ml

View file
 *)
 let re node =
   Stypes.record (Stypes.Ti_expr node);
-  Spot.Annot.record node.exp_loc (Spot.Annot.Type (node.exp_type, node.exp_env));
+  Spot.Annot.record node.exp_loc (Spot.Annot.Type (node.exp_type, node.exp_env, `Expr));
   node
 ;;
 let rp node =
   Stypes.record (Stypes.Ti_pat node);
-  Spot.Annot.record node.pat_loc (Spot.Annot.Type (node.pat_type, node.pat_env));
+  Spot.Annot.record node.pat_loc (Spot.Annot.Type (node.pat_type, node.pat_env, `Pattern));
   node
 ;;
 

File typing/typemod.ml

View file
             Spot.Annot.record item.psig_loc
               (Spot.Annot.Str (Spot.Abstraction.Str_value id));
             Spot.Annot.record item.psig_loc
-              (Spot.Annot.Type (desc.val_type, env));
+              (Spot.Annot.Type (desc.val_type, env, `Val));
 	    (* CR jfuruse : or, (Spot.Annot.Use (Spot.Kind.Value, ...)) ?? *) 
             let rem = transl_sig newenv srem in
             if List.exists (Ident.equal id) (get_values rem) then rem