Commits

camlspotter  committed edc86ca

backported from 921805818b16

  • Participants
  • Parent commits 77b69cf
  • Branches ocamlspot

Comments (0)

Files changed (18)

 typing/predef.cmi: typing/types.cmi typing/path.cmi typing/ident.cmi 
 typing/primitive.cmi: 
 typing/printtyp.cmi: typing/types.cmi typing/path.cmi typing/outcometree.cmi \
-    parsing/longident.cmi typing/ident.cmi 
+    parsing/longident.cmi typing/ident.cmi typing/env.cmi 
 typing/spot.cmi: typing/types.cmi typing/typedtree.cmi typing/path.cmi \
     parsing/location.cmi typing/ident.cmi 
 typing/stypes.cmi: typing/typedtree.cmi parsing/location.cmi typing/annot.cmi 
     parsing/longident.cmx typing/ident.cmx typing/env.cmx typing/ctype.cmx \
     utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
     typing/printtyp.cmi 
-typing/spot.cmo: typing/types.cmi typing/typedtree.cmi typing/printtyp.cmi \
-    typing/path.cmi typing/mtype.cmi parsing/location.cmi typing/ident.cmi \
-    typing/ctype.cmi utils/config.cmi utils/clflags.cmi typing/spot.cmi 
-typing/spot.cmx: typing/types.cmx typing/typedtree.cmx typing/printtyp.cmx \
-    typing/path.cmx typing/mtype.cmx parsing/location.cmx typing/ident.cmx \
-    typing/ctype.cmx utils/config.cmx utils/clflags.cmx typing/spot.cmi 
+typing/spot.cmo: typing/types.cmi typing/typedtree.cmi typing/spotcrc.cmo \
+    typing/printtyp.cmi typing/path.cmi typing/mtype.cmi parsing/location.cmi \
+    typing/ident.cmi typing/ctype.cmi utils/config.cmi utils/clflags.cmi \
+    typing/spot.cmi 
+typing/spot.cmx: typing/types.cmx typing/typedtree.cmx typing/spotcrc.cmx \
+    typing/printtyp.cmx typing/path.cmx typing/mtype.cmx parsing/location.cmx \
+    typing/ident.cmx typing/ctype.cmx utils/config.cmx utils/clflags.cmx \
+    typing/spot.cmi 
+typing/spotcrc.cmo: 
+typing/spotcrc.cmx: 
 typing/stypes.cmo: typing/typedtree.cmi typing/printtyp.cmi \
     parsing/location.cmi utils/clflags.cmi typing/annot.cmi typing/stypes.cmi 
 typing/stypes.cmx: typing/typedtree.cmx typing/printtyp.cmx \
 asmcomp/selection.cmi: asmcomp/mach.cmi asmcomp/cmm.cmi 
 asmcomp/spill.cmi: asmcomp/mach.cmi 
 asmcomp/split.cmi: asmcomp/mach.cmi 
-asmcomp/arch.cmo: utils/misc.cmi utils/config.cmi 
-asmcomp/arch.cmx: utils/misc.cmx utils/config.cmx 
+asmcomp/arch.cmo: 
+asmcomp/arch.cmx: 
 asmcomp/asmgen.cmo: bytecomp/translmod.cmi asmcomp/split.cmi \
     asmcomp/spill.cmi asmcomp/selection.cmi asmcomp/scheduling.cmi \
     asmcomp/reload.cmi asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/printmach.cmi \
 asmcomp/debuginfo.cmx: parsing/location.cmx bytecomp/lambda.cmx \
     asmcomp/debuginfo.cmi 
 asmcomp/emit.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
-    asmcomp/mach.cmi parsing/location.cmi asmcomp/linearize.cmi \
-    asmcomp/emitaux.cmi asmcomp/debuginfo.cmi utils/config.cmi \
-    asmcomp/compilenv.cmi asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo \
-    asmcomp/emit.cmi 
+    asmcomp/mach.cmi asmcomp/linearize.cmi asmcomp/emitaux.cmi \
+    asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \
+    asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emit.cmi 
 asmcomp/emit.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
-    asmcomp/mach.cmx parsing/location.cmx asmcomp/linearize.cmx \
-    asmcomp/emitaux.cmx asmcomp/debuginfo.cmx utils/config.cmx \
-    asmcomp/compilenv.cmx asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx \
-    asmcomp/emit.cmi 
+    asmcomp/mach.cmx asmcomp/linearize.cmx asmcomp/emitaux.cmx \
+    asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \
+    asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emit.cmi 
 asmcomp/emitaux.cmo: asmcomp/reg.cmi asmcomp/linearize.cmi \
     asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \
     asmcomp/emitaux.cmi 
 asmcomp/reg.cmo: asmcomp/cmm.cmi asmcomp/reg.cmi 
 asmcomp/reg.cmx: asmcomp/cmm.cmx asmcomp/reg.cmi 
 asmcomp/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
-    asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/reload.cmi 
+    asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/reload.cmi 
 asmcomp/reload.cmx: asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \
-    asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/reload.cmi 
+    asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/reload.cmi 
 asmcomp/reloadgen.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \
     asmcomp/reloadgen.cmi 
 asmcomp/reloadgen.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
     asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/selectgen.cmi 
 asmcomp/selection.cmo: asmcomp/selectgen.cmi asmcomp/reg.cmi asmcomp/proc.cmi \
     utils/misc.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \
-    asmcomp/arch.cmo asmcomp/selection.cmi 
+    utils/clflags.cmi asmcomp/arch.cmo asmcomp/selection.cmi 
 asmcomp/selection.cmx: asmcomp/selectgen.cmx asmcomp/reg.cmx asmcomp/proc.cmx \
     utils/misc.cmx asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \
