seanmcl avatar seanmcl committed 8aeec61

compute hash code of errors in ocaml. Improves Emacs cpu usage

Comments (0)

Files changed (7)

 
 tmp_file=/tmp/all.el
 
-bin=$(dirname $(pwd)/$0)
+bin=$(dirname $0)
 home=$(dirname $bin)
 contrib_dir=$home/elisp/contrib
 jane_dir=$home/elisp/jane

elisp/omake/omake-error.el

    (:predicate Omake.Error.is)
    (:conc-name Omake.Error.)
    (:constructor nil)
-   (:constructor Omake.Error
+   (:constructor Omake.Error.make
                  (&key
+                  hash
                   id
                   relpath
                   file
                   (_ (assert (stringp text)))
                   (_ (assert (stringp full-text)))
                   (full-text-visible-p nil)
-                  )))
+                  (string nil)
+                  (full-string nil))))
+  (hash            nil :read-only t)
   (id              nil :read-only t)
   (relpath         nil :read-only t)
   (file            nil :read-only t)
   (char-end        nil :read-only t)
   (text            nil :read-only t)
   (full-text       nil :read-only t)
-  full-text-visible-p)
+  full-text-visible-p
+  string
+  full-string)
+;; (setq e (Omake.Error.make :id "/Users/seanmcl/save/projects/omake-mode-test/ocaml1" :relpath "lib" :file "bug.ml" :line 9 :char-beg 6 :char-end 7 :text "File \"bug.ml\", line 9, characters 6-7:\nWarning 27: unused variable z." :full-text "File \"bug.ml\", line 9, characters 6-7:\nWarning 27: unused variable z."))
+;; (Omake.Error.is e)
+;; (setq e (Omake.Error :id "/Users/seanmcl/save/projects/omake-mode-test/ocaml1" :relpath "lib" :file "bug.ml" :line 9 :char-beg 6 :char-end 7 :text "File \"bug.ml\", line 9, characters 6-7:\nWarning 27: unused variable z." :full-text "File \"bug.ml\", line 9, characters 6-7:\nWarning 27: unused variable z."))
 
-;; (setq e (Omake.Error :id "/home/seanmcl/ocaml" :relpath "lib" :file "bug.ml" :line 9 :char-beg 6 :char-end 7 :text "File \"bug.ml\", line 9, characters 6-7:\nWarning 27: unused variable z." :full-text "File \"bug.ml\", line 9, characters 6-7:\nWarning 27: unused variable z."))
-
-(defun Omake.Error.visible-text (e)
-  (if (Omake.Error.full-text-visible-p e)
-      (Omake.Error.full-text e)
-    (Omake.Error.text e)))
-
-(defun Omake.Error.to-status-buffer-string (e)
-  (let* ((text (Omake.Error.visible-text e))
-         (relpath (Omake.Error.relpath e))
-         ;; don't let relpath be too long
-         (relpath-len (length relpath))
-         (relpath-max-len 100) ;; ignore this for now
-         (relpath (if (< relpath-len relpath-max-len) relpath
-                    (concat "..." (substring relpath
-                                             (- relpath-max-len 3)
-                                             relpath-len)))))
-    (replace-regexp-in-string "File \"" (format "File \"%s/" relpath) text)))
+;;----------------------------------------------------------------------------;;
+;; Hashing                                                                    ;;
+;;----------------------------------------------------------------------------;;
 
 (defun Omake.Error.same-error (e1 e2)
   "It's common for errors at line=1, char_beg=0, char_end=1 in the same file to be different,
    (equal (Omake.Error.char-end e1) (Omake.Error.char-end e2))
    (equal (Omake.Error.full-text e1) (Omake.Error.full-text e2))))
 
-(defun Omake.Error.hash (e)
-  (assert (Omake.Error.is e))
-  (sxhash (list
-           (Omake.Error.full-text e)
-           (Omake.Error.id e)
-           (Omake.Error.relpath e)
-           (Omake.Error.file e)
-           (Omake.Error.line e)
-           (Omake.Error.char-beg e)
-           (Omake.Error.char-end e)
-           (Omake.Error.full-text e))))
+;; (defun Omake.Error.hash (e)
+;;   (assert (Omake.Error.is e))
+;;   (sxhash (list
+;;            (Omake.Error.full-text e)
+;;            (Omake.Error.id e)
+;;            (Omake.Error.relpath e)
+;;            (Omake.Error.file e)
+;;            (Omake.Error.line e)
+;;            (Omake.Error.char-beg e)
+;;            (Omake.Error.char-end e)
+;;            (Omake.Error.full-text e))))
 ;; (Omake.Error.hash current)
 
