annot -> type.

This commit is contained in:
Kazu Yamamoto 2012-02-13 13:38:06 +09:00
parent a43985a735
commit 11eb321ff6
2 changed files with 20 additions and 15 deletions

View File

@ -62,10 +62,10 @@ typeOf opt fileName modstr lineNo colNo = inModuleContext opt fileName modstr ex
#else
l spn | isGoodSrcSpan spn
#endif
= ("("++) . (++")") . unwords . map show $
= unwords . map show $
[ srcSpanStartLine spn, srcSpanStartCol spn
, srcSpanEndLine spn, srcSpanEndCol spn ]
l _ = "(0 0 0 0)"
l _ = "0 0 0 0"
cmp a b
| a `isSubspanOf` b = O.LT

View File

@ -62,15 +62,17 @@
(defun ghc-type-get-types ()
(overlay-get ghc-type-overlay 'types))
(ghc-defstruct tinfo beg-line beg-column end-line end-column info)
(defun ghc-type-init ()
(setq ghc-type-overlay (make-overlay 0 0))
(overlay-put ghc-type-overlay 'face 'region)
(ghc-type-set-ix 0)
(ghc-type-set-point 0)
(setq after-change-functions
(cons 'ghc-delete-type-ovl after-change-functions)))
(cons 'ghc-type-deleve-overlay after-change-functions)))
(defun ghc-delete-type-ovl (beg end len)
(defun ghc-type-deleve-overlay (beg end len)
(when (overlayp ghc-type-overlay)
(delete-overlay ghc-type-overlay)))
@ -85,25 +87,28 @@
(defun ghc-show-type0 (modname)
(let* ((buf (current-buffer))
(types (ghc-get-type modname))
(tinfo (nth (ghc-type-get-ix) types))
(pos (nth 0 tinfo))
(type (nth 1 tinfo))
(left (ghc-get-pos buf (nth 0 pos) (nth 1 pos)))
(right (ghc-get-pos buf (nth 2 pos) (nth 3 pos))))
(move-overlay ghc-type-overlay (- left 1) (- right 1) buf)
(message type)))
(tinfos (ghc-type-get-tinfos modname))
(tinfo (nth (ghc-type-get-ix) tinfos))
(type (ghc-tinfo-get-info tinfo))
(beg-line (ghc-tinfo-get-beg-line tinfo))
(beg-column (ghc-tinfo-get-beg-column tinfo))
(end-line (ghc-tinfo-get-end-line tinfo))
(end-column (ghc-tinfo-get-end-column tinfo))
(left (ghc-get-pos buf beg-line beg-column))
(right (ghc-get-pos buf end-line end-column)))
(move-overlay ghc-type-overlay (- left 1) (- right 1) buf)
(message type)))
(defun ghc-get-type (modname)
(defun ghc-type-get-tinfos (modname)
(if (= (ghc-type-get-point) (point))
(ghc-type-set-ix
(mod (1+ (ghc-type-get-ix)) (length (ghc-type-get-types))))
(ghc-type-set-types (ghc-call-type modname))
(ghc-type-set-types (ghc-type-obtain-tinfos modname))
(ghc-type-set-point (point))
(ghc-type-set-ix 0))
(ghc-type-get-types))
(defun ghc-call-type (modname)
(defun ghc-type-obtain-tinfos (modname)
(let* ((ln (int-to-string (line-number-at-pos)))
(cn (int-to-string (current-column)))
(cdir default-directory)