Emacs mode for Mercury, mercury.el-rotd-1998-10-14

Dominique de Waleffe ddw at miscrit.be
Wed Oct 14 19:46:05 AEST 1998

I saw a question about this and here's the code I wrote to ease my

Mercury writing...

There are  rough edges and more future features than current


It does require a (beginning-of-clause) function to (partly, buggy)

support  inserting inferred declarations into the code.

If you like it, good. If you make extensions I'd like to see them. I

will surely implement some of the stuff I thought about in some


Have fun....



#### NOTE OUR NEW PHONE: +32 2 757 10 15

Dominique de Waleffe   Email: ddw at acm.org, ddw at myself.com, ddw at miscrit.be

Mission Critical       WWW:   http://www.miscrit.be/~ddw

Phone: +32 2 757 10 15  Fax: +32 2 759 27 60

PGP key fingerprint: F9 CC 23 74 44 62 7C F3  8C 12 DF 71 BB 60 54 98

;;; mercury.el --- Extra tools to support Mercury development

;; Time-stamp: <1998-10-14 11:19:54 ddw>

;; $Id: mercury.el,v 1.13 1998/10/14 09:37:25 ddw Exp $

;; Copyright (C) 1998 by Mission Critical, sa, Belgium

;; Author:  <ddw at acm.org>

;; Keywords: languages, Mercury, minor-mode

;; This file is not part of GNU Emacs.

;; This extension  is free software; you can redistribute it and/or modify

;; it under the terms of the GNU General Public License as published by

;; the Free Software Foundation; either version 2, or (at your option)

;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,

;; but WITHOUT ANY WARRANTY; without even the implied warranty of


;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License

;; along with GNU Emacs; see the file COPYING.  If not, write to

;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,

;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; This file contains a number of specific tools whose goal is to

;; support development of programs written in the language

;; Mercury. This file does not support syntactic support since the

;; syntax of Mercury is close to that of prolog. Rather this file

;; should be used as extra tools activated as supplement to the prolog

;; mode. The goal is to provide the following categories of features:

;; 1) Skeletons: easy ways to insert new predicates/functions either

;;    a the current location or at the expected place in the file.

;;    Those support history and completion for know items. List

;;    extends with use (but not across sessions...)

;;      A number of extra skeletons should be provided  for supported

;;      other common  idioms whose synax is not easy to remember

;;      (typeclasses, lambda terms,...). 

;; [feature status: some]

;; 2) Support the extraction of declaration inferred by the compiler

;;    and inserting tem at the correct spot in the file. Thus the nex

;;    time the compiler runs, the inferences are not to be redone and

;;    the code contains the (expected or not!) declarations.

;;    This partly works but some work is needed... It's been a while

;;    since I used it.

;; [feature status: nil ]

;; 3) Support to the automatic insertion of extra predicate arguments

;;    that are to be threaded into the code. SHould this be done here

;;    or by some DCG extension ???

;; [feature status: nil]

;; 4) In addition, a modified version of etags will support the

;;    creation of tags files for Mercury. The standard version

;;    supports prolog but we want to seethe :-pred and :-mode

;;    declarations (in place of, or in addition to the bodies of

;;    predicates)

;; [feature status: nil, have to see what the new mtags from mercury

;; distrib does...]

;; 5) extend font-lock support for some keywords. module,

;;    implementation, end_module, mode, pred, error -->, --->, ->

;; [feature status: some]

;; 6) exploit imenu in order to display a menu with interesting places

;;    to go.

;; [feature status: nil]

;; 7) provide a menu specific to Mercury actions.

;; [feature status: Done]

;; 8) provide this as a major mode

;; [feature status: hacked]

;; This mode relies on (beginning-of-clause) which should be

;; available in prolog-modes derived from the original Quintus Emacs

;; support.

;; Activation: This file provides a minor mode which is activated

;; (toggle) by calling M-x mercury-minor-mode

;; One can also put the following two lines in .emacs.