-    asmcomp/arch.cmx asmcomp/selection.cmi 
+    utils/clflags.cmx asmcomp/arch.cmx asmcomp/selection.cmi 
 asmcomp/spill.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
     asmcomp/mach.cmi asmcomp/spill.cmi 
 asmcomp/spill.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
     typing/printtyp.cmi bytecomp/printlambda.cmi bytecomp/printinstr.cmi \
     parsing/printast.cmi driver/pparse.cmi parsing/parse.cmi utils/misc.cmi \
     parsing/location.cmi typing/ident.cmi typing/env.cmi \
-    bytecomp/emitcode.cmi utils/config.cmi utils/clflags.cmi utils/ccomp.cmi \
-    bytecomp/bytegen.cmi driver/compile.cmi 
+    bytecomp/emitcode.cmi driver/dump_lambda.cmo utils/config.cmi \
+    utils/clflags.cmi utils/ccomp.cmi bytecomp/bytegen.cmi driver/compile.cmi 
 driver/compile.cmx: utils/warnings.cmx typing/unused_var.cmx \
     typing/typemod.cmx typing/typedtree.cmx bytecomp/translmod.cmx \
     typing/stypes.cmx typing/spot.cmx bytecomp/simplif.cmx \
     typing/printtyp.cmx bytecomp/printlambda.cmx bytecomp/printinstr.cmx \
     parsing/printast.cmx driver/pparse.cmx parsing/parse.cmx utils/misc.cmx \
     parsing/location.cmx typing/ident.cmx typing/env.cmx \
-    bytecomp/emitcode.cmx utils/config.cmx utils/clflags.cmx utils/ccomp.cmx \
-    bytecomp/bytegen.cmx driver/compile.cmi 
+    bytecomp/emitcode.cmx driver/dump_lambda.cmx utils/config.cmx \
+    utils/clflags.cmx utils/ccomp.cmx bytecomp/bytegen.cmx driver/compile.cmi 
+driver/dump_lambda.cmo: bytecomp/lambda.cmi typing/env.cmi 
+driver/dump_lambda.cmx: bytecomp/lambda.cmx typing/env.cmx 
 driver/errors.cmo: utils/warnings.cmi typing/typetexp.cmi typing/typemod.cmi \
     typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
     bytecomp/translmod.cmi bytecomp/translcore.cmi bytecomp/translclass.cmi \
-.*\.(o|cmo|cmi|cmx|cma|cmx|cmxa|cmxs|a|so|output|3o|rej|orig|spot|spit|annot|bak)$
+.*\.(o|cmo|cmi|cmx|cma|cmx|cmxa|cmxs|a|so|output|3o|rej|orig|spot|spit|annot|bak|omc)$
 .*~$
 
 ^ocamlspot/ocamlspot$
 ^config/auto-aux/m\.h$
 ^config/auto-aux/s\.h$
 ^config/auto-aux/tst$
+
+\.omakedb$
+\.omakedb\.lock$

File 0INSTALL-home

