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
features.
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
future.
Have fun....
D.
--
#### 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
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; 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)
(file-name-sans-extension
(file-name-nondirectory
(buffer-file-name)))
""))
'(goto-char (point-min))
":- module " str "." \n
"%% $Id" "$" \n
"%% Time-stamp: <>" \n \n
"%%-----------------------------------------------------------------" \n
"%% Purpose:" \n
"%% " _ \n
"%%-----------------------------------------------------------------" \n
":- interface."
\n
":- implementation." \n
\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"
(merc-read-predicate)
\n
"%%% ------------------------" \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"
(merc-read-predicate)
\n
"%%% ------------------------" \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"
(merc-read-predicate)
\n
"%%% ------------------------" \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"
(merc-read-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)))
,var))
;; 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*"))
"io__state,io__state")
((and type (equal type "*g*"))
"list(char),list(char)")
(t type))
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)
"io__state::di,io__state::uo")
((and type (equal type "*g*"))
(delete-char -5)
"list(char)::in,list(char)::out")
(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)
0)
'(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
(progn
(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
(progn
(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"
(interactive)
(save-excursion
(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))
items)))
(forward-line 1))
(merc-process-decls
(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)
"mode")))))))
)))
(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")
(progn
(if (looking-at "^:- mode")
t
(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)
(beginning-of-line)))
(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))
"\\<\\(implementation\\|pragma\\|interface\\|lambda\\|inst\\)\\>"
"\\<\\(string\\|int\\|float\\|list\\|char\\|in\\|out\\|di\\|uo\\|ui\\)\\>"
"\\(-->\\|:-\\|--->\\|->\\|::\\|;\\)"
))
(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)
(progn
(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
(progn
(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:
\\{merc-keymap}
"
(interactive "P")
(if arg
(if (> (prefix-numeric-value arg) 0)
(merc-activate-mercury-minor-mode)
(merc-deactivate-mercury-minor-mode))
(if mercury-minor-mode
(merc-deactivate-mercury-minor-mode)
(merc-activate-mercury-minor-mode))))
(defun merc-activate-mercury-minor-mode ()
(setq mercury-minor-mode t)
;; activate font-lock
(merc-f-l-on)
;; activate menus
(message "Mercury minor mode now active"))
(defun merc-deactivate-mercury-minor-mode ()
(setq mercury-minor-mode nil)
(merc-f-l-off)
;; 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)
minor-mode-map-alist)))
)
)
(defvar merc-filename-regexp
".*\\.m$"
"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
(current-buffer)))))
(mercury-minor-mode 1)))
;; 7) Providing a menu
;;--------------------
;; Must be after setting up the keymap....
(easy-menu-define
merc-menu
merc-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"
(interactive)
(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