;; (require 'mercury)

;; (add-hook 'prolog-mode-hook 'merc-maybe-minor)


;; or

;; (push '("\\.m$" . mercury-mode)

;;      auto-mode-alist)

;;; Code:

(require 'cl)

;; 1) Skeletons

(require 'skeleton)

;; 1.1) This inserts a module skeleton at the top of the file. It

;; asks for the name (default is current file name).

(define-skeleton merc-module

  "Insert a Mercury Module skeleton, It asks for the name of the module."

  (read-from-minibuffer "Module name:"

			(if (buffer-file-name)





  '(goto-char (point-min))

  ":- module " str "." \n

  "%% $Id" "$" \n

  "%% Time-stamp: <>" \n \n

  "%%-----------------------------------------------------------------" \n

  "%% Purpose:" \n

  "%% " _ \n

  "%%-----------------------------------------------------------------" \n

  ":- interface."


  ":- implementation." \n


  ":- end_module " str "." \n)

;; 1.2) inserts a pred decl (expects both types and modes)

(define-skeleton merc-decl-full-pred

  "inserts a pred decl for a predicate"



  "%%% ------------------------" \n

  "%%% Predicate: " str \n

  "%%% ------------------------" \n

  "%%% Description: " _ \n

  "%%% ------------------------" \n

  ":- pred " str "("

  ( (merc-read-type) str & "::" (merc-read-mode str) ",")

  & -1 ") is " (merc-get-determinism) "." \n)

;; 1.3) Inserts a pred  declaration. with only the types

(define-skeleton merc-decl-pred

  "inserts a pred decl for a predicate"



  "%%% ------------------------" \n

  "%%% Predicate: " str \n

  "%%% ------------------------" \n

  "%%% Description: " _ \n

  "%%% ------------------------" \n

  ":- pred " str "("

  ( (merc-read-type t) str &  ",")

  & -1 ") is " (merc-get-determinism) "." \n)

;; 1.3) Inserts a pred  declaration. with only the types

(define-skeleton merc-pred-descr

  "inserts a description for a predicate"



  "%%% ------------------------" \n

  "%%% Predicate: " str \n

  "%%% ------------------------" \n

  "%%% Description: " _ \n

  "%%% ------------------------" \n)

;; 1.3) Inserts a mode declaration

(define-skeleton merc-decl-mode

  "inserts a mode decl for a predicate"


  ":- mode " str "("

  ( (merc-read-mode) str &  ",")

  & -1 ")." \n)

;; 1.x.0) Useful macro definitions.