+(define-hash-table-test
+  'Omake.Error.hash-test 'Omake.Error.same-error 'Omake.Error.hash)
+
+;;----------------------------------------------------------------------------;;
+;; Misc                                                                       ;;
+;;----------------------------------------------------------------------------;;
+
 (defun Omake.Error.file-path (e)
   "The fullpath of a file"
   (assert (Omake.Error.is e))
     (with-current-buffer status-buffer (goto-char (point-min)))
     (Omake.Error.show e)))
 
-(defun* Omake.Error.to-string (e &key is-current)
+(defun* Omake.Error.to-status-buffer-string (e &key full-text)
+  (let* ((text (if full-text
+                   (Omake.Error.full-text e)
+                 (Omake.Error.text e)))
+         (relpath (Omake.Error.relpath e))
+         ;; don't let relpath be too long
+         (relpath-len (length relpath))
+         (relpath-max-len 100) ;; ignore this for now
+         (relpath (if (< relpath-len relpath-max-len) relpath
+                    (concat "..." (substring relpath
+                                             (- relpath-max-len 3)
+                                             relpath-len)))))
+    (replace-regexp-in-string "File \"" (format "File \"%s/" relpath) text)))
+
+(defun* Omake.Error.error-string (e &key full-text)
   (assert (Omake.Error.is e))
   ;; Use lexical-let so we can put the error in a closure
   (lexical-let*
       (;; error jumping
        (e e) ;; !!! close on e !!!
-       (error-face (if is-current 'Omake.Face.error-current 'Omake.Face.error-pending))
        (goto-error (lambda ()
                      (interactive)
                      (Omake.Error.eval e)))
        (goto-keymap   (make-sparse-keymap))
        (_ (define-key goto-keymap   [mouse-1] goto-error))
        (_ (define-key goto-keymap   "\C-m"     goto-error))
-       (error-str (Omake.Error.to-status-buffer-string e)))
+       (error-str (Omake.Error.to-status-buffer-string e :full-text full-text)))
     (propertize error-str
-                'face            error-face
                 'mouse-face      'Omake.Face.Error.mouse
                 'keymap          goto-keymap)))
 ;; (setq s (Omake.Error.to-string e))
 
+(defun* Omake.Error.cache-strings (e)
+  (setf (Omake.Error.string e) (Omake.Error.error-string e :full-text nil)
+        (Omake.Error.full-string e) (Omake.Error.error-string e :full-text t)))
+
+;;----------------------------------------------------------------------------;;
+;; Cache                                                                      ;;
+;;----------------------------------------------------------------------------;;
+
+(defconst Omake.Error.table (make-hash-table :test 'Omake.Error.hash-test))
+;; (hash-table-size Omake.Error.table)
+
+;; CR smclaughlin: There's a memory leak here, as the cache is never cleared.
+(defun* Omake.Error (&key hash id relpath file line char-beg char-end text full-text)
+  "The constructor caches the string representation."
+  (let* ((e (Omake.Error.make
+             :hash hash 
+             :id id :relpath relpath :file file :line line :char-beg char-beg
+             :char-end char-end :text text :full-text full-text))
+         (cached (gethash e Omake.Error.table)))
+    (if cached cached
+      (Omake.Error.cache-strings e)
+      (puthash e e Omake.Error.table)
+      e)))
+
+(defun* Omake.Error.to-string (e &key is-current)
+  (let ((error-face (if is-current 'Omake.Face.error-current 'Omake.Face.error-pending))
+        (str (if (Omake.Error.full-text-visible-p e)
+                  (Omake.Error.full-string e)
+                (Omake.Error.string e))))
+    (propertize str 'face error-face)))
+
 (defun Omake.Error.mem (e es)
   (List.exists (lambda (e1) (Omake.Error.same-error e e1)) es))
 
 ;; Sets of errors                                                             ;;
 ;;============================================================================;;
 
-(define-hash-table-test
-  'Omake.Error.hash-test 'Omake.Error.same-error 'Omake.Error.hash)
-
 (defun Omake.Error.make-hash-set (l)
   (let ((table (make-hash-table :test 'Omake.Error.hash-test)))
     (List.iter (lambda (e) (puthash e t table)) l)

elisp/omake/omake-version.el

 
 ;; Detect version changes
 
-(defconst Omake.pre-version 14
+(defconst Omake.pre-version 15
   "We use a version number to synchronize the elisp code the omake server
 To roll a new version of elisp that is incompatible with ocaml or vice
 versa, you must bump the version number.  This prevents old elisp code

ocaml/omake/error.ml

 
 open Std
 
+module Make = struct
+  type t = {
+    relpath : path;
+    file : path;
+    line : int;
+    char_beg : int;
+    char_end : int;
+    text : string;
+    full_text : string option;
+  }
+end
+
 type t = {
+  hash : int;
   relpath : path;
   file : path;
   line : int;
   char_end : int;
   text : string;
   full_text : string option;
-} with sexp
+} with sexp, fields
+
+let make m =
+  let hash = Hashtbl.hash m in
+  { hash
+  ; relpath = m.Make.relpath
+  ; file = m.Make.file
+  ; line = m.Make.line
+  ; char_beg = m.Make.char_beg
+  ; char_end = m.Make.char_end
+  ; text = m.Make.text
+  ; full_text = m.Make.full_text }
 
 let to_string = Sexp.to_string_hum ** sexp_of_t
 
   | 0 -> Int.compare e1.line e2.line
   | n -> n
 
-let equal x y =
-  String.equal x.file y.file &&
-    Int.equal x.line y.line &&
-    Int.equal x.char_beg x.char_beg &&
-    Int.equal x.char_end y.char_end
+let equal x y = x.hash = y.hash
+  (* String.equal x.file y.file && *)
+  (*   Int.equal x.line y.line && *)
+  (*   Int.equal x.char_beg x.char_beg && *)
+  (*   Int.equal x.char_end y.char_end *)
 
 (* n^2 dedup.  Errors must maintain their relative order in the raw buffer.
    Of the equal errors, keep the last. *)
   | Some ftext -> String.escaped ftext
   in
   sprintf "
-      (Omake.Error :id \"%s\"
+      (Omake.Error :hash %d
+                   :id \"%s\"
                    :relpath \"%s\"
                    :file \"%s\"
                    :line %d
                    :char-end %d
                    :text \"%s\"
                    :full-text \"%s\")"
-    id t.relpath t.file t.line t.char_beg t.char_end
+    t.hash id t.relpath t.file t.line t.char_beg t.char_end
     text full_text

ocaml/omake/error.mli

 
 open Std
 
-type t = {
-  relpath : path;
-  file : path;
-  line : int;
-  char_beg : int;
-  char_end : int;
-  text : string;
-  full_text : string option;
-} with sexp
+type t with sexp
+
+module Make : sig
+  type t = {
+    relpath : path;
+    file : path;
+    line : int;
+    char_beg : int;
+    char_end : int;
+    text : string;
+    full_text : string option;
+  }
+end
+
+val make : Make.t -> t
+
+val relpath : t -> path
+val text : t -> string
+val full_text : t -> string option
+val file : t -> path
+
 val to_string : t -> string
 val to_elisp : id:string -> t -> Elisp.t
   (* path from the omake root *)

ocaml/omake/omake.ml

       | None -> Error.shorten_lines text, None
       | Some short_text -> Error.shorten_lines short_text, Some text
     in
-    { Error.relpath = t.relpath
-    ; file = t.file
-    ; line = t.line
-    ; char_beg = t.char_beg
-    ; char_end = t.char_end
-    ; text
-    ; full_text
-    }
+    Error.make { Error.Make.relpath = t.relpath
+               ; file = t.file
+               ; line = t.line
+               ; char_beg = t.char_beg
+               ; char_end = t.char_end
+               ; text
+               ; full_text
+               }
 
   let to_omake_error t =
     (* Don't remove lines from omake errors.  Often the lines we don't care about
             | Some _ -> ()
             | None ->
               (* Exclude error-enabled-warning error *)
-              if Regex.has_match Rex.error_enabled_warnings e.Error.text
+              if Regex.has_match Rex.error_enabled_warnings (Error.text e)
               then ()
               else t.errors <- e :: t.errors
           end;
           update ()
         | E.Refresh_file (`Dir d, `Filename_with_no_extension f) ->
           let errs = List.filter t.errors ~f:(fun e ->
-            let ef = remove_extension e.Error.file in
-            not (String.equal e.Error.relpath d
+            let ef = remove_extension (Error.file e) in
+            not (String.equal (Error.relpath e) d
                  && String.equal ef f))
           in
           t.errors <- errs;

ocaml/omake/version.ml

 
 (* Use a version number to synchronize with the elisp code. *)
-let version = 14
+let version = 15
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.