[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 01265da: * externals-list: Convert sml-mode to :external
|
From: |
Stefan Monnier |
|
Subject: |
[elpa] master 01265da: * externals-list: Convert sml-mode to :external |
|
Date: |
Tue, 1 Dec 2020 10:01:49 -0500 (EST) |
branch: master
commit 01265daa55b297f8d90f0d82c546f6de51714467
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>
* externals-list: Convert sml-mode to :external
---
externals-list | 1 +
packages/sml-mode/README | 19 -
packages/sml-mode/TODO | 46 -
packages/sml-mode/mltags | 8 -
packages/sml-mode/sml-mode.el | 1858 ---------------------------------------
packages/sml-mode/sml-mode.spec | 67 --
packages/sml-mode/sml-mode.texi | 1143 ------------------------
packages/sml-mode/testcases.sml | 616 -------------
8 files changed, 1 insertion(+), 3757 deletions(-)
diff --git a/externals-list b/externals-list
index ed11a37..73a4a94 100644
--- a/externals-list
+++ b/externals-list
@@ -207,6 +207,7 @@
("slime-volleyball" :external nil)
("sm-c-mode" :external nil)
("smalltalk-mode" :external "git://git.sv.gnu.org/smalltalk")
+ ("sml-mode" :external nil)
("so-long" :core "lisp/so-long.el")
("soap-client" :core ("lisp/net/soap-client.el"
"lisp/net/soap-inspect.el"))
("sotlisp" :external
"https://github.com/Malabarba/speed-of-thought-lisp";)
diff --git a/packages/sml-mode/README b/packages/sml-mode/README
deleted file mode 100644
index 9632487..0000000
--- a/packages/sml-mode/README
+++ /dev/null
@@ -1,19 +0,0 @@
-SML-MODE is a major Emacs mode for editing Standard ML.
-It provides syntax highlighting and automatic indentation and
-comes with sml-proc which allows interaction with an inferior SML
-interactive loop.
-
-This release should work on any recent version of Emacs or XEmacs.
-If it doesn't: complain.
-
-Some more or less out of date documentation can be found in TeXinfo format.
-
-Check the INSTALL file for installation instructions.
-Check the NEWS file for a list of changes in this version.
-Check the BUGS and TODO file before sending me bug reports and requests for
-enhancements.
-
-Send any complaint/question/praise/ice-cream to me,
-
-
- Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/packages/sml-mode/TODO b/packages/sml-mode/TODO
deleted file mode 100644
index b9c7d34..0000000
--- a/packages/sml-mode/TODO
+++ /dev/null
@@ -1,46 +0,0 @@
-* file-name completion in sml-cm-mode.
-
-* Don't always jump to the *sml* buffer when you send a snippet of code.
-
-* Fix inferior-sml-mode's TAB completion of filenames so it doesn't append
- a space.
-
-* Improve support for MLton's def-use info (see http://mlton.org/Emacs)
-
-* Add an sml-mlb-mode for ML Basis files (see http://mlton.org/Emacs)
-
-* make `M-x sml-compile' more generic.
-
-* allow specifying indentation of dependent keywords (how to indent `in'
- relative to `let', for example).
-
-* recognize irrefutable patterns (with "Capital"-heuristics, for example:
- a regexp like "\\([(),]\\|[_a-z][_a-z0-9]*\\)+").
- This can then be used to allow indenting like
-
- (fn x =>
- some expressions)
-
-* take advantage of text after-the-line (when available) for indentation.
-
-* obey fixity directives.
-
-* dangling `case e' in stuff like
-
- fun myfunction x = case x
- of bla =>
- | bli =>
-
-* deal with CPS kind of code ???
-
- function1 (arg1, arg2, fn v1 =>
- function2 (arg2, fn v2 =>
- function3 (arg5, arg3, arg8, fn v3 =>
- function4 (v1, v2, v3))))
-
- or even just
-
- F.LET (v1, foo,
- F.LET (v2, bar,
- F.LET (v3, baz,
- F.RET [v1, v2, v3])))
diff --git a/packages/sml-mode/mltags b/packages/sml-mode/mltags
deleted file mode 100755
index 606fc4c..0000000
--- a/packages/sml-mode/mltags
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/bin/sh
-exec etags \
- --language=none \
- --regex='/[
\t]*\(exception\|datatype\|type\|val\|and\|fun\|structure\|signature\|functor\)
\([A-Za-z_0-9]+\)/\2/' \
- --regex='/[ \t]*[=|] \([A-Z_]+\)/\1/' \
- $*
-
-# --regex='/[ \t]*val [^:]+:[ \t]*\(.*\)/\1/' \
diff --git a/packages/sml-mode/sml-mode.el b/packages/sml-mode/sml-mode.el
deleted file mode 100644
index 172ffe5..0000000
--- a/packages/sml-mode/sml-mode.el
+++ /dev/null
@@ -1,1858 +0,0 @@
-;;; sml-mode.el --- Major mode for editing (Standard) ML -*- lexical-binding:
t; coding: utf-8 -*-
-
-;; Copyright (C) 1989-2020 Free Software Foundation, Inc.
-
-;; Maintainer: Stefan Monnier <monnier@iro.umontreal.ca>
-;; Version: 6.10
-;; Keywords: SML
-;; Author: Lars Bo Nielsen
-;; Olin Shivers
-;; Fritz Knabe (?)
-;; Steven Gilmore (?)
-;; Matthew Morley <mjm@scs.leeds.ac.uk>
-;; Matthias Blume <blume@cs.princeton.edu>
-;; (Stefan Monnier) <monnier@iro.umontreal.ca>
-;; Package-Requires: ((emacs "24.3") (cl-lib "0.5"))
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs 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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; A major mode to edit Standard ML (SML) code.
-;; Provides the following features, among others:
-;; - Indentation.
-;; - Syntax highlighting.
-;; - Prettified display of ->, =>, fn, ...
-;; - Imenu.
-;; - which-function-mode.
-;; - Skeletons/templates.
-;; - Electric pipe key.
-;; - outline-minor-mode (with some known problems).
-;; - Interaction with a read-eval-print loop.
-
-;;;; Known bugs:
-
-;; - Indentation after "functor toto() where type foo = bar ="
-;; Because the last is treated as an equality comparison.
-;; - indentation of a declaration after a long `datatype' can be slow.
-
-;;;; News:
-
-;;;;; Changes since 6.8:
-
-;; - new var sml-abbrev-skeletons to control whether to include skeletons
-;; in the main abbrev table.
-;; - change parsing rule of "local"
-
-;;;;; Changes since 5.0:
-
-;; - sml-electric-pipe-mode to make the | key electric.
-;; - Removal of a lot of compatibility code. Requires Emacs-24.
-;; - Integrate in GNU ELPA.
-
-;;;;; Changes since 4.1:
-
-;; - New indentation code using SMIE when available.
-;; - `sml-back-to-outer-indent' is now on S-tab (aka `backtab') rather
-;; than M-tab.
-;; - Support for electric-layout-mode and electric-indent-mode.
-;; - `sml-mark-defun' tries to be more clever.
-;; - A single file (sml-mode.el) is needed unless you want to use an
-;; interactive process like SML/NJ, or if your Emacs does not provide SMIE.
-
-;;;;; Changes since 4.0:
-
-;; - Switch to GPLv3+.
-;; - When possible (i.e. running under Emacs>=23), be case-sensitive when
-;; expanding abbreviations, and don't expand them in comments and strings.
-;; - When you `next-error' to a type error, highlight the actual parts of the
-;; types that differ.
-;; - Flush the recorded errors not only upon sml-compile and friends, but also
-;; when typing commands directly at the prompt.
-;; - New command sml-mlton-typecheck.
-;; - Simple support to parse errors and warnings in MLton's output.
-;; - Simple support for MLton's def-use files.
-
-;;;;; Changes since 3.9.5:
-
-;; - No need to add the dir to your load-path any more.
-;; The sml-mode-startup.el file does it for you.
-;; - Symbols like -> can be displayed as real arrows.
-;; See sml-font-lock-symbols.
-;; - Fix some incompatibilities with the upcoming Emacs-21.4.
-;; - Indentation rules improved. New customizable variable
-;; `sml-rightalign-and'. Also `sml-symbol-indent' is now customizable.
-
-;;;;; Changes since 3.9.3:
-
-;; - New add-log support (try C-x 4 a from within an SML function).
-;; - Imenu support
-;; - sml-bindings has disappeared.
-;; - The code skeletons are now abbrevs as well.
-;; - A new *sml* process is sent the content of sml-config-file
-;; (~/.sml-proc.sml) if it exists.
-;; - `sml-compile' works yet a bit differently. The command can begin
-;; with `cd "path";' and it will be replaced by OS.FileSys.chDir.
-;; - run-sml now pops up the new buffer. It can also run the command on
-;; another machine. And it always prompts for the command name.
-;; Use a prefix argument if you want to give args or to specify a host on
-;; which to run the command.
-;; - mouse-2 to yank in *sml* should work again (but won't work for next-error
-;; any more).
-;; - New major-modes sml-cm-mode, sml-lex-mode and sml-yacc-mode.
-;; - sml-load-hook has disappeared as has inferior-sml-load-hook.
-;; - sml-mode-startup.el is now automatically generated and you're supposed to
-;; `load' it from .emacs or site-start.el.
-;; - Minor bug fixes.
-
-;;; Code:
-
-(eval-when-compile (require 'cl-lib))
-(require 'smie nil 'noerror)
-(require 'electric)
-
-(defgroup sml ()
- "Editing SML code."
- :group 'languages)
-
-(defcustom sml-indent-level 4
- "Basic indentation step for SML code."
- :type 'integer)
-
-(defcustom sml-indent-args sml-indent-level
- "Indentation of args placed on a separate line."
- :type 'integer)
-
-(defcustom sml-rightalign-and t
- "If non-nil, right-align `and' with its leader.
-If nil: If t:
- datatype a = A datatype a = A
- and b = B and b = B"
- :type 'boolean)
-
-(defcustom sml-electric-pipe-mode t
- "If non-nil, automatically insert appropriate template when hitting |."
- :type 'boolean)
-
-(defvar sml-mode-hook nil
- "Run upon entering `sml-mode'.
-This is a good place to put your preferred key bindings.")
-
-;; font-lock setup
-
-(defvar sml-outline-regexp
- ;; `st' and `si' are to match structure and signature.
- " \\|s[ti]\\|[ \t]*\\(let[ \t]+\\)?\\(fun\\|and\\)\\_>"
- "Regexp matching a major heading.
-This actually can't work without extending `outline-minor-mode' with the
-notion of \"the end of an outline\".")
-
-;;
-;; Internal defines
-;;
-
-(defvar sml-mode-map
- (let ((map (make-sparse-keymap)))
- ;; Text-formatting commands:
- (define-key map "\C-c\C-m" 'sml-insert-form)
- (define-key map "\M-|" 'sml-electric-pipe)
- (define-key map "\M-\ " 'sml-electric-space)
- (define-key map [backtab] 'sml-back-to-outer-indent)
- ;; The standard binding is C-c C-z, but we add this one for compatibility.
- (define-key map "\C-c\C-s" 'sml-prog-proc-switch-to)
- map)
- "The keymap used in `sml-mode'.")
-
-(defvar sml-mode-syntax-table
- (let ((st (make-syntax-table)))
- (modify-syntax-entry ?\* ". 23n" st)
- (modify-syntax-entry ?\( "()1" st)
- (modify-syntax-entry ?\) ")(4" st)
- (mapc (lambda (c) (modify-syntax-entry c "_" st)) "._'")
- (mapc (lambda (c) (modify-syntax-entry c "." st)) ",;")
- ;; `!' is not really a prefix-char, oh well!
- (mapc (lambda (c) (modify-syntax-entry c "'" st)) "~#!")
- (mapc (lambda (c) (modify-syntax-entry c "." st)) "%&$+-/:<=>?@`^|")
- st)
- "The syntax table used in `sml-mode'.")
-
-
-(easy-menu-define sml-mode-menu sml-mode-map "Menu used in `sml-mode'."
- '("SML"
- ("Process"
- ["Start SML repl" sml-run t]
- ["-" nil nil]
- ["Compile the project" sml-prog-proc-compile t]
- ["Send file" sml-prog-proc-load-file t]
- ["Switch to SML repl" sml-prog-proc-switch-to t]
- ["--" nil nil]
- ["Send buffer" sml-prog-proc-send-buffer t]
- ["Send region" sml-prog-proc-send-region t]
- ["Send function" sml-send-function t]
- ["Goto next error" next-error t])
- ["Insert SML form" sml-insert-form t]
- ("Forms" :filter sml-forms-menu)
- ["Indent region" indent-region t]
- ["Outdent line" sml-back-to-outer-indent t]
- ["-----" nil nil]
- ["Customize SML-mode" (customize-group 'sml) t]
- ["SML mode help" describe-mode t]))
-
-;;
-;; Regexps
-;;
-
-(defun sml-syms-re (syms)
- (concat "\\_<" (regexp-opt syms t) "\\_>"))
-
-;;
-
-(defconst sml-module-head-syms
- '("signature" "structure" "functor" "abstraction"))
-
-
-(defconst sml-=-starter-syms
- `("|" "val" "fun" "and" "datatype" "type" "abstype" "eqtype"
- . ,sml-module-head-syms)
- "Symbols that can be followed by a `='.")
-(defconst sml-=-starter-re
- (concat "\\S.|\\S.\\|" (sml-syms-re (cdr sml-=-starter-syms)))
- "Symbols that can be followed by a `='.")
-
-(defconst sml-non-nested-of-starter-re
- (sml-syms-re '("datatype" "abstype" "exception"))
- "Symbols that can introduce an `of' that shouldn't behave like a paren.")
-
-(defconst sml-starters-syms
- (append sml-module-head-syms
- '("abstype" "datatype" "exception" "fun"
- "local" "infix" "infixr" "sharing" "nonfix"
- "open" "type" "val" "and"
- "withtype" "with"))
- "The starters of new expressions.")
-
-(defconst sml-pipeheads
- '("|" "of" "fun" "fn" "and" "handle" "datatype" "abstype"
- "(" "{" "[")
- "A `|' corresponds to one of these.")
-
-(defconst sml-keywords-regexp
- (sml-syms-re '("abstraction" "abstype" "and" "andalso" "as" "before" "case"
- "datatype" "else" "end" "eqtype" "exception" "do" "fn"
- "fun" "functor" "handle" "if" "in" "include" "infix"
- "infixr" "let" "local" "nonfix" "o" "of" "op" "open" "orelse"
- "overload" "raise" "rec" "sharing" "sig" "signature"
- "struct" "structure" "then" "type" "val" "where" "while"
- "with" "withtype"))
- "A regexp that matches any and all keywords of SML.")
-
-(eval-and-compile
- (defconst sml-id-re "\\sw\\(?:\\sw\\|\\s_\\)*"))
-
-(defconst sml-tyvarseq-re
- (concat "\\(?:\\(?:'+" sml-id-re "\\|(\\(?:[,' \t\n]+" sml-id-re
- "\\)+)\\)\\s-+\\)?"))
-
-;;; Font-lock settings ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defcustom sml-font-lock-symbols nil
- "Display \\ and -> and such using symbols in fonts.
-This may sound like a neat trick, but be extra careful: it changes the
-alignment and can thus lead to nasty surprises w.r.t layout."
- :type 'boolean)
-(if (fboundp 'prettify-symbols-mode)
- (make-obsolete-variable 'sml-font-lock-symbols
- 'prettify-symbols-mode "24.4"))
-
-(defconst sml-font-lock-symbols-alist
- '(("fn" . ?λ)
- ("andalso" . ?∧) ;; ?⋀
- ("orelse" . ?∨) ;; ?⋁
- ;; ("as" . ?≡)
- ("not" . ?¬)
- ("div" . ?÷)
- ("*" . ?×)
- ("o" . ?○)
- ("->" . ?→)
- ("=>" . ?⇒)
- ("<-" . ?←)
- ("<>" . ?≠)
- (">=" . ?≥)
- ("<=" . ?≤)
- ("..." . ?⋯)
- ;; ("::" . ?∷)
- ;; Some greek letters for type parameters.
- ("'a" . ?α)
- ("'b" . ?β)
- ("'c" . ?γ)
- ("'d" . ?δ)
- ))
-
-(defun sml-font-lock-compose-symbol ()
- "Compose a sequence of ascii chars into a symbol.
-Regexp match data 0 points to the chars."
- ;; Check that the chars should really be composed into a symbol.
- (let* ((start (match-beginning 0))
- (end (match-end 0))
- (syntaxes (if (memq (char-syntax (char-after start)) '(?w ?_))
- '(?w ?_) '(?. ?\\))))
- (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
- (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
- (memq (get-text-property start 'face)
- '(font-lock-doc-face font-lock-string-face
- font-lock-comment-face)))
- ;; No composition for you. Let's actually remove any composition
- ;; we may have added earlier and which is now incorrect.
- (remove-text-properties start end '(composition))
- ;; That's a symbol alright, so add the composition.
- (compose-region start end (cdr (assoc (match-string 0)
- sml-font-lock-symbols-alist)))))
- ;; Return nil because we're not adding any face property.
- nil)
-
-(defun sml-font-lock-symbols-keywords ()
- (when sml-font-lock-symbols
- `((,(regexp-opt (mapcar 'car sml-font-lock-symbols-alist) t)
- (0 (sml-font-lock-compose-symbol))))))
-
-;; The font lock regular expressions.
-
-(defconst sml-font-lock-keywords
- `(;;(sml-font-comments-and-strings)
- (,(concat "\\_<\\(fun\\|and\\)\\s-+" sml-tyvarseq-re
- "\\(" sml-id-re "\\)\\s-+[^ \t\n=]")
- (1 font-lock-keyword-face)
- (2 font-lock-function-name-face))
- (,(concat "\\_<\\(\\(?:data\\|abs\\|with\\|eq\\)?type\\)\\s-+"
- sml-tyvarseq-re "\\(" sml-id-re "\\)")
- (1 font-lock-keyword-face)
- (2 font-lock-type-def-face))
- (,(concat "\\_<\\(val\\)\\s-+\\(?:" sml-id-re "\\_>\\s-*\\)?\\("
- sml-id-re "\\)\\s-*[=:]")
- (1 font-lock-keyword-face)
- (2 font-lock-variable-name-face))
- (,(concat "\\_<\\(structure\\|functor\\|abstraction\\)\\s-+\\("
- sml-id-re "\\)")
- (1 font-lock-keyword-face)
- (2 font-lock-module-def-face))
- (,(concat "\\_<\\(signature\\)\\s-+\\(" sml-id-re "\\)")
- (1 font-lock-keyword-face)
- (2 font-lock-interface-def-face))
-
- (,sml-keywords-regexp . font-lock-keyword-face)
- ,@(sml-font-lock-symbols-keywords))
- "Regexps matching standard SML keywords.")
-
-(defface font-lock-type-def-face
- '((t (:bold t)))
- "Font Lock mode face used to highlight type definitions."
- :group 'font-lock-highlighting-faces)
-(defvar font-lock-type-def-face 'font-lock-type-def-face
- "Face name to use for type definitions.")
-
-(defface font-lock-module-def-face
- '((t (:bold t)))
- "Font Lock mode face used to highlight module definitions."
- :group 'font-lock-highlighting-faces)
-(defvar font-lock-module-def-face 'font-lock-module-def-face
- "Face name to use for module definitions.")
-
-(defface font-lock-interface-def-face
- '((t (:bold t)))
- "Font Lock mode face used to highlight interface definitions."
- :group 'font-lock-highlighting-faces)
-(defvar font-lock-interface-def-face 'font-lock-interface-def-face
- "Face name to use for interface definitions.")
-
-;;
-;; Code to handle nested comments and unusual string escape sequences
-;;
-
-(defvar sml-syntax-prop-table
- (let ((st (make-syntax-table)))
- (modify-syntax-entry ?\\ "." st)
- (modify-syntax-entry ?* "." st)
- st)
- "Syntax table for text-properties.")
-
-(defconst sml-font-lock-syntactic-keywords
- `(("^\\s-*\\(\\\\\\)" (1 ',sml-syntax-prop-table))))
-
-(defconst sml-font-lock-defaults
- '(sml-font-lock-keywords nil nil nil nil
- (font-lock-syntactic-keywords . sml-font-lock-syntactic-keywords)))
-
-
-;;; Indentation with SMIE
-
-(defconst sml-smie-grammar
- ;; We have several problem areas where SML's syntax can't be handled by an
- ;; operator precedence grammar:
- ;;
- ;; "= A before B" is "= A) before B" if this is the
- ;; `boolean-=' but it is "= (A before B)" if it's the `definitional-='.
- ;; We can work around the problem by tweaking the lexer to return two
- ;; different tokens for the two different kinds of `='.
- ;; "of A | B" in a "case" we want "of (A | B, but in a `datatype'
- ;; we want "of A) | B".
- ;; "= A | B" can be "= A ) | B" if the = is from a "fun" definition,
- ;; but it is "= (A | B" if it is a `datatype' definition (of course, if
- ;; the previous token introducing the = is `and', deciding whether
- ;; it's a datatype or a function requires looking even further back).
- ;; "functor foo (...) where type a = b = ..." the first `=' looks very much
- ;; like a `definitional-=' even tho it's just an equality constraint.
- ;; Currently I don't even try to handle `where' at all.
- (smie-prec2->grammar
- (smie-merge-prec2s
- (smie-bnf->prec2
- '((exp ("if" exp "then" exp "else" exp)
- ("case" exp "of" branches)
- ("let" decls "in" cmds "end")
- ("struct" decls "end")
- ("sig" decls "end")
- (sexp)
- (sexp "handle" branches)
- ("fn" sexp "=>" exp))
- ;; "simple exp"s are the ones that can appear to the left of `handle'.
- (sexp (sexp ":" type) ("(" exps ")")
- (sexp "orelse" sexp)
- (marg ":>" type)
- (sexp "andalso" sexp))
- (cmds (cmds ";" cmds) (exp))
- (exps (exps "," exps) (exp)) ; (exps ";" exps)
- (branches (sexp "=>" exp) (branches "|" branches))
- ;; Operator precedence grammars handle separators much better then
- ;; starters/terminators, so let's pretend that let/fun are separators.
- (decls (sexp "d=" exp)
- (sexp "d=" databranches)
- (funbranches "|" funbranches)
- (sexp "=of" type) ;After "exception".
- ;; FIXME: Just like PROCEDURE in Pascal and Modula-2, this
- ;; interacts poorly with the other constructs since I
- ;; can't make "local" a separator like fun/val/type/...
- ("local" decls "in" decls "end")
- ;; (decls "local" decls "in" decls "end")
- (decls "functor" decls)
- (decls "signature" decls)
- (decls "structure" decls)
- (decls "type" decls)
- (decls "open" decls)
- (decls "and" decls)
- (decls "withtype" decls)
- (decls "infix" decls)
- (decls "infixr" decls)
- (decls "nonfix" decls)
- (decls "abstype" decls)
- (decls "datatype" decls)
- (decls "include" decls)
- (decls "sharing" decls)
- (decls "exception" decls)
- (decls "fun" decls)
- (decls "val" decls))
- (type (type "->" type)
- (type "*" type))
- (funbranches (sexp "d=" exp))
- (databranches (sexp "=of" type) (databranches "d|" databranches))
- ;; Module language.
- ;; (mexp ("functor" marg "d=" mexp)
- ;; ("structure" marg "d=" mexp)
- ;; ("signature" marg "d=" mexp))
- (marg (marg ":" type) (marg ":>" type))
- (toplevel (decls) (exp) (toplevel ";" toplevel)))
- ;; '(("local" . opener))
- ;; '((nonassoc "else") (right "handle"))
- '((nonassoc "of") (assoc "|")) ; "case a of b => case c of d => e | f"
- '((nonassoc "handle") (assoc "|")) ; Idem for "handle".
- '((assoc "->") (assoc "*"))
- '((assoc "val" "fun" "type" "datatype" "abstype" "open" "infix" "infixr"
- "nonfix" "functor" "signature" "structure" "exception"
- "include" "sharing" "local")
- (assoc "withtype")
- (assoc "and"))
- '((assoc "orelse") (assoc "andalso") (nonassoc ":"))
- '((assoc ";")) '((assoc ",")) '((assoc "d|")))
-
- (smie-precs->prec2
- '((nonassoc "andalso") ;To anchor the prec-table.
- (assoc "before") ;0
- (assoc ":=" "o") ;3
- (nonassoc ">" ">=" "<>" "<" "<=" "=") ;4
- (assoc "::" "@") ;5
- (assoc "+" "-" "^") ;6
- (assoc "/" "*" "quot" "rem" "div" "mod") ;7
- (nonassoc " -dummy- "))) ;Bogus anchor at the end.
- )))
-
-(defvar sml-indent-separator-outdent 2)
-
-(defun sml--rightalign-and-p ()
- (when sml-rightalign-and
- ;; Only right-align the "and" if the intervening code is more deeply
- ;; indented, to avoid things like:
- ;; datatype foo
- ;; = Foo of int
- ;; and bar = Bar of string
- (save-excursion
- (let ((max (line-end-position 0))
- (_data (smie-backward-sexp "and"))
- (startcol (save-excursion
- (forward-comment (- (point)))
- (current-column)))
- (mincol (current-column)))
- (save-excursion
- (search-forward "=" max t)
- (forward-line 1)
- (if (< (point) max) (setq max (point))))
- (while (and (<= (point) max) (not (eobp)))
- (skip-chars-forward " \t")
- (setq mincol (current-column))
- (forward-line 1))
- (>= mincol startcol)))))
-
-(defun sml-smie-rules (kind token)
- (pcase (cons kind token)
- (`(:elem . basic) sml-indent-level)
- (`(:elem . args) sml-indent-args)
- (`(:list-intro . "fn") t)
- (`(:close-all . ,_) t)
- (`(:after . "struct") 0)
- (`(:after . "=>") (if (smie-rule-hanging-p) 0 2))
- (`(:after . "in") (if (smie-rule-parent-p "local") 0))
- (`(:after . "of") 3)
- (`(:after . ,(or `"(" `"{" `"[")) (if (not (smie-rule-hanging-p)) 2))
- (`(:after . "else") (if (smie-rule-hanging-p) 0)) ;; (:next "if" 0)
- (`(:after . ,(or `"|" `"d|" `";" `",")) (smie-rule-separator kind))
- (`(:after . "d=")
- (if (and (smie-rule-parent-p "val") (smie-rule-next-p "fn")) -3))
- (`(:before . "=>") (if (smie-rule-parent-p "fn") 3))
- (`(:before . "of") 1)
- ;; FIXME: pcase in Emacs<24.4 bumps into a bug if we do this:
- ;;(`(:before . ,(and `"|" (guard (smie-rule-prev-p "of")))) 1)
- (`(:before . "|") (if (smie-rule-prev-p "of") 1 (smie-rule-separator
kind)))
- (`(:before . ,(or `"|" `"d|" `";" `",")) (smie-rule-separator kind))
- ;; Treat purely syntactic block-constructs as being part of their parent,
- ;; when the opening statement is hanging.
- (`(:before . ,(or `"let" `"(" `"[" `"{")) ; "struct"? "sig"?
- (if (smie-rule-hanging-p) (smie-rule-parent)))
- ;; Treat if ... else if ... as a single long syntactic construct.
- ;; Similarly, treat fn a => fn b => ... as a single construct.
- (`(:before . ,(or `"if" `"fn"))
- (and (not (smie-rule-bolp))
- (smie-rule-prev-p (if (equal token "if") "else" "=>"))
- (smie-rule-parent)))
- (`(:before . "and")
- ;; FIXME: maybe "and" (c|sh)ould be handled as an smie-separator.
- (cond
- ((smie-rule-parent-p "datatype" "withtype")
- (if (sml--rightalign-and-p) 5 0))
- ((smie-rule-parent-p "fun" "val") 0)))
- (`(:before . "withtype") 0)
- (`(:before . "d=")
- (cond
- ((smie-rule-parent-p "datatype") (if (smie-rule-bolp) 2))
- ((smie-rule-parent-p "structure" "signature" "functor") 0)))
- ))
-
-(defun sml-smie-definitional-equal-p ()
- "Figure out which kind of \"=\" this is.
-Assumes point is right before the = sign."
- ;; The idea is to look backward for the first occurrence of a token that
- ;; requires a definitional "=" and then see if there's such a definitional
- ;; equal between that token and ourselves (in which case we're not
- ;; a definitional = ourselves).
- ;; The "search for =" is naive and will match "=>" and "<=", but it turns
- ;; out to be OK in practice because such tokens very rarely (if ever) appear
- ;; between the =-starter and the corresponding definitional equal.
- ;; One known problem case is code like:
- ;; "functor foo (structure s : S) where type t = s.t ="
- ;; where the "type t = s.t" is mistaken for a type definition.
- (save-excursion
- (let ((res (smie-backward-sexp "=")))
- (member (nth 2 res) `(":" ":>" ,@sml-=-starter-syms)))))
-
-(defun sml-smie-non-nested-of-p ()
- ;; FIXME: Maybe datatype-|-p makes this nested-of business unnecessary.
- "Figure out which kind of \"of\" this is.
-Assumes point is right before the \"of\" symbol."
- (save-excursion
- ;; (let ((case-fold-search nil))
- ;; (and (re-search-backward (concat "\\(" sml-non-nested-of-starter-re
- ;; "\\)\\|\\_<case\\_>")
- ;; nil t)
- ;; (match-beginning 1)))
- (and (stringp (sml-smie-backward-token-1))
- (let ((tok (sml-smie-backward-token-1)))
- (if (equal tok "=")
- (equal "d=" (sml-smie-forward-token))
- (member tok '("|" "exception")))))))
-
-(defun sml-smie-datatype-|-p ()
- "Figure out which kind of \"|\" this is.
-Assumes point is right before the | symbol."
- (save-excursion
- (forward-char 1) ;Skip the |.
- (let ((after-type-def
- '("|" "of" "in" "datatype" "and" "exception" "abstype" "infix"
- "infixr" "nonfix" "local" "val" "fun" "structure" "functor"
- "signature")))
- (or (member (sml-smie-forward-token-1) after-type-def) ;Skip the tag.
- (member (sml-smie-forward-token-1) after-type-def)))))
-
-(defun sml-smie-forward-token-1 ()
- (forward-comment (point-max))
- (buffer-substring-no-properties
- (point)
- (progn
- (or (/= 0 (skip-syntax-forward "'w_"))
- (skip-syntax-forward ".'"))
- (point))))
-
-;; "local...end" acts as a kind of parentheses, but it *also* terminates
-;; any preceding declaration: SMIE doesn't really know how to handle such
-;; a token correctly. In the past we solved this problem in the
-;; `sml-smie-rules' with an ad-hoc indentation rule for `local', but instead
-;; we now just emit two tokens ("val" and "local") when we encounter
-;; a "local" keyword.
-(defvar-local sml-smie--pending-token nil
- "Tokens already parsed but not yet emitted.
-Used when several tokens should be emitted at the same buffer position.
-Takes the form (DIR POS . TOKENS).")
-
-(defun sml-smie-forward-token ()
- (or
- (when sml-smie--pending-token
- (if (and (eq 'forward (car sml-smie--pending-token))
- (eql (point) (nth 1 sml-smie--pending-token))
- (nthcdr 2 sml-smie--pending-token))
- (pop (nthcdr 2 sml-smie--pending-token))
- (setq sml-smie--pending-token nil)))
- (let ((sym (sml-smie-forward-token-1)))
- (cond
- ((equal "op" sym)
- (concat "op " (sml-smie-forward-token-1)))
- ((member sym '("|" "of" "="))
- ;; The important lexer for indentation's performance is the backward
- ;; lexer, so for the forward lexer we delegate to the backward one.
- (save-excursion (sml-smie-backward-token)))
- ((string= sym "local")
- (setq sml-smie--pending-token `(forward ,(point) ,sym))
- "val")
- (t sym)))))
-
-(defun sml-smie-backward-token-1 ()
- (forward-comment (- (point)))
- (buffer-substring-no-properties
- (point)
- (progn
- (or (/= 0 (skip-syntax-backward ".'"))
- (skip-syntax-backward "'w_"))
- (point))))
-
-(defun sml-smie-backward-token ()
- (or
- (when sml-smie--pending-token
- (if (and (eq 'backward (car sml-smie--pending-token))
- (eql (point) (nth 1 sml-smie--pending-token))
- (nthcdr 2 sml-smie--pending-token))
- (pop (nthcdr 2 sml-smie--pending-token))
- (setq sml-smie--pending-token nil)))
- (let ((sym (sml-smie-backward-token-1)))
- (unless (zerop (length sym))
- ;; FIXME: what should we do if `sym' = "op" ?
- (let ((point (point)))
- (if (equal "op" (sml-smie-backward-token-1))
- (concat "op " sym)
- (goto-char point)
- (cond
- ((string= sym "=") (if (sml-smie-definitional-equal-p) "d=" "="))
- ((string= sym "of") (if (sml-smie-non-nested-of-p) "=of" "of"))
- ((string= sym "|") (if (sml-smie-datatype-|-p) "d|" "|"))
- ((string= sym "local")
- (setq sml-smie--pending-token `(backward ,(point) "val"))
- sym)
- (t sym))))))))
-
-;;;;
-;;;; Imenu support
-;;;;
-
-(defconst sml-imenu-regexp
- (concat "^[ \t]*\\(let[ \t]+\\)?"
- (regexp-opt (append sml-module-head-syms
- '("and" "fun" "datatype" "abstype" "type")) t)
- "\\_>"))
-
-(defun sml-imenu-create-index ()
- (let (alist)
- (goto-char (point-max))
- (while (re-search-backward sml-imenu-regexp nil t)
- (save-excursion
- (let ((kind (match-string 2))
- (column (progn (goto-char (match-beginning 2)) (current-column)))
- (location
- (progn (goto-char (match-end 0))
- (forward-comment (point-max))
- (when (looking-at sml-tyvarseq-re)
- (goto-char (match-end 0)))
- (point)))
- (name (sml-smie-forward-token)))
- ;; Eliminate trivial renamings.
- (when (or (not (member kind '("structure" "signature")))
- (when (search-forward "=" nil t)
- (forward-comment (point-max))
- (looking-at "sig\\|struct")))
- (push (cons (concat (make-string (/ column 2) ?\ ) name) location)
- alist)))))
- alist))
-
-;;; Generic prog-proc interaction.
-
-(require 'comint)
-(require 'compile)
-
-(defvar sml-prog-proc-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [?\C-c ?\C-l] 'sml-prog-proc-load-file)
- (define-key map [?\C-c ?\C-c] 'sml-prog-proc-compile)
- (define-key map [?\C-c ?\C-z] 'sml-prog-proc-switch-to)
- (define-key map [?\C-c ?\C-r] 'sml-prog-proc-send-region)
- (define-key map [?\C-c ?\C-b] 'sml-prog-proc-send-buffer)
- ;; FIXME: Add
- ;; (define-key map [?\M-C-x] 'sml-prog-proc-send-defun)
- ;; (define-key map [?\C-x ?\C-e] 'sml-prog-proc-send-last-sexp)
- ;; FIXME: Add menu. Now, that's trickier because keymap inheritance
- ;; doesn't play nicely with menus!
- map)
- "Keymap for `sml-prog-proc-mode'.")
-
-(defvar-local sml-prog-proc--buffer nil
- "The inferior-process buffer to which to send code.")
-
-(cl-defstruct (sml-prog-proc-descriptor
- (:constructor sml-prog-proc-make)
- (:predicate nil)
- (:copier nil))
- (name nil :read-only t)
- (run nil :read-only t)
- (load-cmd nil :read-only t)
- (chdir-cmd nil :read-only t)
- (command-eol "\n" :read-only t)
- (compile-commands-alist nil :read-only t))
-
-(defvar sml-prog-proc-descriptor nil
- "Struct containing the various functions to create a new process, ...")
-
-(defmacro sml-prog-proc--prop (prop)
- `(,(intern (format "sml-prog-proc-descriptor-%s" prop))
- (or sml-prog-proc-descriptor
- ;; FIXME: Look for available ones and pick one.
- (error "Not a `sml-prog-proc' buffer"))))
-(defmacro sml-prog-proc--call (method &rest args)
- `(funcall (sml-prog-proc--prop ,method) ,@args))
-
-;; The inferior process and his buffer are basically interchangeable.
-;; Currently the code takes sml-prog-proc--buffer as the main reference,
-;; but all users should either use sml-prog-proc-proc or sml-prog-proc-buffer
-;; to find the info.
-
-(defun sml-prog-proc-proc ()
- "Return the inferior process for the code in current buffer."
- (or (and (buffer-live-p sml-prog-proc--buffer)
- (get-buffer-process sml-prog-proc--buffer))
- (when (derived-mode-p 'sml-prog-proc-mode 'sml-prog-proc-comint-mode)
- (setq sml-prog-proc--buffer (current-buffer))
- (get-buffer-process sml-prog-proc--buffer))
- (let ((ppd sml-prog-proc-descriptor)
- (buf (sml-prog-proc--call run)))
- (with-current-buffer buf
- (if (and ppd (null sml-prog-proc-descriptor))
- (setq-local sml-prog-proc-descriptor ppd)))
- (setq sml-prog-proc--buffer buf)
- (get-buffer-process sml-prog-proc--buffer))))
-
-(defun sml-prog-proc-buffer ()
- "Return the buffer of the inferior process."
- (process-buffer (sml-prog-proc-proc)))
-
-(defun sml-prog-proc-switch-to ()
- "Switch to the buffer running the read-eval-print process."
- (interactive)
- (pop-to-buffer (sml-prog-proc-buffer)))
-
-(defun sml-prog-proc-send-string (proc str)
- "Send command STR to PROC, with an EOL terminator appended."
- (with-current-buffer (process-buffer proc)
- ;; FIXME: comint-send-string does not pass the string through
- ;; comint-input-filter-function, so we have to do it by hand.
- ;; Maybe we should insert the command into the buffer and then call
- ;; comint-send-input?
- (sml-prog-proc-comint-input-filter-function nil)
- (save-excursion (goto-char (process-mark proc))
- (unless (bolp) (insert "\n"))
- (set-marker (process-mark proc) (point)))
- (comint-send-string proc (concat str (sml-prog-proc--prop command-eol)))))
-
-(defun sml-prog-proc-load-file (file &optional and-go)
- "Load FILE into the read-eval-print process.
-FILE is the file visited by the current buffer.
-If prefix argument AND-GO is used, then we additionally switch
-to the buffer where the process is running."
- (interactive
- (list (or buffer-file-name
- (read-file-name "File to load: " nil nil t))
- current-prefix-arg))
- (comint-check-source file)
- (let ((proc (sml-prog-proc-proc)))
- (sml-prog-proc-send-string proc (sml-prog-proc--call load-cmd file))
- (when and-go (pop-to-buffer (process-buffer proc)))))
-
-(defvar sml-prog-proc--tmp-file nil)
-
-(defun sml-prog-proc-send-region (start end &optional and-go)
- "Send the content of the region to the read-eval-print process.
-START..END delimit the region; AND-GO if non-nil indicate to additionally
-switch to the process's buffer."
- (interactive "r\nP")
- (if (> start end) (let ((tmp end)) (setq end start) (setq start tmp))
- (if (= start end) (error "Nothing to send: the region is empty")))
- (let ((proc (sml-prog-proc-proc))
- (tmp (make-temp-file "emacs-region")))
- (write-region start end tmp nil 'silently)
- (when sml-prog-proc--tmp-file
- (ignore-errors (delete-file (car sml-prog-proc--tmp-file)))
- (set-marker (cdr sml-prog-proc--tmp-file) nil))
- (setq sml-prog-proc--tmp-file (cons tmp (copy-marker start)))
- (sml-prog-proc-send-string proc (sml-prog-proc--call load-cmd tmp))
- (when and-go (pop-to-buffer (process-buffer proc)))))
-
-(defun sml-prog-proc-send-buffer (&optional and-go)
- "Send the content of the current buffer to the read-eval-print process.
-AND-GO if non-nil indicate to additionally switch to the process's buffer."
- (interactive "P")
- (sml-prog-proc-send-region (point-min) (point-max) and-go))
-
-(define-derived-mode sml-prog-proc-mode prog-mode "Sml-Prog-Proc"
- "Major mode for editing source code and interact with an interactive loop."
- )
-
-;;; Extended comint-mode for Sml-Prog-Proc.
-
-(defun sml-prog-proc-chdir (dir)
- "Change the working directory of the inferior process to DIR."
- (interactive "DChange to directory: ")
- (let ((dir (expand-file-name dir))
- (proc (sml-prog-proc-proc)))
- (with-current-buffer (process-buffer proc)
- (sml-prog-proc-send-string proc (sml-prog-proc--call chdir-cmd dir))
- (setq default-directory (file-name-as-directory dir)))))
-
-(defun sml-prog-proc-comint-input-filter-function (str)
- ;; `compile.el' doesn't know that file location info from errors should be
- ;; recomputed afresh (without using stale info from earlier compilations).
- (compilation-forget-errors) ;Has to run before compilation-fake-loc.
- (if (and sml-prog-proc--tmp-file (marker-buffer (cdr
sml-prog-proc--tmp-file)))
- (compilation-fake-loc (cdr sml-prog-proc--tmp-file)
- (car sml-prog-proc--tmp-file)))
- str)
-
-(defvar sml-prog-proc-comint-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-l" 'sml-prog-proc-load-file)
- map))
-
-(define-derived-mode sml-prog-proc-comint-mode comint-mode
"Sml-Prog-Proc-Comint"
- "Major mode for an inferior process used to run&compile source code."
- ;; Enable compilation-minor-mode, but only after the child mode is setup
- ;; since the child-mode might want to add rules to
- ;; compilation-error-regexp-alist.
- (add-hook 'after-change-major-mode-hook #'compilation-minor-mode nil t)
- ;; The keymap of compilation-minor-mode is too unbearable, so we
- ;; need to hide most of the bindings.
- (let ((map (make-sparse-keymap)))
- (dolist (keys '([menu-bar] [follow-link]))
- ;; Preserve some of the bindings.
- (define-key map keys (lookup-key compilation-minor-mode-map keys)))
- (add-to-list 'minor-mode-overriding-map-alist
- (cons 'compilation-minor-mode map)))
-
- (add-hook 'comint-input-filter-functions
- #'sml-prog-proc-comint-input-filter-function nil t))
-
-(defvar sml-prog-proc--compile-command nil
- "The command used by default by `sml-prog-proc-compile'.")
-
-(defun sml-prog-proc-compile (command &optional and-go)
- "Pass COMMAND to the read-eval-loop process to compile the current file.
-
-You can then use the command \\[next-error] to find the next error message
-and move to the source code that caused it.
-
-Interactively, prompts for the command if `compilation-read-command' is
-non-nil. With prefix arg, always prompts.
-
-Prefix arg AND-GO also means to switch to the read-eval-loop buffer
afterwards."
- (interactive
- (let* ((dir default-directory)
- (cmd "cd \"."))
- ;; Look for files to determine the default command.
- (while (and (stringp dir)
- (progn
- (cl-dolist (cf (sml-prog-proc--prop compile-commands-alist))
- (when (file-exists-p (expand-file-name (cdr cf) dir))
- (setq cmd (concat cmd "\"; " (car cf)))
- (cl-return nil)))
- (not cmd)))
- (let ((newdir (file-name-directory (directory-file-name dir))))
- (setq dir (unless (equal newdir dir) newdir))
- (setq cmd (concat cmd "/.."))))
- (setq cmd
- (cond
- ((local-variable-p 'sml-prog-proc--compile-command)
- sml-prog-proc--compile-command)
- ((string-match "^\\s-*cd\\s-+\"\\.\"\\s-*;\\s-*" cmd)
- (substring cmd (match-end 0)))
- ((string-match "^\\s-*cd\\s-+\"\\(\\./\\)" cmd)
- (replace-match "" t t cmd 1))
- ((string-match ";" cmd) cmd)
- (t sml-prog-proc--compile-command)))
- ;; code taken from compile.el
- (list (if (or compilation-read-command current-prefix-arg)
- (read-from-minibuffer "Compile command: "
- cmd nil nil '(compile-history . 1))
- cmd))))
- ;; ;; now look for command's file to determine the directory
- ;; (setq dir default-directory)
- ;; (while (and (stringp dir)
- ;; (cl-dolist (cf (sml-prog-proc--prop compile-commands-alist)
t)
- ;; (when (and (equal cmd (car cf))
- ;; (file-exists-p (expand-file-name (cdr cf)
dir)))
- ;; (cl-return nil))))
- ;; (let ((newdir (file-name-directory (directory-file-name dir))))
- ;; (setq dir (unless (equal newdir dir) newdir))))
- ;; (setq dir (or dir default-directory))
- ;; (list cmd dir)))
- (setq-local sml-prog-proc--compile-command command)
- (save-some-buffers (not compilation-ask-about-save) nil)
- (let ((dir default-directory))
- (when (string-match "^\\s-*cd\\s-+\"\\([^\"]+\\)\"\\s-*;" command)
- (setq dir (match-string 1 command))
- (setq command (replace-match "" t t command)))
- (setq dir (expand-file-name dir))
- (let ((proc (sml-prog-proc-proc))
- (eol (sml-prog-proc--prop command-eol)))
- (with-current-buffer (process-buffer proc)
- (setq default-directory dir)
- (sml-prog-proc-send-string
- proc (concat (sml-prog-proc--call chdir-cmd dir)
- ;; Strip the newline, to avoid adding a prompt.
- (if (string-match "\n\\'" eol)
- (replace-match " " t t eol) eol)
- command))
- (when and-go (pop-to-buffer (process-buffer proc)))))))
-
-
-;;; SML Sml-Prog-Proc support.
-
-(defcustom sml-program-name "sml"
- "Program to run as Standard SML read-eval-print loop."
- :type 'string)
-
-(defcustom sml-default-arg ""
- "Default command line option to pass to `sml-program-name', if any."
- :type 'string)
-
-(defcustom sml-host-name ""
- "Host on which to run `sml-program-name'."
- :type 'string)
-
-(defcustom sml-config-file "~/.smlproc.sml"
- "File that should be fed to the SML process when started."
- :type 'string)
-
-
-(defcustom sml-prompt-regexp "^[-=>#] *"
- "Regexp used to recognise prompts in the inferior SML process."
- :type 'regexp)
-
-(defcustom sml-compile-commands-alist
- '(("CMB.make()" . "all-files.cm")
- ("CMB.make()" . "pathconfig")
- ("CM.make()" . "sources.cm")
- ("use \"load-all\"" . "load-all"))
- "Commands used by default by `sml-sml-prog-proc-compile'.
-Each command is associated with its \"main\" file.
-It is perfectly OK to associate several files with a command or several
-commands with the same file.")
-
-;; FIXME: Try to auto-detect the process and set those vars accordingly.
-
-(defvar sml-use-command "use \"%s\""
- "Template for loading a file into the inferior SML process.
-Set to \"use \\\"%s\\\"\" for SML/NJ or Edinburgh ML;
-set to \"PolyML.use \\\"%s\\\"\" for Poly/ML, etc.")
-
-(defvar sml-cd-command "OS.FileSys.chDir \"%s\""
- "Command template for changing working directories under SML.
-Set this to nil if your compiler can't change directories.
-
-The format specifier \"%s\" will be converted into the directory name
-specified when running the command \\[sml-cd].")
-
-(defvar sml-error-regexp-alist
- `(;; Poly/ML messages
- ;;
- ;; Warning- in 'polyml.ML', line 135.
- ;; Matches are not exhaustive.
- ;; Found near
- ;; fun
- ;; convert _ (... ...) = ML_Pretty.Break (false, ...) |
- ;; convert _ ... = ML_Pretty.Break (...) |
- ;; convert ... = let ... in ... end |
- ;; convert ... = …
- ;;
- ;; Error- in 'HTTP.sml', line 370.
- ;; Value or constructor (read_line) has not been declared
- ;; Found near
- ;; case read_line bin of
- ;; NONE => () |
- ;; SOME s => (if s = "" then print "DONE\n" else (... ...; ...))
- ("^\\(?:> \\)?\\(?:Error\\|W\\(arning\\)\\)[-:] in '\\(.+\\)', line
\\([0-9]+\\)" 2 3 nil (1))
- ;; Moscow ML
- ("^File \"\\([^\"]+\\)\", line \\([0-9]+\\)\\(-\\([0-9]+\\)\\)?,
characters \\([0-9]+\\)-\\([0-9]+\\):" 1 2 5)
- ;; SML/NJ: the file-pattern is anchored to avoid
- ;; pathological behavior with very long lines.
- ("^[-= ]*\\(.*[^\n)]\\)\\(
(.*)\\)?:\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)?
\\(Error\\|Warnin\\(g\\)\\): .*" 1
- (3 . 6) (4 . 7) (9))
- ;; SML/NJ's exceptions: see above.
- ("^ +\\(raised at:
\\)?\\(.+\\):\\([0-9]+\\)\\.\\([0-9]+\\)\\(-\\([0-9]+\\)\\.\\([0-9]+\\)\\)" 2
- (3 . 6) (4 . 7)))
- "Alist that specifies how to match errors in compiler output.
-See `compilation-error-regexp-alist' for a description of the format.")
-
-(defconst sml-pp-functions
- (sml-prog-proc-make :name "SML"
- :run (lambda () (call-interactively #'sml-run))
- :load-cmd (lambda (file) (format sml-use-command file))
- :chdir-cmd (lambda (dir) (format sml-cd-command dir))
- :compile-commands-alist sml-compile-commands-alist
- :command-eol ";\n"
- ))
-
-;; font-lock support
-(defconst inferior-sml-font-lock-keywords
- `(;; prompt and following interactive command
- ;; FIXME: Actually, this should already be taken care of by comint.
- (,(concat "\\(" sml-prompt-regexp "\\)\\(.*\\)")
- (1 font-lock-prompt-face)
- (2 font-lock-command-face keep))
- ;; CM's messages
- ("^\\[\\(.*GC #.*\n\\)*.*\\]" . font-lock-comment-face)
- ;; SML/NJ's irritating GC messages
- ("^GC #.*" . font-lock-comment-face))
- "Font-locking specification for inferior SML mode.")
-
-(defface font-lock-prompt-face
- '((t (:bold t)))
- "Font Lock mode face used to highlight prompts."
- :group 'font-lock-highlighting-faces)
-(defvar font-lock-prompt-face 'font-lock-prompt-face
- "Face name to use for prompts.")
-
-(defface font-lock-command-face
- '((t (:bold t)))
- "Font Lock mode face used to highlight interactive commands."
- :group 'font-lock-highlighting-faces)
-(defvar font-lock-command-face 'font-lock-command-face
- "Face name to use for interactive commands.")
-
-(defconst inferior-sml-font-lock-defaults
- '(inferior-sml-font-lock-keywords nil nil nil nil))
-
-(defun sml--read-run-cmd ()
- (list
- (read-string "SML command: " sml-program-name)
- (if (or current-prefix-arg (> (length sml-default-arg) 0))
- (read-string "Any args: " sml-default-arg)
- sml-default-arg)
- (if (or current-prefix-arg (> (length sml-host-name) 0))
- (read-string "On host: " sml-host-name)
- sml-host-name)))
-
-;;;###autoload
-(defalias 'run-sml 'sml-run)
-
-;;;###autoload
-(defun sml-run (cmd arg &optional host)
- "Run the program CMD with given arguments ARG.
-The command is run in buffer *CMD* using mode `inferior-sml-mode'.
-If the buffer already exists and has a running process, then
-just go to this buffer.
-
-If a prefix argument is used, the user is also prompted for a HOST
-on which to run CMD using `remote-shell-program'.
-
-\(Type \\[describe-mode] in the process's buffer for a list of commands.)"
- (interactive (sml--read-run-cmd))
- (let* ((pname (file-name-nondirectory cmd))
- (args (split-string arg))
- (file (when (and sml-config-file (file-exists-p sml-config-file))
- sml-config-file)))
- ;; And this -- to keep these as defaults even if
- ;; they're set in the mode hooks.
- (setq sml-program-name cmd)
- (setq sml-default-arg arg)
- (setq sml-host-name host)
- ;; For remote execution, use `remote-shell-program'
- (when (> (length host) 0)
- (setq args `(,host "cd" ,default-directory ";" ,cmd . ,args))
- (setq cmd remote-shell-program))
- ;; Go for it.
- (save-current-buffer
- (let ((exec-path (if (and (file-name-directory cmd)
- (not (file-name-absolute-p cmd)))
- ;; If the command has slashes, make sure we
- ;; first look relative to the current directory.
- ;; Emacs-21 does it for us, but not Emacs-20.
- (cons default-directory exec-path) exec-path)))
- (pop-to-buffer (apply 'make-comint pname cmd file args)))
-
- (inferior-sml-mode)
- (goto-char (point-max))
- (current-buffer))))
-
-(defun sml-send-function (&optional and-go)
- "Send current paragraph to the inferior SML process.
-With a prefix argument AND-GO switch to the repl buffer as well."
- (interactive "P")
- (save-excursion
- (sml-mark-function)
- (sml-prog-proc-send-region (point) (mark)))
- (if and-go (sml-prog-proc-switch-to)))
-
-(defvar inferior-sml-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map comint-mode-map)
- (define-key map "\C-c\C-s" 'sml-run)
- (define-key map "\t" 'completion-at-point)
- map)
- "Keymap for inferior-sml mode.")
-
-
-(declare-function smerge-refine-subst "smerge-mode"
- (beg1 end1 beg2 end2 props-c))
-
-(defun inferior-sml-next-error-hook ()
- ;; Try to recognize SML/NJ type error message and to highlight finely the
- ;; difference between the two types (in case they're large, it's not
- ;; always obvious to spot it).
- ;;
- ;; Sample messages:
- ;;
- ;; Data.sml:31.9-33.33 Error: right-hand-side of clause doesn't agree with
function result type [tycon mismatch]
- ;; expression: Hstring
- ;; result type: Hstring * int
- ;; in declaration:
- ;; des2hs = (fn SYM_ID hs => hs
- ;; | SYM_OP hs => hs
- ;; | SYM_CHR hs => hs)
- ;; Data.sml:35.44-35.63 Error: operator and operand don't agree [tycon
mismatch]
- ;; operator domain: Hstring * Hstring
- ;; operand: (Hstring * int) * (Hstring * int)
- ;; in expression:
- ;; HSTRING.ieq (h1,h2)
- ;; vparse.sml:1861.6-1922.14 Error: case object and rules don't agree [tycon
mismatch]
- ;; rule domain: STConstraints list list option
- ;; object: STConstraints list option
- ;; in expression:
- (save-current-buffer
- (when (and (derived-mode-p 'sml-mode 'inferior-sml-mode)
- (boundp 'next-error-last-buffer)
- (bufferp next-error-last-buffer)
- (set-buffer next-error-last-buffer)
- (derived-mode-p 'inferior-sml-mode)
- ;; The position of `point' is not guaranteed :-(
- (looking-at (concat ".*\\[tycon mismatch\\]\n"
- " \\(operator domain\\|expression\\|rule
domain\\): +")))
- (require 'smerge-mode)
- (save-excursion
- (let ((b1 (match-end 0))
- e1 b2 e2)
- (when (re-search-forward "\n in \\(expression\\|declaration\\):\n"
- nil t)
- (setq e2 (match-beginning 0))
- (when (re-search-backward
- "\n \\(operand\\|result type\\|object\\): +"
- b1 t)
- (setq e1 (match-beginning 0))
- (setq b2 (match-end 0))
- (smerge-refine-subst b1 e1 b2 e2
- '((face . smerge-refined-change))))))))))
-
-(define-derived-mode inferior-sml-mode sml-prog-proc-comint-mode "Inferior-SML"
- "Major mode for interacting with an inferior SML process.
-
-The following commands are available:
-\\{inferior-sml-mode-map}
-
-An SML process can be fired up (again) with \\[sml].
-
-Customisation: Entry to this mode runs the hooks on `comint-mode-hook'
-and `inferior-sml-mode-hook' (in that order).
-
-Variables controlling behaviour of this mode are
-
-`sml-program-name' (default \"sml\")
- Program to run as SML.
-
-`sml-use-command' (default \"use \\\"%s\\\"\")
- Template for loading a file into the inferior SML process.
-
-`sml-cd-command' (default \"System.Directory.cd \\\"%s\\\"\")
- SML command for changing directories in SML process (if possible).
-
-`sml-prompt-regexp' (default \"^[\\-=] *\")
- Regexp used to recognise prompts in the inferior SML process.
-
-You can send text to the inferior SML process from other buffers containing
-SML source.
- `switch-to-sml' switches the current buffer to the SML process buffer.
- `sml-send-function' sends the current *paragraph* to the SML process.
- `sml-send-region' sends the current region to the SML process.
-
- Prefixing the sml-send-<whatever> commands with \\[universal-argument]
- causes a switch to the SML process buffer after sending the text.
-
-For information on running multiple processes in multiple buffers, see
-documentation for variable `sml-buffer'.
-
-Commands:
-RET after the end of the process' output sends the text from the
- end of process to point.
-RET before the end of the process' output copies the current line
- to the end of the process' output, and sends it.
-DEL converts tabs to spaces as it moves back.
-TAB file name completion, as in shell-mode, etc.."
- (setq comint-prompt-regexp sml-prompt-regexp)
- (sml-mode-variables)
-
- ;; We have to install it globally, 'cause it's run in the *source* buffer :-(
- (add-hook 'next-error-hook 'inferior-sml-next-error-hook)
-
- ;; Make TAB add a " rather than a space at the end of a file name.
- (setq-local comint-completion-addsuffix '("/" . "\""))
-
- (setq-local font-lock-defaults inferior-sml-font-lock-defaults)
-
- ;; Compilation support (used for `next-error').
- (setq-local compilation-error-regexp-alist sml-error-regexp-alist)
- ;; FIXME: move it to sml-mode?
- (setq-local compilation-error-screen-columns nil)
-
- (setq mode-line-process '(": %s")))
-
-;;; MORE CODE FOR SML-MODE
-
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.s\\(ml\\|ig\\)\\'" . sml-mode))
-
-(defvar comment-quote-nested)
-
-(defcustom sml-abbrev-skeletons t
- "Whether to include skeletons in `sml-mode's abbrev table."
- :type 'boolean)
-
-(define-abbrev-table 'sml-skel-abbrev-table nil
- "Abbrev table for skeletons in `sml-mode.'"
- :case-fixed t
- :enable-function
- (lambda () (and sml-abbrev-skeletons (not (nth 8 (syntax-ppss))))))
-
-(define-abbrev-table 'sml-mode-abbrev-table nil
- "Abbrevs for `sml-mode.'"
- :parents (list sml-skel-abbrev-table))
-
-;;;###autoload
-(define-derived-mode sml-mode sml-prog-proc-mode "SML"
- "Major mode for editing Standard ML code.
-This mode runs `sml-mode-hook' just before exiting.
-See also (info \"(sml-mode)Top\")."
- (setq-local font-lock-defaults sml-font-lock-defaults)
- (setq-local prettify-symbols-alist sml-font-lock-symbols-alist)
- (setq-local outline-regexp sml-outline-regexp)
- (setq-local imenu-create-index-function #'sml-imenu-create-index)
- (setq-local add-log-current-defun-function #'sml-current-fun-name)
- ;; Treat paragraph-separators in comments as paragraph-separators.
- (setq-local paragraph-separate
- (concat "\\([ \t]*\\*)?\\)?\\(" paragraph-separate "\\)"))
- (setq-local require-final-newline t)
- (setq-local electric-indent-chars
- (cons ?\; (if (boundp 'electric-indent-chars)
- electric-indent-chars '(?\n))))
- (setq-local electric-layout-rules
- `((?\; . ,(lambda ()
- (save-excursion
- (skip-chars-backward " \t;")
- (unless (or (bolp)
- (progn (skip-chars-forward " \t;")
- (eolp)))
- 'after))))))
- (when sml-electric-pipe-mode
- (add-hook 'post-self-insert-hook #'sml-post-self-insert-pipe nil t))
- (sml-mode-variables))
-
-(defun sml-mode-variables ()
- (setq-local sml-prog-proc-descriptor sml-pp-functions)
- (set-syntax-table sml-mode-syntax-table)
- (setq local-abbrev-table sml-mode-abbrev-table)
- ;; Setup indentation and sexp-navigation.
- (smie-setup sml-smie-grammar #'sml-smie-rules
- :backward-token #'sml-smie-backward-token
- :forward-token #'sml-smie-forward-token)
- (setq-local parse-sexp-ignore-comments t)
- (setq-local comment-start "(* ")
- (setq-local comment-end " *)")
- (setq-local comment-start-skip "(\\*+\\s-*")
- (setq-local comment-end-skip "\\s-*\\*+)")
- ;; No need to quote nested comments markers.
- (setq-local comment-quote-nested nil))
-
-(defun sml-funname-of-and ()
- "Name of the function this `and' defines, or nil if not a function.
-Point has to be right after the `and' symbol and is not preserved."
- (forward-comment (point-max))
- (if (looking-at sml-tyvarseq-re) (goto-char (match-end 0)))
- (let ((sym (sml-smie-forward-token)))
- (forward-comment (point-max))
- (unless (or (member sym '(nil "d="))
- (member (sml-smie-forward-token) '("d=")))
- sym)))
-
-(defun sml-find-forward (re)
- (while (progn (forward-comment (point-max))
- (not (looking-at re)))
- (or (ignore-errors (forward-sexp 1) t) (forward-char 1))))
-
-(defun sml-electric-pipe ()
- "Insert a \"|\".
-Depending on the context insert the name of function, a \"=>\" etc."
- (interactive)
- (unless (save-excursion (skip-chars-backward "\t ") (bolp)) (insert "\n"))
- (insert "| ")
- (unless (sml-post-self-insert-pipe (1- (point)))
- (indent-according-to-mode)))
-
-(defun sml-post-self-insert-pipe (&optional acp)
- (when (or acp (and (eq ?| last-command-event)
- (setq acp (electric--after-char-pos))))
- (let ((text
- (save-excursion
- (goto-char (1- acp)) ;Jump before the "|" we just inserted.
- (let ((sym (sml-find-matching-starter sml-pipeheads
- ;; (sml-op-prec "|" 'back)
- )))
- (sml-smie-forward-token)
- (forward-comment (point-max))
- (cond
- ((string= sym "|")
- (let ((f (sml-smie-forward-token)))
- (sml-find-forward "\\(=>\\|=\\||\\)\\S.")
- (cond
- ((looking-at "|") nil) ; A datatype or an OR pattern?
- ((looking-at "=>") " => ") ;`case', or `fn' or `handle'.
- ((looking-at "=") ;A function.
- (cons (concat f " ")" = ")))))
- ((string= sym "and")
- ;; Could be a datatype or a function.
- (let ((funname (sml-funname-of-and)))
- (if funname (cons (concat funname " ") " = ") nil)))
- ((string= sym "fun")
- (while (and (setq sym (sml-smie-forward-token))
- (string-match "^'" sym))
- (forward-comment (point-max)))
- (cons (concat sym " ") " = "))
- ((member sym '("case" "handle" "of")) " => ") ;; "fn"?
- ;;((member sym '("abstype" "datatype")) "")
- (t nil))))))
- (when text
- (save-excursion
- (goto-char (1- acp))
- (unless (save-excursion (skip-chars-backward "\t ") (bolp))
- (insert "\n")))
- (unless (memq (char-before) '(?\s ?\t)) (insert " "))
- (let ((use-region (and (use-region-p) (< (point) (mark)))))
- ;; (skeleton-proxy-new `(nil ,(if (consp text) (pop text)) _ ,text))
- (when (consp text) (insert (pop text)))
- (if (not use-region)
- (save-excursion (insert text))
- (goto-char (mark))
- (insert text)))
- (indent-according-to-mode)
- t))))
-
-
-;;; Misc
-
-(defun sml-mark-function ()
- "Mark the surrounding function. Or try to at least."
- (interactive)
- ;; FIXME: Provide beginning-of-defun-function so mark-defun "just works".
- (let ((start (point)))
- (sml-beginning-of-defun)
- (let ((beg (point)))
- (smie-forward-sexp 'halfsexp)
- (if (or (< start beg) (> start (point)))
- (progn
- (goto-char start)
- (mark-paragraph))
- (push-mark nil t t)
- (goto-char beg)))))
-
-(defun sml-back-to-outer-indent ()
- "Unindents to the next outer level of indentation."
- (interactive)
- (save-excursion
- (forward-line 0)
- (let ((start-column (current-indentation))
- indent)
- (when (> start-column 0)
- (save-excursion
- (while (>= (setq indent
- (if (re-search-backward "^[ \t]*[^\n\t]" nil t)
- (current-indentation)
- 0))
- start-column))
- (skip-chars-forward " \t")
- (let ((pos (point)))
- (move-to-column start-column)
- (when (re-search-backward " \\([^ \t\n]\\)" pos t)
- (goto-char (match-beginning 1))
- (setq indent (current-column)))))
- (indent-line-to indent)))))
-
-(defun sml-find-matching-starter (syms)
- (let ((halfsexp nil)
- tok)
- ;;(sml-smie-forward-token)
- (while (not (or (bobp)
- (member (nth 2 (setq tok (smie-backward-sexp halfsexp)))
- syms)))
- (cond
- ((null (car tok)) nil)
- ((numberp (car tok)) (setq halfsexp 'half))
- (t (goto-char (cadr tok)))))
- (if (nth 2 tok) (goto-char (cadr tok)))
- (nth 2 tok)))
-
-(defun sml-skip-siblings ()
- (let (tok)
- (while (and (not (bobp))
- (progn (setq tok (smie-backward-sexp 'half))
- (cond
- ((null (car tok)) t)
- ((numberp (car tok)) t)
- (t nil)))))
- (if (nth 2 tok) (goto-char (cadr tok)))
- (nth 2 tok)))
-
-(defun sml-beginning-of-defun ()
- (let ((sym (sml-find-matching-starter sml-starters-syms)))
- (if (member sym '("fun" "and" "functor" "signature" "structure"
- "abstraction" "datatype" "abstype"))
- (save-excursion (sml-smie-forward-token) (forward-comment (point-max))
- (sml-smie-forward-token))
- ;; We're inside a "non function declaration": let's skip all other
- ;; declarations that we find at the same level and try again.
- (sml-skip-siblings)
- ;; Obviously, let's not try again if we're at bobp.
- (unless (bobp) (sml-beginning-of-defun)))))
-
-(defcustom sml-max-name-components 3
- "Maximum number of components to use for the current function name."
- :type 'integer)
-
-(defun sml-current-fun-name ()
- (save-excursion
- (let ((count sml-max-name-components)
- fullname name)
- (end-of-line)
- (while (and (> count 0)
- (setq name (sml-beginning-of-defun)))
- (cl-decf count)
- (setq fullname (if fullname (concat name "." fullname) name))
- ;; Skip all other declarations that we find at the same level.
- (sml-skip-siblings))
- fullname)))
-
-
-;;; INSERTING PROFORMAS (COMMON SML-FORMS)
-
-(defvar sml-forms-alist nil
- "Alist of code templates.
-You can extend this alist to your heart's content. For each additional
-template NAME in the list, declare a keyboard macro or function (or
-interactive command) called `sml-form-NAME'.
-If `sml-form-NAME' is a function it takes no arguments and should
-insert the template at point\; if this is a command it may accept any
-sensible interactive call arguments\; keyboard macros can't take
-arguments at all.
-`sml-forms-alist' understands let, local, case, abstype, datatype,
-signature, structure, and functor by default.")
-
-(defmacro sml-def-skeleton (name interactor &rest elements)
- (declare (indent 2))
- (let ((fsym (intern (concat "sml-form-" name))))
- `(progn
- (add-to-list 'sml-forms-alist ',(cons name fsym))
- (define-abbrev sml-skel-abbrev-table ,name "" ',fsym :system t)
- (define-skeleton ,fsym
- ,(format "SML-mode skeleton for `%s..' expressions" name)
- ,interactor
- ,(concat name " ") >
- ,@elements))))
-
-(sml-def-skeleton "let" nil
- @ "\nin " > _ "\nend" >)
-
-(sml-def-skeleton "if" nil
- @ " then " > _ "\nelse " > _)
-
-(sml-def-skeleton "local" nil
- @ "\nin" > _ "\nend" >)
-
-(sml-def-skeleton "case" "Case expr: "
- str "\nof " > _ " => ")
-
-(sml-def-skeleton "signature" "Signature name: "
- str " =\nsig" > "\n" > _ "\nend" >)
-
-(sml-def-skeleton "structure" "Structure name: "
- str " =\nstruct" > "\n" > _ "\nend" >)
-
-(sml-def-skeleton "functor" "Functor name: "
- str " () : =\nstruct" > "\n" > _ "\nend" >)
-
-(sml-def-skeleton "datatype" "Datatype name and type params: "
- str " =" \n)
-
-(sml-def-skeleton "abstype" "Abstype name and type params: "
- str " =" \n _ "\nwith" > "\nend" >)
-
-;;
-
-(sml-def-skeleton "struct" nil
- _ "\nend" >)
-
-(sml-def-skeleton "sig" nil
- _ "\nend" >)
-
-(sml-def-skeleton "val" nil
- @ " = " > _)
-
-(sml-def-skeleton "fn" nil
- @ " =>" > _)
-
-(sml-def-skeleton "fun" nil
- @ " =" > _)
-
-;;
-
-(defun sml-forms-menu (_menu)
- (mapcar (lambda (x) (vector (car x) (cdr x) t))
- sml-forms-alist))
-
-(defvar sml-last-form "let")
-
-(defun sml-electric-space ()
- "Expand a symbol into an SML form, or just insert a space.
-If the point directly precedes a symbol for which an SML form exists,
-the corresponding form is inserted."
- (interactive)
- (let ((abbrev-mode (not abbrev-mode))
- (last-command-event ?\s)
- ;; Bind `this-command' to fool skeleton's special abbrev handling.
- (this-command 'self-insert-command))
- (call-interactively 'self-insert-command)))
-
-(defun sml-insert-form (name newline)
- "Interactive short-cut to insert the NAME common SML form.
-If a prefix argument is given insert a NEWLINE and indent first, or
-just move to the proper indentation if the line is blank\; otherwise
-insert at point (which forces indentation to current column).
-
-The default form to insert is whatever you inserted last time
-\(just hit return when prompted\)\; otherwise the command reads with
-completion from `sml-forms-alist'."
- (interactive
- (list (completing-read
- (format "Form to insert (default %s): " sml-last-form)
- sml-forms-alist nil t nil nil sml-forms-alist)
- current-prefix-arg))
- (setq sml-last-form name)
- (unless (or (not newline)
- (save-excursion (beginning-of-line) (looking-at "\\s-*$")))
- (insert "\n"))
- (when (memq (char-syntax (preceding-char)) '(?_ ?w)) (insert " "))
- (let ((f (cdr (assoc name sml-forms-alist))))
- (cond
- ((commandp f) (command-execute f))
- (f (funcall f))
- (t (error "Undefined SML form: %s" name)))))
-
-;;;
-;;; MLton support
-;;;
-
-(defvar sml-mlton-command "mlton"
- "Command to run MLton. Can include arguments.")
-
-(defvar sml-mlton-mainfile nil)
-
-(defconst sml-mlton-error-regexp-alist
- ;; I wish they just changed MLton to use one of the standard
- ;; error formats.
- `(("^\\(?:Error\\|\\(Warning\\)\\): \\(.+\\) \\([0-9]+\\)\\.\\([0-9]+\\)\\.$"
- 2 3 4
- ;; If subgroup 1 matched, then it's a warning, otherwise it's an error.
- (1))))
-
-(defvar compilation-error-regexp-alist)
-(eval-after-load "compile"
- '(dolist (x sml-mlton-error-regexp-alist)
- (add-to-list 'compilation-error-regexp-alist x)))
-
-(defun sml-mlton-typecheck (mainfile)
- "Typecheck using MLton.
-MAINFILE is the top level file of the project."
- (interactive
- (list (if (and sml-mlton-mainfile (not current-prefix-arg))
- sml-mlton-mainfile
- (read-file-name "Main file: "))))
- (setq sml-mlton-mainfile mainfile)
- (save-some-buffers)
- (require 'compile)
- (dolist (x sml-mlton-error-regexp-alist)
- (add-to-list 'compilation-error-regexp-alist x))
- (with-current-buffer (find-file-noselect mainfile)
- (compile (concat sml-mlton-command
- " -stop tc " ;Stop right after type checking.
- (shell-quote-argument
- (file-relative-name buffer-file-name))))))
-
-;;;
-;;; MLton's def-use info.
-;;;
-
-(defvar sml-defuse-file nil)
-
-(defun sml-defuse-file ()
- (or sml-defuse-file (sml-defuse-set-file)))
-
-(defun sml-defuse-set-file ()
- "Specify the def-use file to use."
- (interactive)
- (setq sml-defuse-file (read-file-name "Def-use file: ")))
-
-(defun sml-defuse-symdata-at-point ()
- (save-excursion
- (sml-smie-forward-token)
- (let ((symname (sml-smie-backward-token)))
- (if (equal symname "op")
- (save-excursion (setq symname (sml-smie-forward-token))))
- (when (string-match "op " symname)
- (setq symname (substring symname (match-end 0)))
- (forward-word)
- (forward-comment (point-max)))
- (list symname
- ;; Def-use files seem to count chars, not columns.
- ;; We hope here that they don't actually count bytes.
- ;; Also they seem to start counting at 1.
- (1+ (- (point) (progn (beginning-of-line) (point))))
- (save-restriction
- (widen) (1+ (count-lines (point-min) (point))))
- buffer-file-name))))
-
-(defconst sml-defuse-def-regexp
- "^[[:alpha:]]+ \\([^ \n]+\\) \\(.+\\) \\([0-9]+\\)\\.\\([0-9]+\\)$")
-(defconst sml-defuse-use-regexp-format "^ %s %d\\.%d $")
-
-(defun sml-defuse-jump-to-def ()
- "Jump to the definition corresponding to the symbol at point."
- (interactive)
- (let ((symdata (sml-defuse-symdata-at-point)))
- (if (null (car symdata))
- (error "Not on a symbol")
- (with-current-buffer (find-file-noselect (sml-defuse-file))
- (goto-char (point-min))
- (unless (re-search-forward
- (format sml-defuse-use-regexp-format
- (concat "\\(?:"
- ;; May be an absolute file name.
- (regexp-quote (nth 3 symdata))
- "\\|"
- ;; Or a relative file name.
- (regexp-quote (file-relative-name
- (nth 3 symdata)))
- "\\)")
- (nth 2 symdata)
- (nth 1 symdata))
- nil t)
- ;; FIXME: This is typically due to editing: any minor editing will
- ;; mess everything up. We should try to fail more gracefully.
- (error "Def-use info not found"))
- (unless (re-search-backward sml-defuse-def-regexp nil t)
- ;; This indicates a bug in this code.
- (error "Internal failure while looking up def-use"))
- (unless (equal (match-string 1) (nth 0 symdata))
- ;; FIXME: This again is most likely due to editing.
- (error "Incoherence in the def-use info found"))
- (let ((line (string-to-number (match-string 3)))
- (char (string-to-number (match-string 4))))
- (pop-to-buffer (find-file-noselect (match-string 2)))
- (goto-char (point-min))
- (forward-line (1- line))
- (forward-char (1- char)))))))
-
-;;;
-;;; SML/NJ's Compilation Manager support
-;;;
-
-(defvar sml-cm-mode-syntax-table sml-mode-syntax-table)
-(defvar sml-cm-font-lock-keywords
- `(,(concat "\\_<" (regexp-opt '("library" "group" "is" "structure"
- "functor" "signature" "funsig") t)
- "\\_>")))
-;;;###autoload
-(add-to-list 'completion-ignored-extensions ".cm/")
-;; This was used with the old compilation manager.
-(add-to-list 'completion-ignored-extensions "CM/")
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.cm\\'" . sml-cm-mode))
-;;;###autoload
-(define-derived-mode sml-cm-mode fundamental-mode "SML-CM"
- "Major mode for SML/NJ's Compilation Manager configuration files."
- (setq-local sml-prog-proc-descriptor sml-pp-functions)
- (setq-local font-lock-defaults '(sml-cm-font-lock-keywords nil t nil nil)))
-
-;;;
-;;; ML-Lex support
-;;;
-
-(defvar sml-lex-font-lock-keywords
- (append
- `((,(concat "^%" sml-id-re) . font-lock-builtin-face)
- ("^%%" . font-lock-module-def-face))
- sml-font-lock-keywords))
-(defconst sml-lex-font-lock-defaults
- (cons 'sml-lex-font-lock-keywords (cdr sml-font-lock-defaults)))
-
-;;;###autoload
-(define-derived-mode sml-lex-mode sml-mode "SML-Lex"
- "Major Mode for editing ML-Lex files."
- (setq-local font-lock-defaults sml-lex-font-lock-defaults))
-
-;;;
-;;; ML-Yacc support
-;;;
-
-(defface sml-yacc-bnf-face
- '((t (:foreground "darkgreen")))
- "Face used to highlight (non)terminals in `sml-yacc-mode'.")
-(defvar sml-yacc-bnf-face 'sml-yacc-bnf-face)
-
-(defcustom sml-yacc-indent-action 16
- "Indentation column of the opening paren of actions."
- :type 'integer)
-
-(defcustom sml-yacc-indent-pipe nil
- "Indentation column of the pipe char in the BNF.
-If nil, align it with `:' or with previous cases."
- :type 'integer)
-
-(defcustom sml-yacc-indent-term nil
- "Indentation column of the (non)term part.
-If nil, align it with previous cases."
- :type 'integer)
-
-(defvar sml-yacc-font-lock-keywords
- (cons `((concat "^\\(" sml-id-re "\\s-*:\\|\\s-*|\\)\\(\\s-*" sml-id-re
- "\\)*\\s-*\\(\\(%" sml-id-re "\\)\\s-+" sml-id-re "\\|\\)")
- (0 (save-excursion
- (save-match-data
- (goto-char (match-beginning 0))
- (unless (or (re-search-forward "\\_<of\\_>"
- (match-end 0) 'move)
- (progn (forward-comment (point-max))
- (not (looking-at "("))))
- sml-yacc-bnf-face))))
- (4 font-lock-builtin-face t t))
- sml-lex-font-lock-keywords))
-(defconst sml-yacc-font-lock-defaults
- (cons 'sml-yacc-font-lock-keywords (cdr sml-font-lock-defaults)))
-
-(defun sml-yacc-indent-line ()
- "Indent current line of ML-Yacc code."
- (let ((savep (> (current-column) (current-indentation)))
- (indent (max (or (ignore-errors (sml-yacc-indentation)) 0) 0)))
- (if savep
- (save-excursion (indent-line-to indent))
- (indent-line-to indent))))
-
-(defun sml-yacc-indentation ()
- (save-excursion
- (back-to-indentation)
- (or (and (looking-at (eval-when-compile
- (concat "%\\|" sml-id-re "\\s-*:")))
- 0)
- (when (save-excursion
- (condition-case nil (progn (up-list -1) nil) (scan-error t)))
- ;; We're outside an action.
- (cond
- ;; Special handling of indentation inside %term and %nonterm
- ((save-excursion
- (and (re-search-backward "^%\\(\\sw+\\)" nil t)
- (member (match-string 1) '("term" "nonterm"))))
- (if (numberp sml-yacc-indent-term) sml-yacc-indent-term
- (let ((offset (if (looking-at "|") -2 0)))
- (forward-line -1)
- (looking-at "\\s-*\\(%\\sw*\\||\\)?\\s-*")
- (goto-char (match-end 0))
- (+ offset (current-column)))))
- ((looking-at "(") sml-yacc-indent-action)
- ((looking-at "|")
- (if (numberp sml-yacc-indent-pipe) sml-yacc-indent-pipe
- (backward-sexp 1)
- (while (progn (forward-comment (- (point)))
- (/= 0 (skip-syntax-backward "w_"))))
- (forward-comment (- (point)))
- (if (not (looking-at "\\s-$"))
- (1- (current-column))
- (skip-syntax-forward " ")
- (- (current-column) 2))))))
- ;; default to SML rules
- (smie-indent-calculate))))
-
-;;;###autoload
-(add-to-list 'auto-mode-alist '("\\.grm\\'" . sml-yacc-mode))
-;;;###autoload
-(define-derived-mode sml-yacc-mode sml-mode "SML-Yacc"
- "Major Mode for editing ML-Yacc files."
- (setq-local indent-line-function 'sml-yacc-indent-line)
- (setq-local font-lock-defaults sml-yacc-font-lock-defaults))
-
-
-(provide 'sml-mode)
-
-;;; sml-mode.el ends here
diff --git a/packages/sml-mode/sml-mode.spec b/packages/sml-mode/sml-mode.spec
deleted file mode 100644
index f0d8437..0000000
--- a/packages/sml-mode/sml-mode.spec
+++ /dev/null
@@ -1,67 +0,0 @@
-%define lispdir %{_datadir}/emacs/site-lisp
-%define startupfile %{lispdir}/site-start.el
-
-Summary: Emacs mode for editing Standard ML source code
-Name: sml-mode
-Version: $Name$
-Release: 0.1
-Group: Applications/Editors
-Copyright: GPL
-Packager: Stefan Monnier
-Source: http://iro.umontreal.ca/~monnier/elisp/%{name}.tar.gz
-Buildroot: %{_tmppath}/%{name}-buildroot
-BuildPreReq: emacs >= 20 xemacs >= 21
-BuildArch: noarch
-
-%description
-SML-MODE is a major Emacs mode for editing Standard ML. It provides
-syntax highlighting and automatic indentation and comes with sml-proc
-which allows interaction with an inferior SML interactive loop.
-
-%prep
-%setup -q -n %{name}
-
-%install
-make install \
- prefix=%{buildroot}%{_prefix} \
- infodir=%{buildroot}%{_infodir} \
- lispdir=%{buildroot}%{lispdir}
-gzip -9f %{buildroot}%{lispdir}/sml-mode/*.el
-
-texi2pdf sml-mode.texi
-
-%post
-cat >> %{lispdir}/site-start.el <<EOF
-;; sml-mode-start
-;; This section was automatically generated by rpm
-(load "sml-mode-startup")
-;; End of automatically generated section
-;; sml-mode-end
-EOF
-
-/sbin/install-info %{_infodir}/sml-mode.info.gz %{_infodir}/dir
-
-%postun
-ed -s %{lispdir}/site-start.el <<EOF
-/^;; sml-mode-start$/,/^;; sml-mode-end$/d
-wq
-EOF
-
-/sbin/install-info --delete %{_infodir}/sml-mode.info.gz %{_infodir}/dir \
- --section=Emacs \
- --entry="* SML: (sml-mode). Editing & Running Standard ML from Emacs"
-
-%clean
-rm -rf %{buildroot}
-
-%files
-%defattr(-,root,root)
-%doc BUGS ChangeLog INSTALL NEWS README TODO
-%doc sml-mode.texi sml-mode.pdf
-%doc %{_infodir}/*.info*
-%dir %{lispdir}/%{name}
-%{lispdir}/%{name}/*.elc
-%{lispdir}/%{name}/*.el
-%{lispdir}/%{name}/*.el.*
-
-%changelog
diff --git a/packages/sml-mode/sml-mode.texi b/packages/sml-mode/sml-mode.texi
deleted file mode 100644
index d9980f7..0000000
--- a/packages/sml-mode/sml-mode.texi
+++ /dev/null
@@ -1,1143 +0,0 @@
-\input texinfo @c -*-texinfo-*-
-
-@comment "@(#)$Name$:$Id$"
-
-@comment Documentation for the GNU Emacs SML mode.
-@comment Copyright (C) 1997-1999 Matthew J.@: Morley
-
-@comment This file is part of the sml-mode distribution.
-
-@comment sml-mode is free software; you can redistribute it and/or modify
-@comment it under the terms of the GNU General Public License as published by
-@comment the Free Software Foundation; either version 3 of the License,
-@comment or (at your option) any later version.
-
-@comment sml-mode is distributed in the hope that it will be useful,
-@comment but WITHOUT ANY WARRANTY; without even the implied warranty of
-@comment MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-@comment GNU General Public License for more details.
-
-@comment You should have received a copy of the GNU General Public License
-@comment along with sml-mode; see the file COPYING. If not, write to
-@comment the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-@setfilename sml-mode.info
-@settitle SML mode - The Emacs SML editing mode
-@dircategory Emacs
-@direntry
-* sml:(sml-mode). Emacs mode for editing SML
-@end direntry
-@setchapternewpage on
-
-@titlepage
-@sp 5
-@center @titlefont{Editing and Running Standard ML}
-@center @titlefont{under GNU Emacs}
-@sp 5
-@center {SML mode, Version $Name$}
-@center {August 1999}
-@sp 2
-@author Authors: Matthew J.@: Morley and Stefan Monnier
-
-@page
-@vskip 0pt plus 1filll
-Copyright @copyright{} (Anon)
-
-@sp 1
-@noindent
-GNU General Public License as published by the Free Software Foundation;
-either version 3, or (at your option) any later version.
-
-@sp 1
-@noindent
-SML mode 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.
-
-@sp 1
-@noindent
-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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-@end titlepage
-
-@setchapternewpage off
-@headings double
-
-@c ============================================================ TOP NODE
-
-@node Top, Copying, (dir), (dir)
-
-@ifinfo
-@chapter SML Mode Info
-
-@c == Top, Copying, (dir), (dir) =======================================
-
-@noindent
-You are looking at the top node of the Info tree documenting
-@sc{sml-mode} (Version $Name$). Not all functions are documented here, but
-those that aren't you probably won't miss. All commands and settable
-variables have built-in documentation, as per usual Emacs conventions.
-@end ifinfo
-
-@menu
-* Copying:: You can copy SML mode
-* Introduction:: Setting things up
-* SML Mode:: Editing SML source
-* Interaction Mode:: Running ML processes
-* Configuration:: Menus, highlighting, setting defaults
-
-Indexes
-* Command Index:: Commands you can invoke
-* Variable Index:: Variables you can set
-* Key Index:: Default keybindings
-
-Introduction
-* Contributors:: Who did what
-* Getting Started:: What to tell Emacs
-* Getting Help:: How Emacs can help
-
-SML Mode
-* Basics:: On entering SML mode
-* Indentation:: Prettying SML text
-* Magic Insertion:: Templates and electric keys
-* SML Mode Defaults:: Variables controlling indentation
-
-Interaction Mode
-* Running ML:: Commands to run the ML compiler in a buffer
-* ML Interaction:: Sending program fragments to the compiler
-* Tracking Errors:: Finding reported syntax errors
-* Process Defaults:: Setting defaults for process interaction
-
-Configuration
-* Hooks:: Creating hooks
-* Key Bindings:: Binding commands to keys
-* Highlighting:: Syntax colouring
-* Advanced Topics:: You may need to speak Emacs Lisp
-@end menu
-
-
-@c ============================================================= COPYING
-
-@node Copying, Introduction, Top, Top
-
-@ifinfo
-@chapter Copying
-
-@c == Copying, Introduction, Top, Top ==================================
-
-@noindent
-You can freely copy, modify and redistribute SML mode because it's
-made available under the liberal terms of the GNU General Public
-License.
-
-GNU General Public License as published by the Free Software Foundation;
-either version 3, or (at your option) any later version.
-
-SML mode 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-@end ifinfo
-
-
-
-
-@c ======================================================== INTRODUCTION
-
-@node Introduction, SML Mode, Copying, Top
-
-@chapter Introduction
-
-@c == Introduction, SML Mode, Copying, Top =============================
-
-
-@noindent
-SML mode is a major mode for Emacs for editing Standard ML. It has
-some novel bugs, and some nice features:
-
-@itemize @bullet
-@item
-Automatic indentation of sml code---a number of variables to customise
-the indentation.
-@item
-Easy insertion for commonly used templates like let, local, signature,
-and structure declarations, with minibuffer prompting for types and
-expressions.
-@item
-Magic pipe insertion: @code{|} automatically determines if it is used
-in a case or fun construct, and indents the next line as appropriate,
-inserting @code{=>} or the name of the function.
-@item
-Inferior shell for running ML. There's no need to leave Emacs, just keep
-on editing while the compiler runs in another window.
-@item
-Automatic ``use file'' in the inferior shell---you can send files,
-buffers, or regions of code to the ML subprocess.
-@item
-Menus, and syntax and keyword highlighting supported for Emacs 19 and
-derivatives.
-@item
-Parsing errors from the inferior shell, and repositioning the
-source with next-error---just like in c-mode.
-@item
-SML mode can be easily configured to work with a number of Standard
-ML compilers, and other SML based tools.
-@end itemize
-
-@menu
-* Contributors:: Who did what
-* Getting Started:: What to tell Emacs
-* Getting Help:: How Emacs can help
-@end menu
-
-
-
-@c ======================================================== CONTRIBUTORS
-
-@node Contributors, Getting Started, Introduction, Introduction
-
-@section Contributors to the SML mode
-@cindex Contributors
-@cindex Authors
-
-Contributions to the package are welcome. I have limited time to work
-on this project, but I will gladly add any code that you contribute to
-me to this package.
-
-Although the history of sml-mode is obscure, it seems that
-the following persons have made contributions to sml-mode:
-
-@itemize @bullet
-@item
-Lars Bo Nielsen wrote the original version of the code, providing the
-sml editing mode and the inferior-sml support.
-
-@item
-Olin Shivers (@samp{shivers@@ai.mit.edu}) hacked the inferior-sml support
-to use comint and call the whole thing ml-mode.
-
-@item
-Steven Gilmore supposedly provided some early attempt at menubar support.
-
-@item
-Matthew J. Morley (@samp{matthew@@verisity.com}) was maintainer for
-a long time (until version 3.4) and provided many additions and fixes in
-all areas.
-
-@item
-Frederick Knabe (@samp{knabe@@ecrc.de}) provided the original code for
-font-lock and hilite support as well as for proper handling of nested
-comments and of all the string escape sequences.
-
-@item
-Matthias Blume (@samp{blume@@kurims.kyoto-u.ac.jp}) provided a sml-make
-which was replaced by sml-compile.
-
-@item
-Monnier Stefan (@samp{monnier@@iro.umontreal.ca}) completely reworked the
-indentation engine as well as most of the rest of the code and is
-the current maintainer since after version 3.4.
-
-@end itemize
-
-
-@c ===================================================== GETTING STARTED
-
-@node Getting Started, Getting Help, Contributors, Introduction
-
-@section Getting started
-
-@c == Getting Started, Getting Help, Contributors, Introduction ========
-
-
-@noindent
-With luck your system administrator will have installed SML mode
-somewhere convenient, so it will just magically all work---you can
-skip the rest of this getting started section. Otherwise you will need
-to tell Emacs where to find all the SML mode @file{.el} files, and
-when to use them. The where is addressed by locating the Lisp code on
-your Emacs Lisp load path---you may have to create a directory for this,
-say @file{/home/mjm/elisp}, and then insert the following lines in your
-@file{/home/mjm/.emacs} file:
-
-@lisp
-(add-to-list 'load-path "/home/mjm/elisp")
-(autoload 'sml-mode "sml-mode" "Major mode for editing SML." t)
-(autoload 'run-sml "sml-proc" "Run an inferior SML process." t)
-@end lisp
-
-@noindent
-The first line adjusts Emacs' internal search path so it can locate the
-Lisp source you have copied to that directory; the second and third
-lines tell Emacs to load the code automatically when it is needed. You
-can then switch any Emacs buffer into SML mode by entering the command
-
-@example
-M-x sml-mode
-@end example
-
-@noindent
-It is usually more convenient to have Emacs automatically place the
-buffer in SML mode whenever you visit a file containing ML
-programs. The simplest way of achieving this is to put something like
-
-@lisp
-(add-to-list 'auto-mode-alist '("\\.\\(sml\\|sig\\)\\'" . sml-mode))
-@end lisp
-
-@noindent
-also in your @file{.emacs} file. Subsequently (after a restart), any
-files with these extensions will be placed in SML mode buffers when
-you visit them.
-
-
-You may want to pre-compile the @file{sml-*.el} files (@kbd{M-x
-byte-compile-file}) for greater speed---byte compiled code loads and
-runs somewhat faster.
-
-
-@c ======================================================== GETTING HELP
-
-@node Getting Help, , Getting Started, Introduction
-
-@section Help!
-
-@c == Getting Help, , Getting Started, Introduction ====================
-
-
-@noindent
-You're reading it. Apart from the on-line info tree (@kbd{C-h i} is the
-Emacs key to enter the @code{info} system---you should follow the brief
-tutorial if this is unfamiliar), there are further details on specific
-commands in their documentation strings. Only the most useful
-SML mode commands are documented in the info tree: to find out more
-use Emacs' help facilities.
-
-Briefly, to get help on a specific function use @kbd{C-h f} and enter
-the command name. All (almost all, then) SML mode commands begin
-with @code{sml-}, so if you type this and press @key{TAB} (for
-completion) you will get a list of all commands. Another way is to use
-@kbd{C-h a} and enter the string @code{sml}. This is command apropos; it
-will list all commands with that sub-string in their names, and any key
-binding they may have in the current buffer. Command apropos gives a
-one-line synopsis of what each command does.
-
-Some commands are also variables---such things are allowed in Lisp, if
-not in ML! @xref{Command Index}, for a list of (info) documented
-functions. @xref{Variable Index}, for a list of user settable variables
-to control the behaviour of SML mode.
-
-Before accessing this information on-line from within Emacs you may have
-to set the variable @code{sml-mode-info}. Put in your @file{.emacs} file
-something like:
-
-@vindex sml-mode-info
-@findex sml-mode-info
-@kindex @kbd{C-c C-i}
-@lisp
-(setq sml-mode-info "/home/mjm/info/sml-mode.info")
-@end lisp
-
-@noindent
-When different from the default this variable should be a string giving
-the absolute name of the @file{.info} file. Then @kbd{C-c C-i} in
-SML mode (i.e., the command @kbd{M-x sml-mode-info}) will bring up
-the manual. This help is also accessible from the menu. (Resetting this
-variable will not be necessary if your site administrator has been kind
-enough to install SML mode and its attendant documentation in the
-Emacs hierarchy.)
-
-
-@c ============================================================ SML MODE
-
-@node SML Mode, Interaction Mode, Introduction, Top
-
-@chapter Editing with SML Mode
-
-@c == SML Mode, Interaction Mode, Introduction, Top ====================
-
-
-@noindent
-Now SML mode provides just a few additional editing commands. Most of
-the work has gone into implementing the indentation algorithm which, if
-you think about it, has to be complicated for a language like
-ML. @xref{SML Mode Defaults,,Indentation Defaults}, for details on how
-to control some of the behaviour of the indentation algorithm. Principal
-goodies are the `electric pipe' feature, and the ability to insert
-common SML forms (macros or templates).
-
-@menu
-* Basics:: On entering SML mode
-* Indentation:: Prettying SML text
-* Magic Insertion:: Templates and electric keys
-* SML Mode Defaults:: Variables controlling indentation
-@end menu
-
-
-@c ============================================================== BASICS
-
-@node Basics, Indentation, SML Mode, SML Mode
-
-@section On entering SML mode
-
-@c == Basics, Indentation, SML Mode, SML Mode ==========================
-
-@noindent
-
-
-@deffn Command sml-mode
-This switches a buffer into SML mode. This is a @emph{major mode} in
-Emacs. To get out of SML mode the buffer's major mode must be set to
-something else, like @t{text-mode}. @xref{Getting Started}, for details
-on how to set this up automatically when visiting an SML file.
-@end deffn
-
-Emacs is all hooks of course. A hook is a variable: if the variable is
-non-nil it binds a list of Emacs Lisp functions to be run in some order
-(usually left to right). You can customise SML mode with these
-hooks:
-
-
-@defvr Hook sml-mode-hook
-Default: @code{nil}
-
-This is run every time a new SML mode buffer is created (or if you
-type @kbd{M-x sml-mode}). This is one place to put your preferred key
-bindings. @xref{Configuration}, for some examples.
-@end defvr
-
-
-@c ========================================================= INDENTATION
-
-@node Indentation, Magic Insertion, Basics, SML Mode
-
-@section Automatic indentation
-
-@c == Indentation, Magic Insertion, Basics, SML Mode ===================
-
-
-@noindent
-ML is a complicated language to parse, let alone compile. The
-indentation algorithm is a little wooden (for some tastes), and the best
-advice is not to fight it! There are several variables that can be
-adjusted to control the indentation algorithm (@pxref{SML Mode
-Defaults,,Customising SML Mode}, below).
-
-
-@deffn Command indent-for-tab-command
-Key: @key{TAB}
-@kindex @key{TAB}
-
-This command indents the current line. If you set the indentation of the
-previous line by hand, @code{indent-for-tab-command} will indent relative to
-this setting.
-@end deffn
-
-
-@deffn Command indent-region
-Key: @kbd{C-M-\}
-@kindex @kbd{C-M-\}
-
-Indent the current region. Be patient if the region is large (like the
-whole buffer).
-@end deffn
-
-
-@deffn Command sml-back-to-outer-indent
-Key: @kbd{M-@key{TAB}}
-@kindex @kbd{M-@key{TAB}}
-
-Unindents the line to the next outer level of indentation.
-@end deffn
-
-
-
-Further indentation commands that Emacs provides (generically, for all
-modes) that you may like to recall:
-
-@itemize @minus
-@item
-@kbd{M-x newline-and-indent}
-
-On @key{LFD} by default.
-@kindex @key{LFD}
-Insert a newline, then indent according to the major mode. @xref{Program
-Indent,,Indentation for Programs,emacs,The Emacs Editor Manual}, for
-details.
-
-@item
-@kbd{M-x indent-rigidly}
-
-On @kbd{C-x @key{TAB}} by default.
-@kindex @kbd{C-x @key{TAB}}
-Moves all lines in the region right by its argument (left, for negative
-arguments). @xref{Indentation,,,emacs,The Emacs Editor Manual}.
-
-@item
-@kbd{M-x indent-for-comment}
-
-On @kbd{M-;} by default.
-@kindex @kbd{M-;}
-Indent this line's comment to comment column, or insert an empty
-comment. @xref{Comment Commands,,,emacs,The Emacs Editor
-Manual}.
-
-@item
-@kbd{M-x indent-new-comment-line}
-
-On @kbd{M-@key{LFD}} by default.
-@kindex @kbd{M-@key{LFD}}
-Break line at point and indent, continuing comment if within one.
-@xref{Multi-Line Comments,,,emacs,The Emacs Editor Manual}.
-@end itemize
-
-@kindex @kbd{C-x ;}
-As with other language modes, @kbd{M-;} gives you a comment at the end
-of the current line. The column where the comment starts is determined
-by the variable @code{comment-column}---default is 40, but it can be
-changed with @code{set-comment-column} (on @kbd{C-x ;} by default).
-
-
-@c ===================================================== MAGIC INSERTION
-
-@node Magic Insertion, SML Mode Defaults, Indentation, SML Mode
-
-@section Electric features
-
-@c == Magic Insertion, SML Mode Defaults, Indentation, SML Mode ========
-
-
-@noindent
-Electric keys are generally pretty irritating, so those provided by
-SML mode are fairly muted. The only truly electric key is @kbd{;},
-and this has to be enabled to take effect.
-
-
-@deffn Command sml-electric-pipe
-Key: @kbd{M-|}
-@kindex @kbd{M-|}
-
-When the point is in a `case' statement this opens a new line, indents
-and inserts @code{| =>} leaving point just before the double arrow; if
-the enclosing construct is a `fun' declaration, the newline is indented
-and the function name copied at the appropriate column. Generally, try
-it whenever a @code{|} is wanted---you'll like it!
-@end deffn
-
-@deffn Command sml-electric-space
-Key: @kbd{M-SPC}
-@kindex @kbd{M-SPC}
-
-When the point is after a keyword like `let', this inserts the
-corresponding predefined skeleton if one exists. Else it just inserts a
-space. Another way to insert those skeletons is to use
-@code{sml-insert-form}, described below.
-@end deffn
-
-@deffn Command sml-insert-form
-Key: @kbd{C-c @key{RET}}
-@kindex @kbd{C-c @key{RET}}
-
-Interactive short-cut to insert common ML forms (a.k.a.@: macros, or
-templates). Recognised forms are `let', `local', `case', `abstype',
-`datatype', `signature', `structure', and `functor'. Except for `let'
-and `local', these will prompt for appropriate parameters like functor
-name and signature, etc.. This command prompts in the mini-buffer, with
-completion.
-
-By default @kbd{C-c @key{RET}} will insert at point, with the
-indentation of the current column; if you give a prefix argument (i.e.,
-@kbd{C-u C-c @key{RET}}) the command will insert a newline first,
-indent, and then insert the template.
-@end deffn
-
-@code{sml-insert-form} is also extensible: see @ref{Configuration} for
-further details.
-
-
-
-@c ======================================================= MODE DEFAULTS
-
-@node SML Mode Defaults, , Magic Insertion, SML Mode
-
-@section Indentation defaults
-
-@c == SML Mode Defaults, , Magic Insertion, SML Mode ===================
-
-
-@noindent
-Several variables try to control the indentation algorithm and other
-features of SML mode. Most of them are still in flux so they are not
-described here yet.
-If the default values are not acceptable you can set these variables
-permanently in your @file{.emacs} file. @xref{Configuration}, for
-details and examples.
-
-
-@defvr Variable sml-indent-level
-@findex sml-indent-level
-Default: @code{4}
-
-This variable controls the block indentation level.
-@end defvr
-
-@c end vtable
-
-
-@c ========================================================= INTERACTION
-
-@node Interaction Mode, Configuration, SML Mode, Top
-
-@chapter Running ML under Emacs
-
-@c == Interaction Mode, Configuration, SML Mode, Top ===================
-
-
-@noindent
-The most useful feature of SML mode is that it provides a convenient
-interface to the compiler. How serious users of ML put up with a
-teletype interface to the compiler is beyond me@.@.@. but perhaps there
-are other interfaces to compilers that require one to part with serious
-money. Such remarks can quickly become dated---in this case, let's hope
-so!
-
-Anyway, SML mode provides an interaction mode,
-@code{inferior-sml-mode}, where the compiler runs in a separate buffer
-in a window or frame of its own. You can use this buffer just like a
-terminal, but it's usually more convenient to mark some text in the
-SML mode buffer and have Emacs communicate with the sub-process. The
-features discussed below are syntax-independent, so they should work
-with a wide range of ML-like tools and compilers. @xref{Process
-Defaults}, for some hints.
-
-@findex inferior-sml-mode
-@code{inferior-sml-mode} is a specialisation of the @file{comint}
-package that comes with Emacs and XEmacs.
-
-
-@menu
-* Running ML:: Commands to run the ML compiler in a buffer
-* ML Interaction:: Sending program fragments to the compiler
-* Tracking Errors:: Finding reported syntax errors
-* Process Defaults:: Setting defaults for process interaction
-@end menu
-
-
-
-@c ========================================================== RUNNING ML
-
-@node Running ML, ML Interaction, Interaction Mode, Interaction Mode
-
-@section Starting the compiler
-
-@c == Running ML, ML Interaction, Interaction Mode, Interaction Mode ==
-
-@noindent
-Start your favourite ML compiler with the command
-
-@example
-@kbd{M-x run-sml}
-@end example
-
-@noindent
-This creates a process interaction buffer that inherits some key
-bindings from SML mode and from @file{comint} (@pxref{Shell Mode, ,
-, emacs, The Emacs Editor Manual}). Starting the ML compiler adds some
-functions to SML mode buffers so that program text can be
-communicated between editor and compiler (@pxref{ML Interaction}).
-
-The name of the ML compiler is the first thing you should know how to
-specify:
-
-
-@defvar sml-program-name
-Default: @code{"sml"}
-
-The program to run as ML. You might need to specify the full path name
-of the program.
-@end defvar
-
-
-@defvar sml-default-arg
-Default: @code{""}
-
-Useful for Poly/ML users who may supply a database file, or others who
-have wrappers for setting various options around the command to run the
-compiler. Moscow ML people might set this to @code{"-P full"}, etc..
-@end defvar
-
-The variable @code{sml-program-name} is a string holding the name
-of the program @emph{as you would type it at the shell}. You
-can always choose a program different to the default by invoking
-
-@example
-@kbd{C-u M-x run-sml}
-@end example
-
-@noindent
-With the prefix argument Emacs will prompt for the command name and any
-command line arguments to pass to the compiler. Thereafter Emacs will
-use this new name as the default, but for a permanent change you should
-set this in your @file{.emacs} with, e.g.:
-
-@lisp
-(setq sml-program-name "nj-sml")
-@end lisp
-
-
-@deffn Command run-sml
-Launches ML as an inferior process in another buffer; if an ML process
-already exists, just switch to the process buffer. A prefix argument
-allows you to edit the command line to specify the program, and any
-command line options.
-@end deffn
-
-
-@defvr Hook inferior-sml-mode-hook
-Default: @code{nil}
-
-@kbd{M-x run-sml} runs @code{comint-mode-hook} and
-@code{inferior-sml-mode-hook} hooks in that order, but @emph{after} the
-compiler is started. Use @code{inferior-sml-mode-hook} to set any
-@code{comint} buffer-local configurations for SML mode you like.
-@end defvr
-
-
-@deffn Command switch-to-sml
-Key: @kbd{C-c C-s}
-@kindex @kbd{C-c C-s}
-
-Switch from the SML buffer to the interaction buffer. By default point
-will be placed at the end of the process buffer, but a prefix argument
-will leave point wherever it was before. If you try @kbd{C-c C-s} before
-an ML process has been started, you'll just get an error message to the
-effect that there's no current process buffer.
-@end deffn
-
-
-@deffn Command sml-cd
-When started, the ML compiler's default working directory is the
-current buffer's default directory. This command allows the working
-directory to be changed, if the compiler can do this. The variable
-@code{sml-cd-command} specifies the compiler command to invoke
-(@pxref{Process Defaults}).
-@end deffn
-
-
-@c ======================================================== SENDING TEXT
-
-@node ML Interaction, Tracking Errors, Running ML, Interaction Mode
-
-@section Speaking to the compiler
-
-@c == ML Interaction, Tracking Errors, Running ML, Interaction Mode ====
-
-
-@noindent
-Several commands are defined for sending program fragments to the
-running compiler. Each of the following commands takes a prefix argument
-that will switch the input focus to the process buffer afterwards
-(leaving point at the end of the buffer):
-
-
-@deffn Command sml-load-file
-Key: @kbd{C-c C-l}
-@kindex @kbd{C-c C-l}
-
-Send a `use file' command to the current ML process. The variable
-@code{sml-use-command} is used to define the correct template for the
-command to invoke (@pxref{Process Defaults}). The default file is the
-file associated with the current buffer, or the last file loaded if you
-are in the interaction buffer.
-@end deffn
-
-
-
-@deffn Command sml-send-region
-@findex sml-send-region-and-go
-Key: @kbd{C-c C-r}
-@kindex @kbd{C-c C-r}
-
-Send the current region of text in the SML buffer.
-@code{sml-send-region-and-go} is a similar command for you to bind in
-SML mode if you wish: it'll send the region and then switch-to-sml.
-@end deffn
-
-@c @deffn Command sml-send-function
-@c @findex sml-send-function-and-go
-
-@c Send the enclosing `function' definition. Contrary to the suggestive
-@c name, this command @emph{does not} try to determine the extent of the
-@c function definition because that is too difficult with ML. Instead
-@c this just sends the enclosing @emph{paragraph} (delimited by blank
-@c lines or form-feed characters).
-@c @end deffn
-
-@deffn Command sml-send-buffer
-Key: @kbd{C-c C-b}
-@kindex @kbd{C-c C-b}
-
-Send the contents of the current buffer to ML.
-@end deffn
-
-@c ===================================================== TRACKING ERRORS
-
-@node Tracking Errors, Process Defaults, ML Interaction, Interaction Mode
-
-@section Finding errors
-
-@c == Tracking Errors, Process Defaults, ML Interaction, Interaction Mode
-
-
-@noindent
-SML mode provides one customisable function for locating the source
-position of errors reported by the compiler. This should work whether
-you type @code{use "puzzle.sml";} into the interaction buffer, or use
-one of the mechanisms provided for sending programs directly to the
-compiler---@pxref{ML Interaction}.
-
-
-@deffn Command next-error
-@findex next-error
-Key: @kbd{C-x`}
-@kindex @kbd{C-x`}
-
-Jump to the source location of the next error reported by the compiler.
-All the usual error-navigation commands are available, see
-@pxref{Compilation Mode, , , emacs, The Emacs Editor Manual}.
-@end deffn
-
-
-@c ==================================================== PROCESS DEFAULTS
-
-@node Process Defaults, , Tracking Errors, Interaction Mode
-
-@section Process defaults
-
-@c == Process Defaults, , Tracking Errors, Interaction Mode ============
-
-@noindent
-The process interaction code is independent of the compiler used,
-deliberately, so SML mode will work with a variety of ML compilers
-and ML-based tools. There are therefore a number of variables that may
-need to be set correctly before SML mode can speak to the compiler.
-Things are by default set up for Standard ML of New Jersey, but
-switching to a new system is quite easy.
-
-
-
-@defvar sml-use-command
-Default: @code{"use \"%s\""}
-
-Use file command template. Emacs will replace the @code{%s} with a file
-name. Note that Emacs requires double quote characters inside strings
-to be quoted with a backslash.
-@end defvar
-
-
-@defvar sml-cd-command
-Default: @code{"OS.FileSys.chDir \"%s\""}
-
-Compiler command to change the working directory. Not all ML systems
-support this feature (well, Edinburgh (core) ML didn't), but they
-should.
-@end defvar
-
-
-@defvar sml-prompt-regexp
-Default: @code{"^[-=>#] *"}
-
-Matches the ML compiler's prompt: @file{comint} uses this for various
-purposes.
-@end defvar
-
-
-To customise error reportage for different ML compilers you need to set
-two further variables before @code{next-error} can be useful:
-
-
-@defvar sml-error-regexp-alist
-
-Alist that specifies how to match errors in compiler output.
-Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...])
-If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and
-the LINE-IDX'th subexpression gives the line number. If COLUMN-IDX is
-given, the COLUMN-IDX'th subexpression gives the column number on that line.
-If any FILE-FORMAT is given, each is a format string to produce a file name to
-try; %s in the string is replaced by the text matching the FILE-IDX'th
-subexpression.
-@end defvar
-
-
-@c A typical way of (re)setting these variables correctly is to put
-@c something in your @file{.emacs} file that resembles
-
-@c @example
-@c (setq sml-use-command "PolyML.use \"%s\"")
-@c (setq sml-prompt-regexp "^[>#] *")
-@c @end example
-
-@c ======================================================= CONFIGURATION
-
-@node Configuration, , Interaction Mode, Top
-
-@chapter Configuration Summary
-
-@c @footnote{@url{http://www.ahl.co.uk/}}
-@c @footnote{@url{http://www.dina.kvl.dk/~sestoft/mosml.html}}
-
-@noindent
-This (sort of pedagogic) section gives more information on how to
-configure SML mode: menus, key bindings, hooks and highlighting are
-discussed, along with a few other random topics.
-
-@menu
-* Hooks:: Creating them
-* Key Bindings:: Binding commands to keys
-* Highlighting:: Syntax colouring
-* Advanced Topics:: You may need to speak Emacs Lisp
-@end menu
-
-
-@c =============================================================== HOOKS
-
-@node Hooks, Key Bindings, Configuration, Configuration
-
-@section Hooks
-
-@c == Hooks, Key Bindings, Configuration, Configuration ================
-
-
-@noindent
-One way to set SML mode variables (@pxref{SML Mode
-Defaults,,Indentation Defaults}), and other defaults, is through the
-@code{sml-mode-hook} in your @file{.emacs}. A simple example:
-
-@lisp
-(defun my-sml-mode-hook () "Local defaults for SML mode"
- (setq sml-indent-level 2) ; conserve on horizontal space
- (setq words-include-escape t) ; \ loses word break status
- (setq indent-tabs-mode nil)) ; never ever indent with tabs
-(add-hook 'sml-mode-hook #'my-sml-mode-hook)
-@end lisp
-@noindent
-The body of @code{my-sml-mode-hook} is a sequence of assignments. In this
-case it is not really necessary to set @code{sml-indent-level} in a hook
-because this variable is global (most SML mode variables are). With
-similar effect:
-
-@lisp
-(setq sml-indent-level 2)
-@end lisp
-@noindent
-anywhere in your @file{.emacs} file. The variable @code{indent-tabs-mode} is
-automatically made local to the current buffer whenever it is set
-explicitly, so it @emph{must} be set in a hook if you always want
-SML mode to behave like this.
-
-Another hook is @code{inferior-sml-mode-hook}. This can be used to
-control the behaviour of the interaction buffer through various
-variables meaningful to @file{comint}-based packages:
-
-@lisp
-(defun my-inf-sml-mode-hook () "Local defaults for inferior SML mode"
- (add-hook 'comint-output-filter-functions 'comint-truncate-buffer)
- (setq comint-scroll-show-maximum-output t)
- (setq comint-input-autoexpand nil))
-(add-hook 'inferior-sml-mode-hook 'my-inf-sml-mode-hook)
-@end lisp
-@noindent
-Again, the body is a sequence of assignments. Unless you run several ML
-compilers simultaneously under one Emacs, this hook will normally only
-get run once. You might want to look up the documentation (@kbd{C-h v}
-and @kbd{C-h f}) for these buffer-local @code{comint} things.
-
-
-@c ======================================================== Key Bindings
-
-@node Key Bindings, Highlighting, Hooks, Configuration
-
-@section Key bindings
-
-@noindent
-Customisation (in Emacs) usually entails putting favourite commands on
-easily remembered keys. Two `keymaps' are defined in SML mode: one
-is effective in program text buffers (@code{sml-mode-map}) and the other
-is effective in interaction buffers (@code{inferior-sml-mode-map}).
-The initial design ensures that (many of) the default key bindings from
-the former keymap will also be available in the latter (e.g.,
-@kbd{C-c`}).
-
-Type @kbd{C-h m} in an SML mode buffer to find the default key
-bindings (and similarly in an ML interaction buffer), and use the hooks
-provided to install your preferred key bindings. Given that the keymaps
-are global (variables):
-
-@lisp
-(defun my-sml-mode-hook () "Global defaults for SML mode"
- (define-key sml-mode-map "\C-cd" 'sml-cd))
-(add-hook 'sml-mode-hook 'my-sml-mode-hook)
-@end lisp
-@noindent
-This has the effect of binding @code{sml-cd} to the key @kbd{C-c d}.
-If you want the same behaviour from @kbd{C-c d} in the ML buffer:
-
-@lisp
-(defun my-inf-sml-mode-hook () "Global defaults for inferior SML mode"
- (define-key inferior-sml-mode-map "\C-cd" 'sml-cd)
- ;; NB. for SML/NJ '96
- (setq sml-cd-command "OS.FileSys.chDir \"%s\""))
-(add-hook 'inferior-sml-mode-hook 'my-inf-sml-mode-hook)
-@end lisp
-
-There is nothing to stop you rebuilding the entire keymap for
-SML mode and the ML interaction buffer in your @file{.emacs} of
-course: SML mode won't define @code{sml-mode-map} or
-@code{inferior-sml-mode-map} if you have already done so.
-
-
-@c ======================================================== Highlighting
-
-@node Highlighting, Advanced Topics, Key Bindings, Configuration
-
-@section Syntax colouring
-
-
-@noindent
-Highlighting is very handy for picking out keywords in the program text,
-spotting misspelled kewyords, and, if you have Emacs' @file{ps-print}
-package installed (you usually do these days), obtaining pretty, even
-colourful code listings---quite properly for your colourful ML programs.
-
-The indentation scheme (strangely enough) also relies on the
-highlighting code to properly handle nested comments, which is yet
-another reason to turn on highlighting. To turn on highlighting,
-use either of:
-
-@lisp
-M-x font-lock-mode
-(add-hook 'sml-mode-hook 'turn-on-font-lock)
-(global-font-lock-mode 1)
-@end lisp
-
-The first will turn it on in the current buffer.
-The second will turn it on in all sml-mode buffers.
-The last will turn it on everywhere.
-This is valid for Emacs but maybe not for XEmacs. Check font-lock
-documentation if you encounter problems.
-
-@c ===================================================== ADVANCED TOPICS
-
-@node Advanced Topics, , Highlighting, Configuration
-
-@section Advanced Topics
-
-@flushright
-@emph{These forms are bloody useless; can't we have better ones?}
-@end flushright
-
-@sp 1
-@noindent
-You can indeed. @code{sml-insert-form} is extensible so all you need to
-do is create the macros yourself. Define a @emph{keybord macro}
-(@kbd{C-x (} <something> @kbd{C-x )}) and give it a suitable name:
-@code{sml-addto-forms-alist} prompts for a name, say @code{NAME}, and
-binds the macro @code{sml-form-NAME}. Thereafter @kbd{C-c @key{RET}
-NAME} will insert the macro at point, and @kbd{C-u C-c @key{RET} NAME}
-will insert the macro after a @code{newline-and-indent}. If you want to
-keep your macros from one editing session to the next, go to your
-@file{.emacs} file and call @code{insert-kbd-macro}; you'll need
-to add @code{NAME} to @code{sml-forms-alist} permanently yourself:
-
-@lisp
-(defun my-sml-mode-hook () "Global defaults for SML mode"
- ;; whatever else you do
- (add-to-list 'sml-forms-alist '("NAME" . FUNCTION)))
-@end lisp
-
-If you want to create templates like `case' that prompt for parameters
-you'll have to do some Lisp programming. The @code{skeleton} package is
-a good stating point. Better yet, you can reuse the wrappers used by
-sml-mode itself in your sml-mode-hook:
-
-@lisp
-(add-hook 'sml-mode-hook
- (lambda ()
- (sml-def-skeleton "case" "Case expr: "
- str " of" \n _ " => ")))
-@end lisp
-
-This will redefine `case' in order to leave the `of' on the first line.
-See the documentation of @code{skeleton-insert} to get a better
-understanding of how this works.
-
-@sp 1
-@flushright
-@emph{I hate that indentation algorithm; can't I tweak it?}
-@end flushright
-
-@sp 1
-@noindent
-Ah, yes, of course, but this manual will not tell you how.
-
-
-@sp 1
-@flushright
-@emph{Can SML mode handle more than one compiler running at once?}
-@end flushright
-
-Sure, just rename the @samp{*sml*} buffer and then use @code{run-sml}
-as usual.
-
-@sp 1
-@flushright
-@emph{What needs to be done to support other ML compilers?}
-@end flushright
-
-@sp 1
-@noindent
-Not much really. Just add the right regular expressions to
-@code{sml-error-regexp-alist} and that should be all.
-
-
-@c ======================================================= COMMAND INDEX
-
-@headings singleafter
-
-@node Command Index, Variable Index, , Top
-
-@unnumbered Command Index
-
-@printindex fn
-
-@c ====================================================== VARIABLE INDEX
-
-@c node Variable Index, , Command Index, Top
-@node Variable Index, Key Index, Command Index, Top
-
-@unnumbered Variable Index
-
-@c == Variable Index, Key Index, Command Index, Top ====================
-
-@printindex vr
-
-@c =========================================================== KEY INDEX
-
-@node Key Index, , Variable Index, Top
-
-@unnumbered Key Index
-
-@c == Key Index, , Variable Index, Top =================================
-
-@printindex ky
-
-@contents
-@bye
diff --git a/packages/sml-mode/testcases.sml b/packages/sml-mode/testcases.sml
deleted file mode 100644
index 671aa4c..0000000
--- a/packages/sml-mode/testcases.sml
+++ /dev/null
@@ -1,616 +0,0 @@
-(* Copyright 1999-2020 Stefan Monnier <monnier@gnu.org> *)
-
-(* sml-mode here treats the second `=' as an equal op because it
- * thinks it's seeing something like "... type t = (s.t = ...)". FIXME! *)
-functor foo (structure s : S) where type t = s.t =
-struct (* fixindent *)
-val bar = fn a1 a2 a3
- a5 a6
- a4 => 1
-val rec bar =
- fn a1 a2 a3
- a5 a6 a4 => 1
-val bar =
- fn a1 a2 a3
- a5 a6
- a4 => (1
- ;(
- w
- ,
- s
- ,
- s
- , s , a ,
- a
- , s , a ,
- a
- )
- ;(
- w
- ,s
- ,a
- )
- ;(
- w
- , s
- , a
- )
- ;( w
- , s
- , a
- )
- ;( w
- ,s
- ,a
- )
- ;3
- + a
- * 4
- + let val x = 3
- in toto
- end
- + if a then
- b
- else
- c
- ;4)
-
-structure Attrs : sig
- type t
- datatype node
- = Attributes of string list
- include WRAPPED
- sharing type node' = node
- sharing type obj = t
- end
-
-functor DoWrap1(type node) : S = struct
-type t = node Wrap.t
-open Wrap
-type node' = node
-type obj = t
-end
-
-fun test1 None =
- 4
- | test1 (Some x) =
- 5
-
-datatype exp_node
- = Let of varpat_t list * rhs_t * exp_t
- | Do of simpleexp_t * exp_t
- | FunExp of fundef_t list * exp_t
- | ContExp of BomId.t * varpat_t list option * exp_t * exp_t
- | If of simpleexp_t * exp_t * exp_t
- | Case of simpleexp_t * caserule_t list
- | Typecase of TyParam.t * tycaserule_t list
- | Apply of LongValueId.t * simpleexp_t list option * simpleexp_t list option
- | Throw of BomId.t * tyargs_t option * simpleexp_t list option
- | Return of simpleexp_t list option
-and rhs_node
- = Composite of exp_t
- | Simple of simpleexp_t
-
-withtype type_t = type_node Wrap.t
- and tyargs_t = tyargs_node Wrap.t
-
-functor DoWrap(type node) : sig
- type t = node Wrap.t
- include WRAPPED
- sharing type node' = node
- sharing type obj = t
- end =
-struct
-type t = node Wrap.t
-open Wrap
-type node' = node
-type obj = t
-end
-
-val ber = 1;
-val sdfg = 1
-val tut = fn (x,y) z y e r =>
- body
-val tut = fn (x,y) => fn z y => fn e r =>
- body
-val tut = fn (x,y)
- z
- y e
- r =>
- body
-val tut =
- (let
- local
- val x = 1 in val x = x end
- val a = 1 val b = 2
- local val x = 1 in val x = x end
- local val x = 1 in val x = x end
- local val x = 1 in val x = x end (* fixindent *)
- local val x = 1 in val x = x end
- val c = 3
- in
- let
- val x = 3
- in
- x + a * b
- * c
- end
- end)
-
-val x =
- (* From "Christopher Dutchyn" <cdutchyn@cs.ubc.ca> *)
- (case foo of
- (* This is actually not valid SML anyway. *)
- | BAR => baz
- | BAR => baz)
-
-
-val x =
- (x := 1;
- x := 2;
- (* Testing obedience to user overrides: *)
- x := 3; (* fixindent *)
- case x of
- FOO => 1
- | BAR =>
- 2;
- case x of
- FOO => 1
- | BAR =>
- case y of
- FAR => 2
- | FRA => 3;
- hello);
-
-datatype foobar
- = FooB of int
- | FooA of bool * int
-and baz = QUX of foo
-datatype foo = FOO | BAR of baz
- and baz = BAZ | QUUX of foo
-
-fun toto = if a
- then
- b
- else c
-
-datatype foo = FOO
- | BAR of baz
- and baz = BAZ (* fixindent *)
- | QUUX of foo
- and b = g
-
-datatype foo = datatype M.foo
-val _ = 42 val x = 5
-
-signature S = S' where type foo = int
-val _ = 42
-
-val foo = [
- "blah"
- , let val x = f 42 in g (x,x,44) end
-]
-
-val foo = [
- "blah",
- let val x = f 42 in g (x,x,44) end
-]
-
-val foo =
- [
- "blah",
- let val x = f 42 in g (x,x,44) end
- ]
-
-val foo = [ "blah"
- , let val x = f 42 in g (x,x,44) end
- , foldl (fn ((p,q),s) => g (p,q,Vector.length q) ^ ":" ^ s)
- "" (Beeblebrox.masterCountList mlist2)
- , if null mlist2 then ";" else ""
- ]
-
-fun foo (true::rest) = 1 + 2 * foo rest
- | foo (false::rest)
- = let val _ = 1 in 2 end
- + 2
- * foo rest
-
-val x = if foo then
- 1
- else if bar then
- 2
- else
- 3
-val y = if foo
- then 1
- else if foo
- then 2 (* Could also be indented by a basic offset. *)
- else 3
-
-val yt = 4
-
-val x =
- (if a then b else c;
- case M.find(m,f)
- of SOME(fl, filt) =>
- F.APP(F.VAR fl, OU.filter filt vs)
- | NONE
- => le
- | NONE =>
- le
- | NONE => le;
- x := x + 1;
- (case foo
- of a => f
- ))
-
-val y = (
- let fun f1 =
- let fun g1 x = 2
- fun g2 y = 4
- local fun toto y = 1
- (* val x = 5 *)
- in
- fun g3 z = z
- end
- in toto
- end
- in a;( ( let
- val f =1
- in
- toto
- end
- )
- )
- foo("(*")
- * 2;
- end;
-
- let
- in a
- ; b
- end;
-
- let
- in
- a +
- b +
- c
- ; b
- end;
-
- let
- in if a then
- b
- else
- c
- end;
-
- let
- in case a of
- F => 1
- | D => 2
- end;
-
- let
- in case a
- of F => 1
- | D => 2
- end;
-
- let
- in if a then b else
- c
- end;
-
- let
- in if a then b
- else
- c
- end)
-end;
-
-structure Foo = struct
-val x = 1
-end
-
-structure Foo = struct val x = 1
- end
-
-signature FSPLIT =
-sig
- type flint = FLINT.prog
- val split: flint -> flint * flint option
-end
-
-structure FSplit :> FSPLIT =
-struct
-
-local
- structure F = FLINT
- structure S = IntRedBlackSet
- structure M = FLINTIntMap
- structure O = Option
- structure OU = OptUtils
- structure FU = FlintUtil
- structure LT = LtyExtern
- structure PO = PrimOp
- structure PP = PPFlint
- structure CTRL = FLINT_Control
-in
-
-val say = Control_Print.say
-fun bug msg = ErrorMsg.impossible ("FSplit: "^msg)
-fun buglexp (msg,le) = (say "\n"; PP.printLexp le; say " "; bug msg)
-fun bugval (msg,v) = (say "\n"; PP.printSval v; say " "; bug msg)
-fun assert p = if p then () else bug ("assertion failed")
-
-type flint = F.prog
-val mklv = LambdaVar.mkLvar
-val cplv = LambdaVar.dupLvar
-
-fun S_rmv(x, s) = S.delete(s, x) handle NotFound => s
-
-fun addv (s,F.VAR lv) = S.add(s, lv)
- | addv (s,_) = s
-fun addvs (s,vs) = foldl (fn (v,s) => addv(s, v)) s vs
-fun rmvs (s,lvs) = foldl (fn (l,s) => S_rmv(l, s)) s lvs
-
-exception Unknown
-
-fun split (fdec as (fk,f,args,body)) = let
- val {getLty,addLty,...} = Recover.recover (fdec, false)
-
- val m = Intmap.new(64, Unknown)
- fun addpurefun f = Intmap.add m (f, false)
- fun funeffect f = (Intmap.map m f) handle Uknown => true
-
-(* sexp: env -> lexp -> (leE, leI, fvI, leRet)
- * - env: IntSetF.set current environment
- * - lexp: lexp expression to split
- * - leRet: lexp the core return expression of lexp
- * - leE: lexp -> lexp recursively split lexp: leE leRet == lexp
- * - leI: lexp option inlinable part of lexp (if any)
- * - fvI: IntSetF.set free variables of leI: FU.freevars leI == fvI
- *
- * sexp splits the lexp into an expansive part and an inlinable part.
- * The inlinable part is guaranteed to be side-effect free.
- * The expansive part doesn't bother to eliminate unused copies of
- * elements copied to the inlinable part.
- * If the inlinable part cannot be constructed, leI is set to F.RET[].
- * This implies that fvI == S.empty, which in turn prevents us from
- * mistakenly adding anything to leI.
- *)
-fun sexp env lexp = (* fixindent *)
- let
- (* non-side effecting binds are copied to leI if exported *)
- fun let1 (le,lewrap,lv,vs,effect) =
- let val (leE,leI,fvI,leRet) = sexp (S.add(env, lv)) le
- val leE = lewrap o leE
- in if effect orelse not (S.member(fvI, lv))
- then (leE, leI, fvI, leRet)
- else (leE, lewrap leI, addvs(S_rmv(lv, fvI), vs), leRet)
- end
-
- in case lexp
- (* we can completely move both RET and TAPP to the I part *)
- of F.RECORD (rk,vs,lv,le as F.RET [F.VAR lv']) =>
- if lv' = lv
- then (fn e => e, lexp, addvs(S.empty, vs), lexp)
- else (fn e => e, le, S.singleton lv', le)
- | F.RET vs =>
- (fn e => e, lexp, addvs(S.empty, vs), lexp)
- | F.TAPP (F.VAR tf,tycs) =>
- (fn e => e, lexp, S.singleton tf, lexp)
-
- (* recursive splittable lexps *)
- | F.FIX (fdecs,le) => sfix env (fdecs, le)
- | F.TFN (tfdec,le) => stfn env (tfdec, le)
-
- (* binding-lexps *)
- | F.CON (dc,tycs,v,lv,le) =>
- let1(le, fn e => F.CON(dc, tycs, v, lv, e), lv, [v], false)
- | F.RECORD (rk,vs,lv,le) =>
- let1(le, fn e => F.RECORD(rk, vs, lv, e), lv, vs, false)
- | F.SELECT (v,i,lv,le) =>
- let1(le, fn e => F.SELECT(v, i, lv, e), lv, [v], false)
- | F.PRIMOP (po,vs,lv,le) =>
- let1(le, fn e => F.PRIMOP(po, vs, lv, e), lv, vs, PO.effect(#2 po))
-
- (* IMPROVEME: lvs should not be restricted to [lv] *)
- | F.LET(lvs as [lv],body as F.TAPP (v,tycs),le) =>
- let1(le, fn e => F.LET(lvs, body, e), lv, [v], false)
- | F.LET (lvs as [lv],body as F.APP (v as F.VAR f,vs),le) =>
- let1(le, fn e => F.LET(lvs, body, e), lv, v::vs, funeffect f)
-
- | F.SWITCH (v,ac,[(dc as F.DATAcon(_,_,lv),le)],NONE) =>
- let1(le, fn e => F.SWITCH(v, ac, [(dc, e)], NONE), lv, [v], false)
-
- | F.LET (lvs,body,le) =>
- let val (leE,leI,fvI,leRet) = sexp (S.union(S.addList(S.empty, lvs),
env)) le
- in (fn e => F.LET(lvs, body, leE e), leI, fvI, leRet)
- end
-
- (* useless sophistication *)
- | F.APP (F.VAR f,args) =>
- if funeffect f
- then (fn e => e, F.RET[], S.empty, lexp)
- else (fn e => e, lexp, addvs(S.singleton f, args), lexp)
-
- (* other non-binding lexps result in unsplittable functions *)
- | (F.APP _ | F.TAPP _) => bug "strange (T)APP"
- | (F.SWITCH _ | F.RAISE _ | F.BRANCH _ | F.HANDLE _) =>
- (fn e => e, F.RET[], S.empty, lexp)
- end
-
-(* Functions definitions fall into the following categories:
- * - inlinable: if exported, copy to leI
- * - (mutually) recursive: don't bother
- * - non-inlinable non-recursive: split recursively *)
-and sfix env (fdecs,le) =
- let val nenv = S.union(S.addList(S.empty, map #2 fdecs), env)
- val (leE,leI,fvI,leRet) = sexp nenv le
- val nleE = fn e => F.FIX(fdecs, leE e)
- in case fdecs
- of [({inline=inl as (F.IH_ALWAYS | F.IH_MAYBE _),...},f,args,body)] =>
- let val min = case inl of F.IH_MAYBE(n,_) => n | _ => 0
- in if not(S.member(fvI, f)) orelse min > !CTRL.splitThreshold
- then (nleE, leI, fvI, leRet)
- else (nleE, F.FIX(fdecs, leI),
- rmvs(S.union(fvI, FU.freevars body),
- f::(map #1 args)),
- leRet)
- end
- | [fdec as (fk as {cconv=F.CC_FCT,...},_,_,_)] =>
- sfdec env (leE,leI,fvI,leRet) fdec
-
- | _ => (nleE, leI, fvI, leRet)
- end
-
-and sfdec env (leE,leI,fvI,leRet) (fk,f,args,body) =
- let val benv = S.union(S.addList(S.empty, map #1 args), env)
- val (bodyE,bodyI,fvbI,bodyRet) = sexp benv body
- in case bodyI
- of F.RET[] =>
- (fn e => F.FIX([(fk, f, args, bodyE bodyRet)], e),
- leI, fvI, leRet)
- | _ =>
- let val fvbIs = S.listItems(S.difference(fvbI, benv))
- val (nfk,fkE) = OU.fk_wrap(fk, NONE)
-
- (* fdecE *)
- val fE = cplv f
- val fErets = (map F.VAR fvbIs)
- val bodyE = bodyE(F.RET fErets)
- (* val tmp = mklv()
- val bodyE = bodyE(F.RECORD(F.RK_STRUCT, map F.VAR fvbIs,
- tmp, F.RET[F.VAR tmp])) *)
- val fdecE = (fkE, fE, args, bodyE)
- val fElty = LT.ltc_fct(map #2 args, map getLty fErets)
- val _ = addLty(fE, fElty)
-
- (* fdecI *)
- val fkI = {inline=F.IH_ALWAYS, cconv=F.CC_FCT,
- known=true, isrec=NONE}
- val argsI =
- (map (fn lv => (lv, getLty(F.VAR lv))) fvbIs) @ args
- val fdecI as (_,fI,_,_) = FU.copyfdec(fkI,f,argsI,bodyI)
- val _ = addpurefun fI
-
- (* nfdec *)
- val nargs = map (fn (v,t) => (cplv v, t)) args
- val argsv = map (fn (v,t) => F.VAR v) nargs
- val nbody =
- let val lvs = map cplv fvbIs
- in F.LET(lvs, F.APP(F.VAR fE, argsv),
- F.APP(F.VAR fI, (map F.VAR lvs)@argsv))
- end
- (* let val lv = mklv()
- in F.LET([lv], F.APP(F.VAR fE, argsv),
- F.APP(F.VAR fI, (F.VAR lv)::argsv))
- end *)
- val nfdec = (nfk, f, nargs, nbody)
-
- (* and now, for the whole F.FIX *)
- fun nleE e =
- F.FIX([fdecE], F.FIX([fdecI], F.FIX([nfdec], leE e)))
-
- in if not(S.member(fvI, f)) then (nleE, leI, fvI, leRet)
- else (nleE,
- F.FIX([fdecI], F.FIX([nfdec], leI)),
- S.add(S.union(S_rmv(f, fvI), S.intersection(env, fvbI)),
fE),
- leRet)
- end
- end
-
-(* TFNs are kinda like FIX except there's no recursion *)
-and stfn env (tfdec as (tfk,tf,args,body),le) =
- let val (bodyE,bodyI,fvbI,bodyRet) =
- if #inline tfk = F.IH_ALWAYS
- then (fn e => body, body, FU.freevars body, body)
- else sexp env body
- val nenv = S.add(env, tf)
- val (leE,leI,fvI,leRet) = sexp nenv le
- in case (bodyI, S.listItems(S.difference(fvbI, env)))
- of ((F.RET _ | F.RECORD(_,_,_,F.RET _)),_) =>
- (* split failed *)
- (fn e => F.TFN((tfk, tf, args, bodyE bodyRet), leE e),
- leI, fvI, leRet)
- | (_,[]) =>
- (* everything was split out *)
- let val ntfdec = ({inline=F.IH_ALWAYS}, tf, args, bodyE bodyRet)
- val nlE = fn e => F.TFN(ntfdec, leE e)
- in if not(S.member(fvI, tf)) then (nlE, leI, fvI, leRet)
- else (nlE, F.TFN(ntfdec, leI),
- S_rmv(tf, S.union(fvI, fvbI)), leRet)
- end
- | (_,fvbIs) =>
- let (* tfdecE *)
- val tfE = cplv tf
- val tfEvs = map F.VAR fvbIs
- val bodyE = bodyE(F.RET tfEvs)
- val tfElty = LT.lt_nvpoly(args, map getLty tfEvs)
- val _ = addLty(tfE, tfElty)
-
- (* tfdecI *)
- val tfkI = {inline=F.IH_ALWAYS}
- val argsI = map (fn (v,k) => (cplv v, k)) args
- (* val tmap = ListPair.map (fn (a1,a2) =>
- * (#1 a1, LT.tcc_nvar(#1 a2)))
- * (args, argsI) *)
- val bodyI = FU.copy tmap M.empty
- (F.LET(fvbIs, F.TAPP(F.VAR tfE, map #2 tmap),
- bodyI))
- (* F.TFN *)
- fun nleE e =
- F.TFN((tfk, tfE, args, bodyE),
- F.TFN((tfkI, tf, argsI, bodyI), leE e))
-
- in if not(S.member(fvI, tf)) then (nleE, leI, fvI, leRet)
- else (nleE,
- F.TFN((tfkI, tf, argsI, bodyI), leI),
- S.add(S.union(S_rmv(tf, fvI), S.intersection(env, fvbI)),
tfE),
- leRet)
- end
- end
-
-(* here, we use B-decomposition, so the args should not be
- * considered as being in scope *)
-val (bodyE,bodyI,fvbI,bodyRet) = sexp S.empty body
-in case (bodyI, bodyRet)
- of (F.RET _,_) => ((fk, f, args, bodyE bodyRet), NONE)
- | (_,F.RECORD (rk,vs,lv,F.RET[lv'])) =>
- let val fvbIs = S.listItems fvbI
-
- (* fdecE *)
- val bodyE = bodyE(F.RECORD(rk, vs@(map F.VAR fvbIs), lv, F.RET[lv']))
- val fdecE as (_,fE,_,_) = (fk, cplv f, args, bodyE)
-
- (* fdecI *)
- val argI = mklv()
- val argLtys = (map getLty vs) @ (map (getLty o F.VAR) fvbIs)
- val argsI = [(argI, LT.ltc_str argLtys)]
- val (_,bodyI) = foldl (fn (lv,(n,le)) =>
- (n+1, F.SELECT(F.VAR argI, n, lv, le)))
- (length vs, bodyI) fvbIs
- val fdecI as (_,fI,_,_) = FU.copyfdec (fk, f, argsI, bodyI)
-
- val nargs = map (fn (v,t) => (cplv v, t)) args
- in
- (fdecE, SOME fdecI)
- (* ((fk, f, nargs,
- F.FIX([fdecE],
- F.FIX([fdecI],
- F.LET([argI],
- F.APP(F.VAR fE, map (F.VAR o #1) nargs),
- F.APP(F.VAR fI, [F.VAR argI]))))),
- NONE) *)
- end
-
- | _ => (fdec, NONE) (* sorry, can't do that *)
-(* (PPFlint.printLexp bodyRet; bug "couldn't find the returned record") *)
-
-end
-
-end
-end
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master 01265da: * externals-list: Convert sml-mode to :external,
Stefan Monnier <=