(defmacro merc-mk-completion-table (var)

  `(mapcar (function (lambda(name) (cons name nil)))


;; 1.x.1) Reads a type (name,struct), maintains history list

(defvar merc-type-hist '("int" "float" "string" "char" "list()"

			 "*ios*" "*g")

  "History list for types")		; should be init'ed with

					; types

(defun merc-read-type (&optional onlytype)

  "Reads a type (name,structure) from the minibuffer. Maintains a

  history list of already entered types. If onlytype is t, the

  special type names are expanded at this level."

  (let ((type (completing-read "Type: " 

		   (merc-mk-completion-table merc-type-hist)

		   nil nil nil 'merc-type-hist)))

    (if onlytype

	(cond ((and type (equal type "*ios*"))


	      ((and type (equal type "*g*"))


	      (t type))


;; 1.x.2) Reads a mode (name,struct), maintains history list

(defvar merc-mode-hist '("in" "out" "di" "uo")

  "History list for modes")

(defun merc-read-mode (&optional type)

  "Reads a mode from the minibuffer. Maintains a

  history list of already entered modes."

  (cond ((and type (equal type "*ios*"))

	 (delete-char -7)


	((and type (equal type "*g*"))

	 (delete-char -5)


	(t (completing-read "Mode: " 

			    (merc-mk-completion-table merc-mode-hist)

			    nil nil nil 'merc-mode-hist))))

;; 1.x.3) Reads a predicate name, maintains history list

(defvar merc-predicate-hist nil

  "History list for predicates")

(defun merc-read-predicate ()

  "Reads a predicate name structure from the minibuffer. Maintains a

  history list of already entered predicates."

  (completing-read "Predicate: " 

		   (merc-mk-completion-table merc-predicate-hist)

		   nil nil nil 'merc-predicate-hist))

(defvar merc-det-hist '("det" "semidet" "multi" "erroneous"

			"failure" "cc_multi"  "nondet"))

(defun merc-get-determinism ()

  "Read a determinism category. Must match existing name"

  (completing-read "Determinism: " 

		   (merc-mk-completion-table merc-det-hist)

		   nil t (cons (car merc-det-hist)


		   '(merc-det-hist . 1)))


;; 1.x.4) 

(defun merc-goto-implementation (&optional endp)

  "Locates point at the top (end if arg is non-nil)) end of the

  implementation section."

  (interactive "p")

  (if endp

      ;; goto end of impl


	(goto-char (point-max))

	(if (re-search-backward "^:-[ ]*end_module.*\.$" nil t)

	    (progn (forward-line -1) (beginning-of-line))

	  (error "could not locate end of module")))

    (goto-char (point-min))

    (if (re-search-forward "^:-[ ]*implementation[ ]*.$" nil t)

	(progn (forward-line 1) (beginning-of-line))

      (error "Could not locate implementation section"))))

;; 1.x.5) 

(defun merc-goto-interface (&optional endp)

  "Locates point at the end (top if arg is non-nil))  of the

  interface section."

  (interactive "p")

  (if (not endp)

      ;; goto end of interface


	(goto-char (point-max))

	(if (re-search-backward "^:-[ ]*implementation[ ]*\.$" nil t)

	    (progn (forward-line -1) (beginning-of-line))

	  (error "could not locate end of implementation")))

    (goto-char (point-min))

    (if (re-search-forward "^:-[ ]*interface[ ]*.*\.$" nil t)

	(progn (forward-line 1) (beginning-of-line))

      (error "Could not locate interface section"))))

;; 2) Extraction of inferences


(defstruct merc-decl file line type decl)

(defun merc-extract-infered-decls()

  "Automatically inserts all the inferred declarations found in the

  compilation buffer"



    (let ((items nil))

      (set-buffer "*compilation*")

      (goto-char (point-min))

      (while (not (eobp))

	(cond ((looking-at

		"^\\(.*\\):\\([0-9]+\\): Inferred :- \\(mode\\|pred\\) \\(.*\\)$")

	       (push (make-merc-decl :file (match-string 1)

				     :line (string-to-number (match-string 2))

				     :type (match-string 3)

				     :decl (match-string 4))


	(forward-line 1))


       (sort* items

	      (function (lambda (d1 d2)

			  ;; increasing file names

			  (or (string-lessp (merc-decl-file d1)

					    (merc-decl-file d2))

			      (and (string-equal (merc-decl-file d1)

						 (merc-decl-file d2))

				   ;; decreasing line numbers

				   (> (merc-decl-line d1)

				      (merc-decl-line d2)))

			      (and (string-equal (merc-decl-file d1)

						 (merc-decl-file d2))

				   (= (merc-decl-line d1)

				      (merc-decl-line d2))

				   (string-equal (merc-decl-type d1)



(defun merc-process-decls (decls)

  (mapcar 'merc-process-one-decl	;(function (lambda(decl)

					;      (message "%S" decl)))

	  decls) )

;;; The following works when both decls are inferred by the compiler.

;;; if only the pred is there, it seems to work.

;;; if the pred decl is present and mode inferred it fails. [rpa

;;; 10/13/97]

(defun merc-process-one-decl(decl)

  (find-file (merc-decl-file decl))

  (goto-line (merc-decl-line decl))

  (let ((declarationline (format ":- %s %s\n"

				 (merc-decl-type decl)

				 (merc-decl-decl decl))))

    (if (string-equal (merc-decl-type decl) "pred")


	  (if (looking-at "^:- mode")


	    (forward-char 1)		; avoid bug in

					; beginning-of-clause

	    ;; assumed available from prolog-mode

	    (beginning-of-clause)	; not needed if compiler

					; would tell line number

					; where clause head starts


	  (insert declarationline)

					;  (set-marker merc-position

					;  (point))


      ;; Inserting mode decl

      (if (looking-at "^:- pred")

	  (progn (forward-word 2)

		 (forward-sexp 1)

		 (forward-line 1)


      (insert declarationline))))

;; 5) Font-locking


(defvar merc-font-lock-keywords


     ("\\<_\\w*\\>" (0 font-lock-reference-face)) 

     ("\\<[_A-Z]\\w*\\>" (0 font-lock-variable-name-face)) 

    ("\\([ \t]*:-[ \t]*\\<pred\\>\\)[ \t]+\\(\\w+\\)"

     (1 font-lock-keyword-face)

     (2 font-lock-function-name-face))

    ("\\([ \t]*:-[ \t]*\\<\\(end_\\)?module\\>\\)[ \t]+\\(\\w+\\)"

     (1 font-lock-keyword-face)

     (3 font-lock-function-name-face))

    ("\\([ \t]*:-[ \t]*\\<func\\>\\)[ \t]+\\(\\w+\\)"

     (1 font-lock-keyword-face)

     (2 font-lock-function-name-face))

    ("\\([ \t]*:-[ \t]*\\<mode\\>\\)[ \t]+\\(\\w+\\)"

     (1 font-lock-keyword-face)

     (2 font-lock-function-name-face))

    ("\\([ \t]*:-[ \t]*\\<import_module\\>\\)[ \t]+\\(\\(\\w+[, \t]*\\)+\\)"

     (1 font-lock-keyword-face append)

     (2 font-lock-reference-face append))

    ("\\([ \t]*:-[ \t]*\\<type\\>\\)[ \t]+\\(\\w+\\)"

     (1 font-lock-keyword-face )

     (2 font-lock-type-face))





(defvar merc-saved-f-l-k nil)

(make-variable-buffer-local 'merc-saved-f-l-k)

(defun merc-f-l-on ()

  (if (not merc-saved-f-l-k)


	(setq merc-saved-f-l-k font-lock-keywords)

	(setq font-lock-keywords merc-font-lock-keywords)

	(font-lock-mode 1))))

(defun merc-f-l-off()

  (if merc-saved-f-l-k


	(setq font-lock-keywords merc-saved-f-l-k)

	(setq merc-saved-f-l-k nil))))


;; 8) Activation as minor mode


(defvar mercury-minor-mode nil)

(make-variable-buffer-local 'mercury-minor-mode)

(or (assq 'mercury-minor-mode minor-mode-alist)

    (setq minor-mode-alist

	  (cons '(mercury-minor-mode " Merc") minor-mode-alist)))

(defun mercury-minor-mode (arg)

  "Toggle the state of Mercury minor mode.

In this mode, some support is provided to facilitate the editing of

Mercury programs. A number of skeletons are provided to help defining

common syntactic structures. When inserting a template the functions

grap and maintin histories for types, modes and predicate names. Thus

when being prompted, completion is available as well as history

movements. The bindings are as follows:



  (interactive "P")

  (if arg

      (if (> (prefix-numeric-value arg) 0)



    (if mercury-minor-mode



(defun merc-activate-mercury-minor-mode ()

  (setq mercury-minor-mode t)

  ;; activate font-lock


  ;; activate menus

  (message "Mercury minor mode now active"))

(defun merc-deactivate-mercury-minor-mode ()

  (setq mercury-minor-mode nil)


  ;; undo effects of activation.

  (message "Mercury minor mode now inactive"))

;; Define a keymap for this minor mode

(defvar merc-keymap nil

  "Key map for Mercury minor mode")

;; create it at load time, but only if needed

(cond ((null merc-keymap)


       (setq merc-keymap (make-sparse-keymap))

       (define-key merc-keymap "\C-cmM" 'merc-module)

       (define-key merc-keymap "\C-cmm" 'merc-decl-mode)

       (define-key merc-keymap "\C-cmp" 'merc-decl-pred)

       (define-key merc-keymap "\C-cmd" 'merc-pred-descr)

       (define-key merc-keymap "\C-cmP" 'merc-decl-full-pred)

       (define-key merc-keymap "\C-cmi" 'merc-goto-implementation)

       (define-key merc-keymap "\C-cmI" 'merc-goto-interface)

       (define-key merc-keymap "\C-cmX" 'merc-extract-infered-decls)

       ;; put the keymap in the minor-mod-map-alist so it is

       ;; automagically made active/inactive by Emacs depending on

       ;; the value of merc-minor-mode

       (or (assq 'mercury-minor-mode minor-mode-map-alist)

	   (setq minor-mode-map-alist

		 (cons (cons 'mercury-minor-mode  merc-keymap)




(defvar merc-filename-regexp


  "regexp matching the file names for mercury files" )

(defun merc-maybe-minor()

  "Turn on mercury minor mode if the current file name matches

'merc-filename-regexp. To be used as prolog-mode-hook. Does nothing

if the file name cannot be determined."

  (if (and (buffer-filename (current-buffer))

	   (string-match merc-filename-regexp

		    (file-name-nondirectory (buffer-filename


      (mercury-minor-mode 1)))


;; 7) Providing a menu


;; Must be after setting up the keymap....




 "Menu for Mercury minor mode"

 '( "Mercury"

    ;;    "----"

    ["Module" merc-module t]

    ["Pred (full)" merc-decl-full-pred t]

    ["Predicate" merc-decl-pred t]

    ["Description" merc-pred-descr t]

    ["Modes" merc-decl-mode t]


    ["Implementation" merc-goto-implementation t]

    ["Interface" merc-goto-interface t]


    ["Get inferences" merc-extract-infered-decls t]))


(defun mercury-mode ()

  "mode Mercury"


  (prolog-iso-mode)			; (prolog-mode) may also work??

  (mercury-minor-mode 1))

(provide 'mercury)

;;; mercury.el ends here

More information about the users mailing list