[MLton-commit] r5080

[Vesa K. <ve...@ml...>]

Added some caching to speed up things.

----------------------------------------------------------------------

U   mlton/trunk/ide/emacs/def-use-util.el
U   mlton/trunk/ide/emacs/esml-def-use-mlton.el

----------------------------------------------------------------------

Modified: mlton/trunk/ide/emacs/def-use-util.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-util.el	2007-01-29 16:04:56 UTC (rev 5079)
+++ mlton/trunk/ide/emacs/def-use-util.el	2007-01-29 22:09:09 UTC (rev 5080)
@@ -6,9 +6,21 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Utilities
 
+(defvar def-use-file-truename-table
+  (make-hash-table :test 'equal :weakness 'key)
+  "Weak hash table private to `def-use-file-truename'.")
+
+(defun def-use-file-truename (file)
+  "Cached version of `file-truename'."
+  (def-use-gethash-or-put file
+    (function
+     (lambda ()
+       (def-use-intern (file-truename file))))
+    def-use-intern-table))
+
 (defun def-use-buffer-true-file-name ()
   "Returns the true filename of the current buffer."
-  (file-truename (buffer-file-name)))
+  (def-use-file-truename (buffer-file-name)))
 
 (defun def-use-point-at-next-line ()
   "Returns point at the beginning of the next line."

Modified: mlton/trunk/ide/emacs/esml-def-use-mlton.el
===================================================================
--- mlton/trunk/ide/emacs/esml-def-use-mlton.el	2007-01-29 16:04:56 UTC (rev 5079)
+++ mlton/trunk/ide/emacs/esml-def-use-mlton.el	2007-01-29 22:09:09 UTC (rev 5080)
@@ -19,17 +19,16 @@
     (setq esml-def-use-mlton-resolve-src-last-src src
           esml-def-use-mlton-resolve-src-last-duf duf
           esml-def-use-mlton-resolve-src-last-result
-          (def-use-intern
-            (file-truename
-             (cond
-              ;; XXX <basis>
-              ((file-name-absolute-p src)
-               src)
-              ((equal ?< (aref src 0))
-               src)
-              (t
-               (expand-file-name
-                src (file-name-directory duf)))))))))
+          (def-use-file-truename
+            (cond
+             ;; XXX <basis>
+             ((file-name-absolute-p src)
+              src)
+             ((equal ?< (aref src 0))
+              src)
+             (t
+              (expand-file-name
+               src (file-name-directory duf))))))))
 
 (defun esml-def-use-read (taking skipping)
   (let ((start (point)))