Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml-mode/trunk/sml-proc.el
ViewVC logotype

Diff of /sml-mode/trunk/sml-proc.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2824, Wed Oct 31 17:51:51 2007 UTC revision 2852, Fri Nov 9 04:22:02 2007 UTC
# Line 325  Line 325 
325    ;; Try to recognize SML/NJ type error message and to highlight finely the    ;; Try to recognize SML/NJ type error message and to highlight finely the
326    ;; difference between the two types (in case they're large, it's not    ;; difference between the two types (in case they're large, it's not
327    ;; always obvious to spot it).    ;; always obvious to spot it).
328      ;;
329      ;; Sample messages:
330      ;;
331      ;; Data.sml:31.9-33.33 Error: right-hand-side of clause doesn't agree with function result type [tycon mismatch]
332      ;;   expression:  Hstring
333      ;;   result type:  Hstring * int
334      ;;   in declaration:
335      ;;     des2hs = (fn SYM_ID hs => hs
336      ;;                | SYM_OP hs => hs
337      ;;                | SYM_CHR hs => hs)
338      ;; Data.sml:35.44-35.63 Error: operator and operand don't agree [tycon mismatch]
339      ;;   operator domain: Hstring * Hstring
340      ;;   operand:         (Hstring * int) * (Hstring * int)
341      ;;   in expression:
342      ;;     HSTRING.ieq (h1,h2)
343      ;; vparse.sml:1861.6-1922.14 Error: case object and rules don't agree [tycon mismatch]
344      ;;   rule domain: STConstraints list list option
345      ;;   object: STConstraints list option
346      ;;   in expression:
347    (save-current-buffer    (save-current-buffer
348      (when (and (derived-mode-p 'sml-mode 'inferior-sml-mode)      (when (and (derived-mode-p 'sml-mode 'inferior-sml-mode)
349                 (boundp 'next-error-last-buffer)                 (boundp 'next-error-last-buffer)
# Line 332  Line 351 
351                 (set-buffer next-error-last-buffer)                 (set-buffer next-error-last-buffer)
352                 (derived-mode-p 'inferior-sml-mode)                 (derived-mode-p 'inferior-sml-mode)
353                 ;; The position of `point' is not guaranteed :-(                 ;; The position of `point' is not guaranteed :-(
354                 (looking-at ".*\n  operator domain: "))                 (looking-at (concat ".*\\[tycon mismatch\\]\n"
355                                       "  \\(operator domain\\|expression\\|rule domain\\): +")))
356        (ignore-errors (require 'smerge-mode))        (ignore-errors (require 'smerge-mode))
357        (if (not (fboundp 'smerge-refine-subst))        (if (not (fboundp 'smerge-refine-subst))
358            (remove-hook 'next-error-hook 'inferior-sml-next-error-hook)            (remove-hook 'next-error-hook 'inferior-sml-next-error-hook)
359          (save-excursion          (save-excursion
360            (let ((b1 (match-end 0))            (let ((b1 (match-end 0))
361                  e1 b2 e2)                  e1 b2 e2)
362              (when (re-search-forward "\n  in expression:\n" nil t)              (when (re-search-forward "\n  in \\(expression\\|declaration\\):\n"
363                                         nil t)
364                (setq e2 (match-beginning 0))                (setq e2 (match-beginning 0))
365                (when (re-search-backward "\n  operand:         " b1 t)                (when (re-search-backward
366                         "\n  \\(operand\\|result type\\|object\\): +"
367                         b1 t)
368                  (setq e1 (match-beginning 0))                  (setq e1 (match-beginning 0))
369                  (setq b2 (match-end 0))                  (setq b2 (match-end 0))
370                  (smerge-refine-subst b1 e1 b2 e2                  (smerge-refine-subst b1 e1 b2 e2

Legend:
Removed from v.2824  
changed lines
  Added in v.2852

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0