[MLton-commit] r5237
Vesa Karvonen
vesak at mlton.org
Sat Feb 17 09:17:49 PST 2007
Added real-time approximate (doesn't use the complete file path) query of
symbol data from def-use files currently being parsed. This means that
symbol data is usually available for most operations immediately and one
doesn't need to wait for the background parsing to finish. Also added a
counter to keep track how many times a def-use file has been parsed.
----------------------------------------------------------------------
U mlton/trunk/ide/emacs/esml-du-mlton.el
----------------------------------------------------------------------
Modified: mlton/trunk/ide/emacs/esml-du-mlton.el
===================================================================
--- mlton/trunk/ide/emacs/esml-du-mlton.el 2007-02-17 17:10:51 UTC (rev 5236)
+++ mlton/trunk/ide/emacs/esml-du-mlton.el 2007-02-17 17:17:49 UTC (rev 5237)
@@ -75,7 +75,9 @@
(nth 7 (esml-du-ctx-attr ctx)))))
"% left")
"complete")
- "]"))
+ ", parsed "
+ (int-to-string (esml-du-ctx-parse-cnt ctx))
+ " times]"))
(defun esml-du-sym-at-ref (ref ctx)
(if (def-use-attr-newer?
@@ -85,7 +87,9 @@
(unless (let ((buffer (def-use-find-buffer-visiting-file
(def-use-ref-src ref))))
(and buffer (buffer-modified-p buffer)))
- (gethash ref (esml-du-ctx-ref-to-sym-table ctx)))))
+ (or (gethash ref (esml-du-ctx-ref-to-sym-table ctx))
+ (and (esml-du-try-to-read-symbol-at-ref ref ctx)
+ (gethash ref (esml-du-ctx-ref-to-sym-table ctx)))))))
(defun esml-du-sym-to-uses (sym ctx)
(if (def-use-attr-newer?
@@ -111,7 +115,7 @@
(defun esml-du-ctx (duf)
(let ((ctx (vector (def-use-make-hash-table) (def-use-make-hash-table)
- duf nil nil nil)))
+ duf nil nil nil 0)))
(when esml-du-change-poll-period
(esml-du-ctx-set-poll-timer
(run-with-timer esml-du-change-poll-period esml-du-change-poll-period
@@ -119,6 +123,7 @@
ctx))
ctx))
+(defun esml-du-ctx-parse-cnt (ctx) (aref ctx 6))
(defun esml-du-ctx-poll-timer (ctx) (aref ctx 5))
(defun esml-du-ctx-buf (ctx) (aref ctx 4))
(defun esml-du-ctx-attr (ctx) (aref ctx 3))
@@ -126,6 +131,9 @@
(defun esml-du-ctx-ref-to-sym-table (ctx) (aref ctx 1))
(defun esml-du-ctx-sym-to-uses-table (ctx) (aref ctx 0))
+(defun esml-du-ctx-inc-parse-cnt (ctx)
+ (aset ctx 6 (1+ (aref ctx 6))))
+
(defun esml-du-ctx-set-poll-timer (timer ctx) (aset ctx 5 timer))
(defun esml-du-ctx-set-buf (buf ctx) (aset ctx 4 buf))
(defun esml-du-ctx-set-attr (attr ctx) (aset ctx 3 attr))
@@ -163,6 +171,54 @@
(run-with-idle-timer 0.5 nil (function esml-du-reparse) ctx)
nil)))
+(defun esml-du-try-to-read-symbol-at-ref (ref ctx)
+ "Tries to read the symbol at the specified ref from the duf."
+ (let ((buffer (esml-du-ctx-buf ctx)))
+ (when buffer
+ (with-current-buffer buffer
+ (when (search-forward (esml-du-ref-to-appx-syntax ref) nil t)
+ (beginning-of-line)
+ (while (= ?\ (char-after))
+ (forward-line -1))
+ (let ((start (point)))
+ (esml-du-read-one-symbol ctx)
+ (setq buffer-read-only nil)
+ (delete-backward-char (- (point) start))
+ (setq buffer-read-only t)))))))
+
+(defun esml-du-ref-to-appx-syntax (ref)
+ (let ((pos (def-use-ref-pos ref)))
+ (concat
+ (file-name-nondirectory (def-use-ref-src ref)) " "
+ (int-to-string (def-use-pos-line pos)) "."
+ (int-to-string (1+ (def-use-pos-col pos))))))
+
+(defun esml-du-read-one-symbol (ctx)
+ "Reads one symbol from the current buffer starting at the current
+point."
+ (let* ((ref-to-sym (esml-du-ctx-ref-to-sym-table ctx))
+ (sym-to-uses (esml-du-ctx-sym-to-uses-table ctx))
+ (class (def-use-intern (esml-du-read "^ " " ")))
+ (name (def-use-intern (esml-du-read "^ " " ")))
+ (src (def-use-file-truename (esml-du-read "^ " " ")))
+ (line (string-to-int (esml-du-read "^." ".")))
+ (col (1- (string-to-int (esml-du-read "^\n" "\n"))))
+ (pos (def-use-pos line col))
+ (ref (def-use-ref src pos))
+ (sym (def-use-sym class name ref
+ (cdr (assoc class esml-du-classes))))
+ (uses nil))
+ (puthash ref sym ref-to-sym)
+ (while (< 0 (skip-chars-forward " "))
+ (let* ((src (def-use-file-truename (esml-du-read "^ " " ")))
+ (line (string-to-int (esml-du-read "^." ".")))
+ (col (1- (string-to-int (esml-du-read "^\n" "\n"))))
+ (pos (def-use-pos line col))
+ (ref (def-use-ref src pos)))
+ (puthash ref sym (esml-du-ctx-ref-to-sym-table ctx))
+ (push ref uses)))
+ (puthash sym uses sym-to-uses)))
+
(defun esml-du-parse (ctx)
"Parses the def-use -file. Because parsing may take a while, it is
done as a background process. This allows you to continue working
@@ -190,39 +246,20 @@
(let ((buffer (esml-du-ctx-buf ctx)))
(or (not buffer)
(with-current-buffer buffer
+ (goto-char 1)
(eobp))))))
(function
(lambda (ctx)
(with-current-buffer (esml-du-ctx-buf ctx)
(goto-char 1)
- (let* ((ref-to-sym (esml-du-ctx-ref-to-sym-table ctx))
- (sym-to-uses (esml-du-ctx-sym-to-uses-table ctx))
- (class (def-use-intern (esml-du-read "^ " " ")))
- (name (def-use-intern (esml-du-read "^ " " ")))
- (src (def-use-file-truename (esml-du-read "^ " " ")))
- (line (string-to-int (esml-du-read "^." ".")))
- (col (1- (string-to-int (esml-du-read "^\n" "\n"))))
- (pos (def-use-pos line col))
- (ref (def-use-ref src pos))
- (sym (def-use-sym class name ref
- (cdr (assoc class esml-du-classes))))
- (uses nil))
- (puthash ref sym ref-to-sym)
- (while (< 0 (skip-chars-forward " "))
- (let* ((src (def-use-file-truename (esml-du-read "^ " " ")))
- (line (string-to-int (esml-du-read "^." ".")))
- (col (1- (string-to-int (esml-du-read "^\n" "\n"))))
- (pos (def-use-pos line col))
- (ref (def-use-ref src pos)))
- (puthash ref sym (esml-du-ctx-ref-to-sym-table ctx))
- (push ref uses)))
- (puthash sym uses sym-to-uses))
+ (esml-du-read-one-symbol ctx)
(setq buffer-read-only nil)
- (delete-backward-char (- (point) 1))
+ (delete-backward-char (1- (point)))
(setq buffer-read-only t))))
(function
(lambda (ctx)
(esml-du-stop-parsing ctx)
+ (esml-du-ctx-inc-parse-cnt ctx)
(message "Finished parsing %s." (esml-du-ctx-duf ctx))))
ctx)
(message "Parsing %s in the background..." (esml-du-ctx-duf ctx)))
More information about the MLton-commit
mailing list