-#!/bin/sh
-
-tar zxvf ../ocamlspot.tgz
-/bin/rm -rf boot 0MAKEDIFF* 0UPDATE*
-
-
-# # run this script placing itself and ocamlspot.tgz in a newly created directory
-# cvs -d :pserver:anoncvs@camlcvs.inria.fr:/caml co -r ocaml3110 ocaml 
-# mv ocaml/* ocaml/.[A-z]* .
-# rmdir ocaml
-
-tar zxvf ../ocaml-3.11.0.tar.gz
-mv ocaml-3.11.0/* ocaml-3.11.0/.[A-z]* .
-
-patch -p1 < ocamlspot.diff 
-
-./configure
-make core coreboot
-make world
-cp boot/myocamlbuild boot/myocamlbuild.boot
-make opt opt.opt

File 0INSTALL-home-old

+#!/bin/sh
+
+tar zxvf ../ocamlspot.tgz
+/bin/rm -rf boot 0MAKEDIFF* 0UPDATE*
+
+
+# # run this script placing itself and ocamlspot.tgz in a newly created directory
+# cvs -d :pserver:anoncvs@camlcvs.inria.fr:/caml co -r ocaml3110 ocaml 
+# mv ocaml/* ocaml/.[A-z]* .
+# rmdir ocaml
+
+tar zxvf ../ocaml-3.11.0.tar.gz
+mv ocaml-3.11.0/* ocaml-3.11.0/.[A-z]* .
+
+patch -p1 < ocamlspot.diff 
+
+./configure
+make core coreboot
+make world
+cp boot/myocamlbuild boot/myocamlbuild.boot
+make opt opt.opt
+#!/bin/sh
+
+./configure --prefix $PREFIX
+make clean core coreboot world opt opt.opt install
+cp ocamlspot/ocamlspot.el $MY_ELISP
 tools/makespotcrc: tools/makespotcrc.ml boot/ocamlc
 	$(CAMLC) -o tools/makespotcrc tools/makespotcrc.ml
 
-typing/spotcrc.ml: typing/spot.cmi tools/makespotcrc
-	tools/makespotcrc > typing/spotcrc.ml
+typing/spotcrc.ml: typing/spot.cmi tools/makespotcrc boot/ocamlrun
+	boot/ocamlrun tools/makespotcrc > typing/spotcrc.ml
 
 typing/spot.cmo: typing/spotcrc.cmo
 
 
 partialclean::
 	rm -f typing/spotcrc.ml
+	rm -f tools/makespotcrc
 
 # The bytecode compiler compiled with the native-code compiler
 

File boot/ocamlc

Binary file modified.

File boot/ocamldep

Binary file modified.

File boot/ocamllex

Binary file modified.

File build/partial-install.sh

   mkdir -p $CAMLP4DIR/$dir
   installdir     \
     $dir/*.cm*   \
+    $dir/*.sp?t   \
     $dir/*.$O    \
     $CAMLP4DIR/$dir
 done

File ocamlspot/.depend

     command.cmx ../typing/btype.cmx ../typing/annot.cmi 
 treeset.cmo: xset.cmo treeset.cmi 
 treeset.cmx: xset.cmx treeset.cmi 
+tst.cmo: 
+tst.cmx: 
 utils.cmo: 
 utils.cmx: 
 xset.cmo: 

File ocamlspot/Makefile

 
 .PHONY: clean install installopt beforedepend depend test
 
+# elisp
+
+EMACS=emacs
+
+ELISPS=ocamlspot.el
+
+COMPILECMD=(progn \
+		(setq load-path (cons "." load-path)) \
+		(byte-compile-file "ocamlspot.el"))
+
+install-elisp:
+	@if test "$(EMACSDIR)" = ""; then \
+          set xxx `($(EMACS) --batch --eval "(mapcar 'print load-path)") \
+                   2>/dev/null | \
+                   sed -n -e '/\/site-lisp/s/"//gp'`; \
+          if test "$$2" = ""; then \
+            echo "Cannot determine Emacs site-lisp directory"; \
+            exit 2; \
+          else \
+            $(MAKE) EMACSDIR="$$2" simple-install; \
+	  fi; \
+        else \
+          $(MAKE) simple-install; \
+        fi
+
+# install the .el files, but do not compile them.
+install-el:
+	$(MAKE) NOCOMPILE=true install
+
+simple-install:
+	@echo "Installing in $(EMACSDIR)..."
+	if test -d $(EMACSDIR); then : ; else mkdir -p $(EMACSDIR); fi
+	cp $(ELISPS) $(EMACSDIR)
+	if [ -z "$(NOCOMPILE)" ]; then \
+	  cd $(EMACSDIR); $(EMACS) --batch --eval '$(COMPILECMD)'; \
+	fi
+
 install installopt::
 	cp ocamlspot $(BINDIR)/ocamlspot$(EXE)
 	if test -f ocamlspot.opt; \
 	  then cp ocamlspot.opt $(BINDIR)/ocamlspot.opt$(EXE); else :; fi
+	# The following is optional
+	# $(MAKE) install-emacs-lisp
 
 test: ocamlspot ocamlspot.cmo
 	tests/auto-test.pl ocamlspot.ml treeset.ml xset.ml 

File ocamlspot/bugreport/ruslan.txt

+1. There is a bug in the emacs configuration, one of the lines should read
+something like:
+
+ ;; load path
+ (setq load-path (cons "/usr/local/lib/ocaml/ocamlspot/" load-path))
+
+2. The folder ocamlspotter-1.05/ocamlspot is required when compiling and
+should be copied to the ocaml-3.11.1 root folder. Is this what you mean when you say
+
+  - check the directory ocamlspot exists
+
+in the INSTALL-... file?
+
+3. After compiling, the folder ocaml-3.11.1/ocamlspot should be automatically copied to
+whatever place ocaml was installed.
+
+I hope this comments are useful for your next release.
+

File ocamlspot/ocamlspot.el

 ; Write the following to your .emacs
 ;
 ; ; load-path
-; (setq load-path (cons "YOUR-OCAML-SOURCE/ocamlspot/") load-path))
+; (setq load-path (cons "WHERE-YOU-HAVE-INSTALLED-THE-ELISP" load-path))
 ;
 ; ; set the path of the ocamlspot binary
-; (setq ocamlspot-path "YOUR-OCAML-SOURCE/ocamlspot/ocamlspot")
+; (setq ocamlspot-path "WHERE-YOU-HAVE-INSTALLED-THE-BINARIES/ocamlspot")
 ;
 ; ; autoload
 ; (autoload 'ocamlspot-query "ocamlspot" "OCamlSpot")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defun ocamlspot-warning ()
+  (if (re-search-forward "^\\(Warning: .*\\)$" nil t)
+      (buffer-substring-no-properties (match-beginning 1) (match-end 1))
+    nil))
+
+(defun ocamlspot-warnings-rev (lst)
+  (let ((warning (ocamlspot-warning)))
+    (if warning (ocamlspot-warnings-rev (concat lst warning "\n"))
+      lst)))
+
+(defun ocamlspot-warnings ()
+  (goto-char (point-min))
+  (ocamlspot-warnings-rev ""))
 
 ; launch ocamlspot 
 ; result is stored in the buffer "ocamlspot-buffer"
 ; the current buffer is stored in source_buffer
 (defun ocamlspot-gen-query (extra_args)
   (interactive)
-  (ocamlspot-delete-overlays-now)
-  ;; arguments
-  (let ((file-name (buffer-file-name))
-        (arg
-         (format "%s:l%dc%d"
-                 (buffer-file-name)
-                 (ocamlspot-lines-of-point)
-                 (ocamlspot-bytes-of-line-to-point))
-         ))
-    ;; ocamlspot buffer
-    (setq source-buffer (current-buffer))
-    (save-current-buffer
-      (set-buffer (get-buffer-create ocamlspot-buffer))
-      (erase-buffer)
-      (let* ((debug
-	      ; (if ocamlspot-debug '("--debug") nil))
-              (if ocamlspot-debug '("-debug") nil))
-	     (command 
-	      (append '(call-process ocamlspot-path nil ocamlspot-buffer nil)
-                      ; '("--version") ; it's new
-		      debug
-		      extra_args
-		      '(arg))))
-        ;; chdir is required
-        (cd (file-name-directory file-name))
-	(eval command))
-      ;; search the found tree element
-      (goto-char (point-min))
-      (if (re-search-forward "^Tree: \\(l[\-0-9]+c[\-0-9]+b[\-0-9]+:l[\-0-9]+c[\-0-9]+b[\-0-9]+\\)$" 
-			     nil t)
-          (let ((pos (buffer-substring (match-beginning 1) (match-end 1))))
-            ;; display the result
-            (ocamlspot-display-overlay source-buffer pos ocamlspot-tree-overlay)
-            t)
-        (progn 
-          (if (re-search-forward "^\\(Error: .*\\)" nil t)
-              (message (buffer-substring (match-beginning 1) (match-end 1)))
-            ;; display debug info
-            (message "ERROR: no tree node found there"))
-          nil)))))
+  (save-excursion
+    (ocamlspot-delete-overlays-now)
+    ;; arguments
+    (let ((file-name (buffer-file-name))
+          (arg
+           (format "%s:l%dc%d"
+                   (buffer-file-name)
+                   (ocamlspot-lines-of-point)
+                   (ocamlspot-bytes-of-line-to-point))
+           ))
+      ;; ocamlspot buffer
+      (setq source-buffer (current-buffer))
+      (save-current-buffer
+        (set-buffer (get-buffer-create ocamlspot-buffer))
+        (erase-buffer)
+        (let* ((debug
+  	      ; (if ocamlspot-debug '("--debug") nil))
+                (if ocamlspot-debug '("-debug") nil))
+  	     (command 
+  	      (append '(call-process ocamlspot-path nil ocamlspot-buffer nil)
+                        ; '("--version") ; it's new
+  		      debug
+  		      extra_args
+  		      '(arg))))
+          ;; chdir is required
+          (cd (file-name-directory file-name))
+  	(eval command))
+        ;; search the found tree element
+        (goto-char (point-min))
+        (if (re-search-forward "^Tree: \\(l[\-0-9]+c[\-0-9]+b[\-0-9]+:l[\-0-9]+c[\-0-9]+b[\-0-9]+\\)$" 
+  			     nil t)
+            (let ((pos (buffer-substring (match-beginning 1) (match-end 1))))
+              ;; display the result
+              (save-current-buffer
+                (ocamlspot-display-overlay source-buffer pos ocamlspot-tree-overlay))
+              (message (ocamlspot-warnings))
+              t)
+          (progn 
+            (if (re-search-forward "^\\(Error: .*\\)" nil t)
+                (message (buffer-substring (match-beginning 1) (match-end 1)))
+              ;; display debug info
+              (message "ERROR: no tree node found there"))
+            nil))))))
 
 (defun ocamlspot-jump-to-spot (filename position)
   (if (string-match "\.cm[ioxa]$" filename)
 
 (defun ocamlspot-query ()
   (interactive)
+  (let ((sel-window (selected-window)))
   (save-selected-window
     (if (ocamlspot-gen-query nil)
-        (save-excursion
+        (progn ;save-excursion
           ;; search the result
           (progn 
             (set-buffer (get-buffer-create ocamlspot-buffer))
         )
     (ocamlspot-delete-overlays)) ; CR jfuruse: it depends on one's taste
   ; I dunno why but we need the following line to list-buffers work nicely
-  (select-window (selected-window)))
+  (select-window sel-window)))
 
-(defun ocamlspot-type ()
+(defun ocamlspot-type (&optional to-kill)
   (interactive)
   (if (ocamlspot-gen-query '("-n"))
       (save-current-buffer 
 	(goto-char (point-min))
 	(if (re-search-forward "^Type: \\(.*\\(\n +.*\\)*\\)" nil t)
 	    (let ((type (buffer-substring (match-beginning 1) (match-end 1))))
+              (if to-kill (kill-new type))
 	      (message type))
 	  (message "no type found here"))))
   (ocamlspot-delete-overlays))
 
+(defun ocamlspot-type-and-copy ()
+  (interactive)
+  (ocamlspot-type t))
+
 ; CR can be shared with ocamlspot-type
 (defun ocamlspot-use ()
   (interactive)

File ocamlspot/ocamlspot.ml

 module Path0 = Path
 
 module Ident = struct
-  (* extend the original Ident module *)
+  (* extend the original module *)
   include Ident
 
-  let name (* id => *) id (* <= id *) =
-    let binding_time = Ident.binding_time id in
-    if binding_time = -1 then
-      Printf.sprintf "%s__G" (Ident.name id)
-    else
-      Printf.sprintf "%s__%d" (Ident.name id) (Ident.binding_time id (* ? id *))
+  module XIdent : sig
+    val name : t -> string
+      (* with pos *)
+  
+    val unsafe_create_with_stamp : ?flags: int -> string -> int -> t
+      (* create an ident with given flags and stamp *)
+  
+  end = struct
+    (* extend the original Ident module *)
+  
+    let name (* id => *) id (* <= id *) =
+      let binding_time = binding_time id (* ? id *) in
+      if binding_time = -1 then
+        Printf.sprintf "%s__G" (name id)
+      else
+        Printf.sprintf "%s__%d" (name id) binding_time
+  
+    module Ident_internal : sig
+      type t
+      val unsafe_create_with_stamp : ?flags: int -> string -> int -> Ident.t
+    end= struct
+      (* Stamp is untouchable outside of ident.ml. A dirty workaround *)
+      type t = { stamp: int; name: string; mutable flags: int }
+      let to_ident (id : t) = (Obj.magic id : Ident.t)
+  
+      (* It is dangerous operation! *)        
+      let unsafe_create_with_stamp ?(flags=0) name stamp =
+        to_ident { stamp = stamp; name = name; flags = flags }
+    end
+  
+    let unsafe_create_with_stamp = Ident_internal.unsafe_create_with_stamp
+  end
+  include XIdent
+end
 
-  module Ident_internal : sig
-    type t
-    val unsafe_create_with_stamp : ?flags: int -> string -> int -> Ident.t
-  end= struct
-    (* Stamp is untouchable outside of ident.ml. A dirty workaround *)
-    type t = { stamp: int; name: string; mutable flags: int }
-    let to_ident (id : t) = (Obj.magic id : Ident.t)
+module Longident = struct
+  (* extend the original module *)
+  include Longident
 
-    (* It is dangerous operation! *)        
-    let unsafe_create_with_stamp ?(flags=0) name stamp =
-      to_ident { stamp = stamp; name = name; flags = flags }
-  end
+  include (struct
+    let rec to_string = function
+      | Lident s -> s
+      | Ldot (t, s) -> to_string t ^ "." ^ s
+      | Lapply (t1, t2) -> Printf.sprintf "%s(%s)" (to_string t1) (to_string t2)
+  end : sig
+    val to_string : t -> string
+  end)
+end
 
-  let unsafe_create_with_stamp = Ident_internal.unsafe_create_with_stamp
-end
-    
 module Path = struct
-  (* extend the original Ident module *)
+  (* extend the original module *)
   include Path
 
-  let rec name = function
-    | Pident id -> Ident.name id
-    | Pdot(p, s, -1) -> name p ^ "." ^ s ^ "__G"
-    | Pdot(p, s, pos) -> name p ^ "." ^ s ^ "__" ^ string_of_int pos
-    | Papply(p1, p2) -> name p1 ^ "(" ^ name p2 ^ ")"
-
-  let rec local = function
-    | Pident id -> not (Ident.global id)
-    | Pdot (p, _, _) -> local p
-    | Papply(p1, _p2) -> local p1 (* ? *) 
+  module XPath : sig
+    val name : t -> string
+    val local : t -> bool 
+      (** return true if "local" *)
+  end = struct
+    let rec name = function
+      | Pident id -> Ident.name id
+      | Pdot(p, s, -1) -> name p ^ "." ^ s ^ "__G"
+      | Pdot(p, s, pos) -> name p ^ "." ^ s ^ "__" ^ string_of_int pos
+      | Papply(p1, p2) -> name p1 ^ "(" ^ name p2 ^ ")"
+  
+    let rec local = function
+      | Pident id -> not (Ident.global id)
+      | Pdot (p, _, _) -> local p
+      | Papply(p1, _p2) -> local p1 (* ? *) 
+  end
+  include XPath
 end
 
 module With_pos = struct
      This module implements a workaround.
   *)
 
-  module Fix = struct
+  module Fix : sig
+
+    val type_expr : Types.type_expr -> Types.type_expr
+      (** put pos and stamps to type_expr *)
+
+  end = struct
     let ident id = Ident.create_persistent (Ident.name id)
   
     let rec path = function
       f
   end
 
-  module Parse = struct
+  module Parse : sig
+
+    val path : string -> Path.t
+
+  end = struct
     let name s =
       try
         let pos = String.rindex s '_' in
 module Printtyp = struct
   include Printtyp
 
-  let make f ?(with_pos=false) ty =
-    let ty = if with_pos then With_pos.Fix.type_expr ty else ty in
-    f ty
+  module XPrinttyp : sig
 
-  let type_sch ?with_pos ppf = make (type_sch ppf) ?with_pos
+    val type_sch 
+      : ?with_pos: bool -> Format.formatter -> Types.type_expr -> unit
+      (** type scheme printer with position *)
+
+  end = struct
+    let make f ?(with_pos=false) ty =
+      let ty = if with_pos then With_pos.Fix.type_expr ty else ty in
+      f ty
+
+    let type_sch ?with_pos ppf = make (type_sch ppf) ?with_pos
+  end
+  include XPrinttyp
 end
 
-module Position = struct
+module Position : sig
+
+  type t = { line_column : (int * int) option; bytes : int option }
+
+  val none : t
+
+  val compare : t -> t -> int
+
+  val next : t -> t
+
+  val of_lexing_position : Lexing.position -> t
+
+  exception Parse_failure of string
+  val parse : string -> t
+
+  val to_string : t -> string
+
+  val complete : string -> t -> t
+
+end = struct
   open Lexing
 
   type t = { line_column : (int * int) option; bytes : int option }
     | { line_column = Some (l,c); bytes = None } ->
         { line_column = Some (l, c+1); bytes = None }
     | _ -> assert false
+
+  (* it drops one byte at the end, but who cares? *)        
+  let complete mlpath t = match t with
+    | { line_column = Some _; bytes = Some _ } -> 
+        t (* already complete *)
+    | { line_column = Some (line, column); bytes = None } ->
+        let ic = open_in_bin mlpath in
+        let rec iter cur_line pos =
+          ignore (input_line ic);
+          let cur_line = cur_line + 1 in
+          if cur_line = line then begin
+            close_in ic;
+            { line_column = Some (line, column); bytes = Some (pos + column) }
+          end else iter cur_line (pos_in ic)
+        in
+        iter 0 0
+
+    | { line_column = None; bytes = Some bytes } -> 
+        let ic = open_in_bin mlpath in
+        let rec iter lines remain =
+          let pos = pos_in ic in
+          let new_remain = bytes - pos in
+          if new_remain < 0 then begin (* run over *)
+            close_in ic;
+            { line_column = Some (lines, remain); bytes = Some bytes }
+          end else begin
+            ignore (input_line ic);
+            iter (lines+1) new_remain
+          end
+        in
+        iter 0 bytes
+          
+    | { line_column = None; bytes = None } -> assert false
+
 end
 
-module Location = struct
+module Location : sig
+    
+  type t = { 
+    start : Position.t;
+    end_ : Position.t
+  }
+
+  val compare : t -> t 
+    -> [> `Included | `Includes | `Left | `Overwrap | `Right | `Same ]
+    
+  val to_string : t -> string
+  val of_parsing : Location.t -> t
+
+  val split : t -> by:t -> (t * t) option
+
+  val point_by_byte : int -> t
+  val point : Position.t -> t
+
+  val length_in_bytes : t -> int
+    (* works only if bytes are available *)
+
+  val complete : string -> t -> t
+  val substring : string -> t -> t * string
+
+end = struct
   type t = { 
     start : Position.t;
     end_ : Position.t
 
   let none = { start = Position.none;
 	       end_ = Position.none }
+
+  let length_in_bytes t =
+    let bytes = function
+      | { Position.bytes = Some bytes } -> bytes
+      | _ -> raise Not_found
+    in
+    bytes t.end_ - bytes t.start
+
+  let complete mlpath t =
+    { start = Position.complete mlpath t.start;
+      end_ = Position.complete mlpath t.end_ }
+
+  let substring mlpath t =
+    let t = complete mlpath t in
+    let ic = open_in_bin mlpath in
+    match t.start.Position.bytes, t.end_.Position.bytes with
+    | Some start, Some end_ ->
+	seek_in ic start;
+	let s = String.create (end_ - start) in
+	really_input ic s 0 (end_ - start);
+	t, s
+    | _ -> assert false
+    
 end
 
 module Types = struct
   include Types
 
-  let id_of_signature_item = function
+  let id_of_signature_item : signature_item -> Ident.t = function
     | Tsig_value (id, _) -> id
     | Tsig_type (id, _, _) -> id
     | Tsig_exception (id, _) -> id
 module Kind = struct
   include Kind
 
-  (* debug purpose. 'k' is to make their type clearer *)
+  (* debug purpose. *)
   let to_string = function
-    | Value -> "kValue"
-    | Type -> "kType"
-    | Exception -> "kException" 
-    | Module -> "kModule"
-    | Module_type -> "kModule_type"
-    | Class -> "kClass"
-    | Class_type -> "kClass_type"
+    | Value -> "Value"
+    | Type -> "Type"
+    | Exception -> "Exception" 
+    | Module -> "Module"
+    | Module_type -> "Module_type"
+    | Class -> "Class"
+    | Class_type -> "Class_type"
 
   (* for messages *)
   let name = function
 
   (* used for query interface *)        
   let from_string = function
-    | "v" -> Value
-    | "t" -> Type
-    | "e" -> Exception
-    | "m" -> Module
-    | "mt" -> Module_type
-    | "c" -> Class
-    | "ct" -> Class_type
+    | "v" | "value" -> Value
+    | "t" | "type" -> Type
+    | "e" | "exception" -> Exception
+    | "m" | "module" -> Module
+    | "mt" | "module_type" -> Module_type
+    | "c" | "class" -> Class
+    | "ct" | "class_type" -> Class_type
     | _ -> raise Not_found
 end
 
     match p with
     | Path.Papply _ -> assert false
     | Path.Pident id -> 
+        (* predef check first (testing) *)
+	begin try snd (Env.find Env.predef id) with Not_found ->
+        
         if Ident.global id then
           lazy begin try
 	      let path, str = 
 	      (String.concat "; " 
 		  (List.map Ident.name (Env.domain env)));
             try !!(snd (Env.find env id)) with Not_found -> 
+(*
 	      (* it may be a predefed thing *)
 	      try !!(snd (Env.find Env.predef id)) with Not_found ->
+*)
                 Error (Failure (Printf.sprintf "%s not found in { %s }" 
 				   (Ident.name id)
 				   (String.concat "; " 
 				       (List.map Ident.name (Env.domain env)))))
           end
         end
+        end
     | Path.Pdot (p, name, pos) ->
         lazy begin
 	  match !!(find_path (* ? find_path *) env (Kind.Module, p)) with
       | _ -> str) str flat
 end
 
+module Config = struct
+
+  let print_version () =
+    Format.eprintf "ocamlspot version: %s-%s@." Sys.ocaml_version version
+      
+  let spec = ref None
+  let (* dump_file_ref => *) dump_file (* <= dump_file_ref *) = ref false
+  let dump_lannots = ref false
+  let dump_tree = ref false
+  let dump_top = ref false
+  let dump_flat = ref false
+  let eager_dump = ref false
+  let no_definition_analysis = ref false
+  let strict_time_stamp = ref false
+  let print_file_info = ref false
+
+  let _ = 
+    Arg.parse 
+      [ "--version", Arg.Unit print_version, " print version information";
+        "-version", Arg.Unit print_version, " (deprecated)";
+        "--debug", Arg.Set Debug.on, " print debug information";
+        "-debug", Arg.Set Debug.on, " (deprecated)";
+        "--dump-file", Arg.Set dump_file, " dump spot file"; 
+        "--dump-lannots", Arg.Set dump_lannots, " dump loc-annots";
+        "--dump-tree", Arg.Set dump_tree, " dump annot tree";
+        "--dump-top", Arg.Set dump_top, " dump top"; 
+        "--dump-flat", Arg.Set dump_flat, " dump flat"; 
+        "--eager-dump", Arg.Set eager_dump, " eager evaluation at dump";
+        "-n", Arg.Set no_definition_analysis, " no definition analysis";
+        "--strict-time-stamp", Arg.Set strict_time_stamp, " error at newer source files than their spots";
+        "-i", Arg.Set print_file_info, " print file information";
+      ]
+      (fun s -> 
+	match !spec with
+	| Some _ -> failwith "you can specify only one search"
+	| None -> spec := Some s)
+      (Printf.sprintf 
+	  "ocamlspot search\nversion %s (spot file version %d.%d:%s)\n\
+\tsearch ::= file | file:pos | file:kind:path\n\
+\tpos ::= l<line>c<column> | b<bytes>\n\
+\tkind ::= v|t|e|m|mt|c|ct"
+	  version (* ? version *)
+	  version_major
+	  version_minor
+          (Digest.to_hex Spotcrc.crc))
+
+  let (* dump_file => *) dump_file (* <= dump_file *) = !dump_file (* ? dump_file_ref *)
+  let dump_lannots = !dump_lannots
+  let dump_tree = !dump_tree
+  let dump_top  = !dump_top 
+  let dump_flat = !dump_flat
+  let eager_dump = !eager_dump
+  let no_definition_analysis = !no_definition_analysis
+  let strict_time_stamp = !strict_time_stamp
+  let print_file_info = !print_file_info
+      
+  let dump_any = 
+    dump_file (* ? dump_file *) || dump_lannots || dump_tree || dump_top || dump_flat
+
+  module Spec = struct
+    type t = 
+	| Pos of Position.t
+	| Kind of Kind.t * Path.t
+	| Dump
+
+    let parse s =
+      try
+	let at = String.rindex s ':' in
+	try
+	  let at2 = String.rindex_from s (at - 1) ':' in
+	  String.sub s 0 at2,
+	  Kind 
+	    (Kind.from_string (String.sub s (at2+1) (at-at2-1)),
+	   let s = String.sub s (at+1) (String.length s - at - 1) in 
+	   try With_pos.Parse.path s with
+	   | _ -> failwith ("illegal path: " ^ s))
+	with
+	| Invalid_argument _ | Not_found -> 
+	    String.sub s 0 at,
+	    Pos 
+	      (Position.parse 
+		  (String.sub s (at+1) (String.length s - at - 1)))
+      with
+      | Failure s -> failwith s
+      | Position.Parse_failure s -> failwith ("illegal file:pos: " ^ s)
+      | Not_found -> s, Dump
+
+    let to_string = function
+      | Pos pos -> ":" ^ Position.to_string pos
+      | Kind (k, path) -> 
+	  Printf.sprintf ":%s:%s"
+	    (Kind.to_string k)
+	    (Path.name path)
+      | Dump -> ""
+  end
+
+  let mlpath, spec =
+    match !spec with
+    | None -> failwith "you must specify a search"
+    | Some s when dump_any -> s, Spec.Dump
+    | Some s -> Spec.parse s
+end
+    
 module File = struct
   include File
 
 		| "" -> ()
 		| source -> 
 		    if not (check_time_stamp ~spot:path source) then 
-		      raise (Old_spot (path, source))
+                      if Config.strict_time_stamp then 
+		        raise (Old_spot (path, source))
+                      else
+                        Format.eprintf "Warning: source %s is newer than the spot@." source
 		end;
 		Hashtbl.replace cache path file;
 		file
 
   let find_path_in_flat file path : PIdent.t * result =
     let env = 
-	let env = invalid_env file in
-	let str = Eval.structure_flat env file.flat in
-	Binding.set env.Env.binding str; (* dirty hack *)
+      let env = invalid_env file in
+      let str = Eval.structure_flat env file.flat in
+      Binding.set env.Env.binding str; (* dirty hack *)
       env
     in
     let find_loc pid =
           (* CR jfuruse: loading twice... *)
           Debug.format "Finding %a@." PIdent.format pid;
           let file = 
-	    Load.load ~load_paths: [] (spot_of_file pid.PIdent.path) 
+	    Load.load ~load_paths:[] (spot_of_file pid.PIdent.path) 
           in
           match pid.PIdent.ident with
 	  | None -> File_itself (* the whole file *)
   let dump_elems elems = List.iter dump_elem elems
 end
 
-module Config = struct
-
-  let print_version () =
-    Format.eprintf "ocamlspot version: %s-%s@." Sys.ocaml_version version
-      
-  let spec = ref None
-  let (* dump_file_ref => *) dump_file (* <= dump_file_ref *) = ref false
-  let dump_lannots = ref false
-  let dump_tree = ref false
-  let dump_top = ref false
-  let dump_flat = ref false
-  let eager_dump = ref false
-  let no_definition_analysis = ref false
-
-  let _ = 
-    Arg.parse 
-      [ "--version", Arg.Unit print_version, " print version information";
-        "-version", Arg.Unit print_version, " (deprecated)";
-        "--debug", Arg.Set Debug.on, " print debug information";
-        "-debug", Arg.Set Debug.on, " (deprecated)";
-        "--dump-file", Arg.Set dump_file, " dump spot file"; 
-        "--dump-lannots", Arg.Set dump_lannots, " dump loc-annots";
-        "--dump-tree", Arg.Set dump_tree, " dump annot tree";
-        "--dump-top", Arg.Set dump_top, " dump top"; 
-        "--dump-flat", Arg.Set dump_flat, " dump flat"; 
-        "--eager-dump", Arg.Set eager_dump, " eager evaluation at dump";
-        "-n", Arg.Set no_definition_analysis, " no definition analysis";
-      ]
-      (fun s -> 
-	match !spec with
-	| Some _ -> failwith "you can specify only one search"
-	| None -> spec := Some s)
-      (Printf.sprintf 
-	  "ocamlspot search\nversion %s (spot file version %d.%d:%s)\n\
-\tsearch ::= file | file:pos | file:kind:path\n\
-\tpos ::= l<line>c<column> | b<bytes>\n\
-\tkind ::= v|t|e|m|mt|c|ct"
-	  version (* ? version *)
-	  version_major
-	  version_minor
-          (Digest.to_hex Spotcrc.crc))
-
-  let (* dump_file => *) dump_file (* <= dump_file *) = !dump_file (* ? dump_file_ref *)
-  let dump_lannots = !dump_lannots
-  let dump_tree = !dump_tree
-  let dump_top  = !dump_top 
-  let dump_flat = !dump_flat
-  let eager_dump = !eager_dump
-  let no_definition_analysis = !no_definition_analysis
-
-  let dump_any = 
-    dump_file (* ? dump_file *) || dump_lannots || dump_tree || dump_top || dump_flat
-
-  module Spec = struct
-    type t = 
-	| Pos of Position.t
-	| Kind of Kind.t * Path.t
-	| Dump
-
-    let parse s =
-      try
-	let at = String.rindex s ':' in
-	try
-	  let at2 = String.rindex_from s (at - 1) ':' in
-	  String.sub s 0 at2,
-	  Kind 
-	    (Kind.from_string (String.sub s (at2+1) (at-at2-1)),
-	   let s = String.sub s (at+1) (String.length s - at - 1) in 
-	   try With_pos.Parse.path s with
-	   | _ -> failwith ("illegal path: " ^ s))
-	with
-	| Invalid_argument _ | Not_found -> 
-	    String.sub s 0 at,
-	    Pos 
-	      (Position.parse 
-		  (String.sub s (at+1) (String.length s - at - 1)))
-      with
-      | Failure s -> failwith s
-      | Position.Parse_failure s -> failwith ("illegal file:pos: " ^ s)
-      | Not_found -> s, Dump
-
-    let to_string = function
-      | Pos pos -> ":" ^ Position.to_string pos
-      | Kind (k, path) -> 
-	  Printf.sprintf ":%s:%s"
-	    (Kind.to_string k)
-	    (Path.name path)
-      | Dump -> ""
-  end
-
-  let mlpath, spec =
-    match !spec with
-    | None -> failwith "you must specify a search"
-    | Some s when dump_any -> s, Spec.Dump
-    | Some s -> Spec.parse s
-end
-    
 module Dump = struct
   (* mainly debugging purpose *)
   let file f = File.dump f
 
   let f () = 
 
-    Format.printf "ocamlspot %s:%s@." 
+    Debug.format "ocamlspot %s:%s@." 
       Config.mlpath (Config.Spec.to_string Config.spec);
-    Format.printf "cwd: %s@." (Sys.getcwd ());
+    Debug.format "cwd: %s@." (Sys.getcwd ());
 
     let path = File.spot_of_file Config.mlpath in
     let file = File.Load.load ~load_paths: ["."] path in
     if Config.dump_top then Dump.top file;
     if Config.dump_flat then Dump.flat file;
 
-    Format.printf "Compile: %s@."
-      (String.concat " " 
-          (List.map Command.escaped_for_shell 
-              (Array.to_list file.File.argv)));
+    if Config.print_file_info then
+      Format.printf "Compile: %s@."
+        (String.concat " " 
+            (List.map Command.escaped_for_shell 
+                (Array.to_list file.File.argv)));
 
-    Format.printf "@[<v2>Included_dirs:@ %a@]@."
-      (Format.list "" Format.pp_print_string)
-      file.File.load_paths;
+    if Config.print_file_info then
+      Format.printf "@[<v2>Included_dirs:@ %a@]@."
+        (Format.list "" Format.pp_print_string)
+        file.File.load_paths;
 
     if Config.dump_any then bye 0;
 
           failwith (Printf.sprintf "nothing at %s"
 		       (Position.to_string pos))
       | (({ Located.loc = l}, _) :: _ as path) ->
+          (* Here we have location l, pos and ml file mlpath *)
+	  let get_substring () = 
+	    try
+	      let pos = Position.complete Config.mlpath pos in
+	      let l = Location.complete Config.mlpath l in
+	      let bytes = Location.length_in_bytes l in
+	      let to_cursor = 
+		Location.length_in_bytes 
+		  { l with Location.end_ = pos } 
+	      in
+	      if bytes < 256 then (* too long, too bad *)
+		let substr = snd (Location.substring Config.mlpath l) in
+		let former = String.sub substr 0 to_cursor in
+		let latter = 
+		  String.sub substr to_cursor
+		    (String.length substr - to_cursor)
+		in
+		former, latter
+	      else failwith (Printf.sprintf "Substring: too long length=%d" bytes)
+	    with
+            | Failure e -> raise (Failure e)
+	    | e -> failwith (Printf.sprintf "Substring: failed: %s" (Printexc.to_string e))
+	  in
+          (try ignore (get_substring ()) with Failure _ -> ());
+
   	  Format.printf "Tree: %s@." (Location.to_string l);
 	  let rec find_module_path = function
 	    | [] -> []
         Format.eprintf "Error: %s@." s;
         bye 1
     | File.Load.Old_spot (_spot, source) ->
-  	Format.eprintf "Error: source %s is newer than the spot" source;
+  	Format.eprintf "Error: source %s is newer than the spot@." source;
         bye 1
     | e ->
         Format.eprintf "uncaught exception: %s@." (Printexc.to_string e);
 end
 
 let _ = Main.f ()
-

File ocamlspot/tests/exception.ml

   | Target.E (* ? Target.E *) -> assert false
 
 exception X = E (* ? E *) (* bug 090818 *)
+
+module M = struct
+  (* EE => *) exception EE (* <= EE *)
+end
+
+let _ = raise M.EE (* ? EE *)
+let _ = raise (Failure "x") (* predefind *)

File ocamlspot/tst.ml

+type t = { line_column : (int * int) option;
+           bytes : int option }
+
+let complete mlpath t = match t with
+    | { line_column = Some _; bytes = Some _ } -> 
+        t (* already complete *)
+    | { line_column = Some (line, column); bytes = None } ->
+        let ic = open_in_bin mlpath in
+        let rec iter cur_line pos =
+          ignore (input_line ic);
+          let cur_line = cur_line + 1 in
+          if cur_line = line then begin
+            close_in ic;
+            { line_column = Some (line, column); bytes = Some (pos + column) }
+          end else iter cur_line (pos_in ic)
+        in
+        iter 0 0
+
+    | { line_column = None; bytes = Some bytes } -> 
+        let ic = open_in_bin mlpath in
+        let rec iter lines remain =
+          let pos = pos_in ic in
+          let new_remain = bytes - pos in
+          if new_remain < 0 then begin (* run over *)
+            close_in ic;
+            { line_column = Some (lines, remain); bytes = Some bytes }
+          end else begin
+            ignore (input_line ic);
+            iter (lines+1) new_remain
+          end
+        in
+        iter 0 bytes
+          
+    | { line_column = None; bytes = None } -> assert false
+
+let test mlpath byte =
+  let p = complete mlpath { line_column= None; bytes = Some byte } in
+  let q = complete mlpath { p with bytes = None } in
+  assert (p = q)
+;;

File typing/typemod.ml

   | Pmty_functor(param, sarg, sres) ->
       let arg = transl_modtype env sarg in
       let (id, newenv) = Env.enter_module param arg env in
-      Spot.Annot.record smty.pmty_loc (* CR jfuruse: name shoud have its position  *) (Spot.Annot.Functor_parameter id);
+      Spot.Annot.record smty.pmty_loc (* CR jfuruse: name should have its position  *) (Spot.Annot.Functor_parameter id);
       let res = transl_modtype newenv sres in
       Tmty_functor(id, arg, res)
   | Pmty_with(sbody, constraints) ->