Permalink
Browse files

(inferior-haskell-info-xref-re): New cst.

Ignore-this: ce4a5e92609010c1a9935bad0aee6468
(inferior-haskell-info-xref-re): New cst.
(inferior-haskell-error-regexp-alist): Use it to highlight xref info.
(inferior-haskell-type, inferior-haskell-info)
(inferior-haskell-find-definition): New funs.
Contributed by Matthew Danish <mrd@cs.cmu.edu>.

darcs-hash:20070210072307-c2f2e-1e9b01952d8907831e475c9f665f9446ae359871.gz
  • Loading branch information...
1 parent 9e99279 commit 36dd8bd989b07b0991767e34210758b66ec057b2 monnier committed Feb 10, 2007
Showing with 114 additions and 2 deletions.
  1. +114 −2 inf-haskell.el
View
@@ -1,6 +1,6 @@
;;; inf-haskell.el --- Interaction with an inferior Haskell process.
-;; Copyright (C) 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: Haskell
@@ -30,6 +30,7 @@
(require 'comint)
(require 'shell) ;For directory tracking.
(require 'compile)
+(require 'haskell-mode)
(eval-when-compile (require 'cl))
;; Here I depart from the inferior-haskell- prefix.
@@ -49,12 +50,19 @@ The command can include arguments."
:group 'haskell
:type '(choice string (repeat string)))
+(defconst inferior-haskell-info-xref-re
+ "\t-- Defined at \\(.+\\):\\([0-9]+\\):\\([0-9]+\\)$")
+
(defconst inferior-haskell-error-regexp-alist
;; The format of error messages used by Hugs.
`(("^ERROR \"\\(.+?\\)\"\\(:\\| line \\)\\([0-9]+\\) - " 1 3)
;; Format of error messages used by GHCi.
("^\\(.+?\\):\\([0-9]+\\):\\(\\([0-9]+\\):\\)?\\( \\|\n +\\)\\(Warning\\)?"
- 1 2 4 ,@(if (fboundp 'compilation-fake-loc) '((6)))))
+ 1 2 4 ,@(if (fboundp 'compilation-fake-loc) '((6))))
+ ;; Info xrefs.
+ ,@(if (fboundp 'compilation-fake-loc)
+ `((,inferior-haskell-info-xref-re
+ 1 2 3 0))))
"Regexps for error messages generated by inferior Haskell processes.
The format should be the same as for `compilation-error-regexp-alist'.")
@@ -209,6 +217,110 @@ The process PROC should be associated to a comint buffer."
(interactive)
(inferior-haskell-load-file 'reload))
+(defun inferior-haskell-type (expr &optional insert-value)
+ "Query the haskell process for the type of the given expression.
+If optional argument `insert-value' is non-nil, insert the type above point
+in the buffer. This can be done interactively with the \\[universal-argument] prefix.
+The returned info is cached for reuse by `haskell-doc-mode'."
+ (interactive
+ (let ((sym (haskell-ident-at-point)))
+ (list (read-string (if (> (length sym) 0)
+ (format "Show type of (default %s): " sym)
+ "Show type of: ")
+ nil nil sym)
+ current-prefix-arg)))
+ (if (string-match "\\`\\s_+\\'" expr) (setq expr (concat "(" expr ")")))
+ (let* ((proc (inferior-haskell-process))
+ (type
+ (with-current-buffer (process-buffer proc)
+ (let ((parsing-end ; Remember previous spot.
+ (marker-position (process-mark proc))))
+ (inferior-haskell-send-command proc (concat ":type " expr))
+ ;; Find new point.
+ (goto-char (point-max))
+ (inferior-haskell-wait-for-prompt proc)
+ ;; Back up to the previous end-of-line.
+ (end-of-line 0)
+ ;; Extract the type output
+ (buffer-substring-no-properties
+ (save-excursion (goto-char parsing-end)
+ (line-beginning-position 2))
+ (point))))))
+ (if (not (string-match (concat "\\`" (regexp-quote expr) "[ \t]+::[ \t]*")
+ type))
+ (error "No type info: %s" type)
+
+ ;; Cache for reuse by haskell-doc.
+ (when (and (boundp 'haskell-doc-mode) haskell-doc-mode
+ (boundp 'haskell-doc-user-defined-ids)
+ ;; Haskell-doc only works for idents, not arbitrary expr.
+ (string-match "\\`(?\\(\\s_+\\|\\(\\sw\\|\\s'\\)+\\)?[ \t]*::[ \t]*"
+ type))
+ (let ((sym (match-string 1 type)))
+ (setq haskell-doc-user-defined-ids
+ (cons (cons sym (substring type (match-end 0)))
+ (remove-if (lambda (item) (equal (car item) sym))
+ haskell-doc-user-defined-ids)))))
+
+ (if (interactive-p) (message type))
+ (when insert-value
+ (beginning-of-line)
+ (insert type "\n"))
+ type)))
+
+(defun inferior-haskell-info (sym)
+ "Query the haskell process for the info of the given expression."
+ (interactive
+ (let ((sym (haskell-ident-at-point)))
+ (list (read-string (if (> (length sym) 0)
+ (format "Show info of (default %s): " sym)
+ "Show info of: ")
+ nil nil sym))))
+ (let ((proc (inferior-haskell-process)))
+ (with-current-buffer (process-buffer proc)
+ (let ((parsing-end ; Remember previous spot.
+ (marker-position (process-mark proc))))
+ (inferior-haskell-send-command proc (concat ":info " sym))
+ ;; Find new point.
+ (goto-char (point-max))
+ (inferior-haskell-wait-for-prompt proc)
+ ;; Move to previous end-of-line
+ (end-of-line 0)
+ (let ((result
+ (buffer-substring-no-properties
+ (save-excursion (goto-char parsing-end)
+ (line-beginning-position 2))
+ (point))))
+ ;; Move back to end of process buffer
+ (goto-char (point-max))
+ (if (interactive-p) (message "%s" result))
+ result)))))
+
+(defun inferior-haskell-find-definition (sym)
+ "Attempt to locate and jump to the definition of the given expression."
+ (interactive
+ (let ((sym (haskell-ident-at-point)))
+ (list (read-string (if (> (length sym) 0)
+ (format "Find definition of (default %s): " sym)
+ "Find definition of: ")
+ nil nil sym))))
+ (let ((info (inferior-haskell-info sym)))
+ (if (not (string-match inferior-haskell-info-xref-re info))
+ (error "No source information available")
+ (let ((file (match-string-no-properties 1 info))
+ (line (string-to-number
+ (match-string-no-properties 2 info)))
+ (col (string-to-number
+ (match-string-no-properties 3 info))))
+ (when file
+ ;; Push current location marker on the ring used by `find-tag'
+ (require 'etags)
+ (ring-insert find-tag-marker-ring (point-marker))
+ (pop-to-buffer (find-file-noselect file))
+ (when line
+ (goto-line line)
+ (when col (move-to-column col))))))))
+
(provide 'inf-haskell)
;; arch-tag: 61804287-63dd-4052-bc0e-90f691b34b40

0 comments on commit 36dd8bd

Please sign in to comment.