]> code.delx.au - gnu-emacs-elpa/blob - packages/shen-mode/shen-mode.el
* GNUmakefile: Rename from Makefile. Add targets for in-place use.
[gnu-emacs-elpa] / packages / shen-mode / shen-mode.el
1 ;;; shen-mode.el --- A major mode for editing shen source code
2
3 ;; Copyright (C) 2011, 2013 Free Software Foundation, Inc.
4
5 ;; Author: Eric Schulte <schulte.eric@gmail.com>
6 ;; Version: 0.1
7 ;; Keywords: languages, shen
8 ;; Description: A major mode for editing shen source code
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26
27 ;; A minor mode for editing shen source code. Shen is a modern lisp
28 ;; dialect with support for functional and declarative programming,
29 ;; pattern matching and a very powerful type system. See the
30 ;; following for more information on Shen. http://www.shenlanguage.org
31
32 ;;; Code:
33 (require 'lisp-mode)
34 (require 'imenu)
35
36 (defcustom shen-mode-hook '(turn-on-eldoc-mode)
37 "Normal hook run when entering `shen-mode'."
38 :type 'hook
39 :group 'shen)
40
41 (defvar shen-mode-map
42 (let ((map (make-sparse-keymap)))
43 (set-keymap-parent map lisp-mode-shared-map)
44 map)
45 "Currently just inherits from `lisp-mode-shared-map'.")
46
47 (eval-and-compile
48 (defconst shen-functions
49 '((* "number --> number --> number" "Number multiplication.")
50 (+ "number --> number --> number" "Number addition.")
51 (- "number --> number --> number" "Number subtraction.")
52 (/ "number --> number --> number" "Number division.")
53 (/. "_" "Abstraction builder, receives a variable and an expression; does the job of --> in the lambda calculus.")
54 (< "number --> number --> boolean" "Less than.")
55 (<-vector nil nil)
56 (<= "number --> number --> boolean" "Less than or equal to.")
57 (<e> nil nil)
58 (= "A --> A --> boolean" "Equal to.")
59 (== "A --> B --> boolean" "Equal to.")
60 (> "number --> number --> boolean" "Greater than.")
61 (>= "number --> number --> boolean" "Greater than or equal to.")
62 (@p "_" "Takes two inputs and forms an ordered pair.")
63 (@s "_" "Takes two or more inputs and forms a string.")
64 (@v "_" "Takes two or more inputs and forms a vector.")
65 (abort nil "throw a simple error")
66 (adjoin nil "add arg1 to list arg2 if not already a member")
67 (and "boolean --> boolean --> boolean" "Boolean and.")
68 (append "(list A) --> (list A) --> (list A)" "Appends two lists into one list.")
69 (apply "(A --> B) --> (A --> B)" "Applies a function to an input.")
70 (arity nil nil)
71 (assoc nil nil)
72 (assoc-type "symbol --> variable --> symbol" "Associates a Qi type (first input) with Lisp type (second input)..")
73 (average nil "return the average of two numbers")
74 (bind nil nil)
75 (boolean\? "A --> boolean" "Recognisor for booleans.")
76 (bound\? nil "check is a symbol is bound")
77 (byte->string nil "return the string represented by bytes")
78 (call nil nil)
79 (cd "string --> string" "Changes the home directory. (cd \"My Programs\") will cause (load \"hello_world.txt\") to load MyPrograms/hello_world.txt. (cd \"\") is the default.")
80 (character\? "A --> boolean" "Recognisor for characters.")
81 (compile nil nil)
82 (complex\? "A --> boolean" "Recognisor for complex numbers.")
83 (concat "symbol --> symbol --> symbol" "Concatenates two symbols.")
84 (congruent\? "A --> A --> boolean" "Retrns true if objects are identical or else if they are strings or characters which are identical differing at most in case or numbers of equal value (e.g. 1 and 1.0) or tuples composed of congruent elements.")
85 (cons "_" "A special form that takes an object e of type A and a list l of type (list A) and produces a list of type (list A) by adding e to the front of l.")
86 (cons\? "--> boolean" "Returns true iff the input is a non-empty list.")
87 (core nil nil)
88 (cut nil nil)
89 (debug "A --> string" "The input is ignored and debugging is returned; but all terminal output is echoed to the file debug.txt until the undebug function is executed.")
90 (declare "_" "Takes a function name f and a type t expressed as a list and gives f the type t.")
91 (define "_" "Define a function, takes a name, an optional type and a pattern matching body.")
92 (delete-file "string --> string" "The file named in the string is deleted and the string returned.")
93 (destroy "_" "Receives the name of a function and removes it and its type from the environment.")
94 (difference "(list A) --> (list A) --> (list A)" "Subtracts the elements of the second list from the first")
95 (do "_" "A special form: receives n well-typed expressions and evaluates each one, returning the normal form of the last one.")
96 (dump "string --> string" "Dumps all user-generated Lisp from the file f denoted by the argument into a file f.lsp.")
97 (echo "string --> string" "Echoes all terminal input/output to a file named by string (which is either appended to if it exists or created if not) until the command (echo \"\") is received which switches echo off.")
98 (element\? "A -> (list A) --> boolean" "Returns true iff the first input is an element in the second.")
99 (empty\? "--> boolean" "Returns true iff the input is [].")
100 (error "_" "A special form: takes a string followed by n (n --> 0) expressions. Prints error string.")
101 (eval "_" "Evaluates the input.")
102 (explode "A --> (list character)" "Explodes an object to a list of characters.")
103 (fail nil nil)
104 (fix "(A --> A) --> (A --> A)" "Applies a function to generate a fixpoint.")
105 (float\? "A --> boolean" "Recognisor for floating point numbers.")
106 (floor nil nil)
107 (format nil "takes a stream, a format string and args, formats and prints to the stream")
108 (freeze "A --> (lazy A)" "Returns a frozen version of its input.")
109 (fst "(A * B) --> A" "Returns the first element of a tuple.")
110 (fwhen nil nil)
111 (gensym "_" "Generates a fresh symbol or variable from a string..")
112 (get nil "gets property arg2 from object arg1")
113 (get-array "(array A) --> (list number) --> A --> A" "3-place function that takes an array of elements of type A, an index to that array as a list of natural numbers and an expression E of type A. If an object is stored at the index, then it is returned, otherwise the normal form of E is returned.")
114 (get-prop "_" "3-place function that takes a symbol S, a pointer P (which can be a string, symbol or number), and an expression E of any kind and returns the value pointed by P from S (if one exists) or the normal form of E otherwise.")
115 (hash nil "hash an object")
116 (hdv nil nil)
117 (head "(list A) --> A" "Returns the first element of a list.")
118 (identical nil nil)
119 (if "boolean --> A --> A" "takes a boolean b and two expressions x and y and evaluates x if b evaluates to true and evaluates y if b evaluates to false.")
120 (if-with-checking "string --> (list A)" "If type checking is enabled, raises the string as an error otherwise returns the empty list..")
121 (if-without-checking "string --> (list A)" "If type checking is disabled, raises the string as an error otherwise returns the empty list.")
122 (include "(list symbol) --> (list symbol)" "Includes the datatype theories or synonyms for use in type checking.")
123 (include-all-but "(list symbol) --> (list symbol)" "Includes all loaded datatype theories and synonyms for use in type checking apart from those entered.")
124 (inferences "A --> number" "The input is ignored. Returns the number of logical inferences executed since the last call to the top level.")
125 (input "_" "0-place function. Takes a user input i and returns the normal form of i.")
126 (input+ "_" "Special form. Takes inputs of the form : <expr>. Where d(<expr>) is the type denoted by the choice of expression (e.g. \"number\" denotes the type number). Takes a user input i and returns the normal form of i given i is of the type d(<expr>).")
127 (integer\? "A --> boolean" "Recognisor for integers.")
128 (interror nil nil)
129 (intersection "(list A) --> (list A) --> (list A)" "Computes the intersection of two lists.")
130 (intmake-string nil nil)
131 (intoutput nil nil)
132 (lambda "_" "Lambda operator from lambda calculus.")
133 (length "(list A) --> integer" "Returns the number of elements in a list.")
134 (let nil nil)
135 (limit nil nil)
136 (lineread "_" "Top level reader of read-evaluate-print loop. Reads elements into a list. lineread terminates with carriage return when brackets are balanced. ^ aborts lineread.")
137 (list "A .. A --> (list A)" "A special form. Assembles n (n --> 0) inputs into a list.")
138 (load "string --> symbol" "Takes a file name and loads the file, returning loaded as a symbol.")
139 (macroexpand nil nil)
140 (make-string "string A1 - An --> string" "A special form: takes a string followed by n (n --> 0) well-typed expressions; assembles and returns a string.")
141 (map "(A --> B) --> (list A) --> (list B)" "The first input is applied to each member of the second input and the results consed into one list..")
142 (mapcan "(A --> (list B)) --> (list A) --> (list B)" "The first input is applied to each member of the second input and the results appended into one list.")
143 (maxinferences "number --> number" "Returns the input and as a side-effect, sets a global variable to a number that limits the maximum number of inferences that can be expended on attempting to typecheck a program. The default is 1,000,000.")
144 (mod nil "arg1 mod arg2")
145 (newsym "symbol --> symbol" "Generates a fresh symbol from a symbol.")
146 (newvar "variable --> variable" "Generates a fresh variable from a variable")
147 (nl nil nil)
148 (not "boolean --> boolean" "Boolean not.")
149 (nth "number --> (list A) --> A" "Gets the nth element of a list numbered from 1.")
150 (number\? "A --> boolean" "Recognisor for numbers.")
151 (occurences "A --> B --> number" "Returns the number of times the first argument occurs in the second.")
152 (occurrences nil "returns the number of occurrences of arg1 in arg2")
153 (occurs-check "symbol --> boolean" "Receives either + or - and enables/disables occur checking in Prolog, datatype definitions and rule closures. The default is +.")
154 (opaque "symbol --> symbol" "Applied to a Lisp macro makes it opaque to Qi.")
155 (or "boolean --> (boolean --> boolean)" "Boolean or.")
156 (output "string A1 - An --> string" "A special form: takes a string followed by n (n --> 0) well-typed expressions; prints a message to the screen and returns an object of type string (the string \"done\").")
157 (preclude "(list symbol) --> (list symbol)" "Removes the mentioned datatype theories and synonyms from use in type checking.")
158 (preclude-all-but "(list symbol) --> (list symbol)" "Removes all the datatype theories and synonyms from use in type checking apart from the ones given.")
159 (print "A --> A" "Takes an object and prints it, returning it as a result.")
160 (profile "(A --> B) --> (A --> B)" "Takes a function represented by a function name and inserts profiling code returning the function as an output.")
161 (profile-results "A --> symbol" "The input is ignored. Returns a list of profiled functions and their timings since profile-results was last used.")
162 (ps "_" "Receives a symbol denoting a Qi function and prints the Lisp source code associated with the function.")
163 (put nil "puts value of arg3 as property arg2 in object arg1")
164 (put-array "(array A) --> (list number) --> A --> A" "3-place function that takes an array of elements of type A, an index to that array as a list of natural numbers and an expression E of type A. The normal form of E is stored at that index and then returned.")
165 (put-prop "_" "3-place function that takes a symbol S, a pointer P (a string symbol or number), and an expression E. The pointer P is set to point from S to the normal form of E which is then returned.")
166 (quit "_" "0-place function that exits Qi.")
167 (random "number --> number" "Given a positive number n, generates a random number between 0 and n-1.")
168 (rational\? "A --> boolean" "Recognisor for rational numbers.")
169 (read nil nil)
170 (read-char "A --> character" "The input is discarded and the character typed by the user is returned.")
171 (read-chars-as-stringlist "(list character) --> (character --> boolean) --> (list string)" "Returns a list of strings whose components are taken from the character list. The second input acts as a tokeniser. Thus (read-chars-as-stringlist [#\\H #\\i #\\Space #\\P #\\a #\\t] (/. X (= X #\\Space))) will produce [\"Hi\" \"Pat\"].")
172 (read-file "string --> (list unit)" "Returns the contents of an ASCII file designated by a string. Returns a list of units, where unit is an unspecified type.")
173 (read-file-as-charlist "string --> (list character)" "Returns the list of characters from the contents of an ASCII file designated by a string.")
174 (read-file-as-string nil nil)
175 (real\? "A --> boolean" "Recognisor for real numbers.")
176 (remove "A --> (list A) --> (list A)" "Removes all occurrences of an element from a list.")
177 (return nil nil)
178 (reverse "(list A)--> ?(list A)" "Reverses a list.")
179 (round "number--> ?number" "Rounds a number.")
180 (save "_" "0 place function. Saves a Qi image.")
181 (snd "(A * B) --> B" "Returns the second element of a tuple.")
182 (specialise "symbol --> symbol" "Receives the name of a function and turns it into a special form. Special forms are not curried during evaluation or compilation.")
183 (speed "number --> number" "Receives a value 0 to 3 and sets the performance of the generated Lisp code, returning its input. 0 is the lowest setting.")
184 (spy "symbol --> boolean" "Receives either + or - and respectively enables/disables tracing the operation of T*.")
185 (sqrt "number --> number" "Returns the square root of a number.")
186 (step "symbol --> boolean" "Receives either + or - and enables/disables stepping in the trace.")
187 (stinput nil nil)
188 (string\? "A --> boolean" "Recognisor for strings.")
189 (strong-warning "symbol --> boolean" "Takes + or -; if + then warnings are treated as error messages.")
190 (subst nil nil)
191 (sugar "symbol --> (A --> B) --> number --> (A --> B)" "Receives either in or out as first argument, a function f and an integer greater than 0 and returns f as a result. The function f is placed on the sugaring list at a position determined by the number.")
192 (sugar-list "symbol --> (list symbol)" "Receives either in or out as first argument, and returns the list of sugar functions.")
193 (sum nil "sum a list of numbers")
194 (symbol\? "A --> boolean" "Recognisor for symbols.")
195 (systemf nil nil)
196 (tail "(list A) --> (list A)" "Returns all but the first element of a non-empty list.")
197 (tc "symbol --> boolean" "Receives either + or - and respectively enables/disables static typing.")
198 (tc\? nil "return true if type checking")
199 (thaw "(lazy A) --> A" "Receives a frozen input and evaluates it to get the unthawed result..")
200 (time "A --> A" "Prints the run time for the evaluation of its input and returns its normal form.")
201 (tlv nil nil)
202 (track "symbol --> symbol" "Tracks the I/O behaviour of a function.")
203 (transparent "symbol --> symbol" "Applied to a Lisp macro makes it transparent to Qi.")
204 (tuple\? "A --> boolean" "Recognisor for tuples.")
205 (type "_" "Returns a type for its input (if any) or false if the input has no type.")
206 (unassoc-type "symbol --> symbol" "Removes any associations with the Qi type in the type association table.")
207 (undebug "A --> string" "The input is ignored, undebugging is returned and all terminal output is closed to the file debug.txt.")
208 (unify nil nil)
209 (unify! nil nil)
210 (union "(list A) --> (list A) --> (list A)" "Forms the union of two lists.")
211 (unprofile "(A --> B) --> (A --> B)" "Unprofiles a function.")
212 (unspecialise "symbol --> symbol" "Receives the name of a function and deletes its special form status.")
213 (unsugar "symbol --> (A --> B) --> (A --> B)" "Receives either out or in and the name of a function and removes its status as a sugar function.")
214 (untrack "symbol --> symbol" "Untracks a function.")
215 (value "_" "Applied to a symbol, returns the global value assigned to it.")
216 (variable\? "A --> boolean" "Applied to a variable, returns true.")
217 (vector nil nil)
218 (vector-> nil nil)
219 (vector\? nil nil)
220 (version "string --> string" "Changes the version string displayed on startup.")
221 (warn "string --> string" "Prints the string as a warning and returns \"done\". See strong-warning")
222 (write-to-file "string --> A --> string" "Writes the second input into a file named in the first input. If the file does not exist, it is created, else it is overwritten. If the second input is a string then it is written to the file without the enclosing quotes. The first input is returned.")
223 (y-or-n\? "string --> boolean" "Prints the string as a question and returns true for y and false for n."))
224 "Shen functions taken largely from the Qi documentation by Dr. Mark Tarver."))
225
226 \f
227 ;;; Fontification
228 (defconst shen-font-lock-keywords
229 (eval-when-compile
230 `(;; definitions
231 (,(concat "(\\("
232 (regexp-opt
233 '("define" "defmacro" "defprolog" "/." "synonyms" "defcc"))
234 "\\)\\>"
235 "[ \t]*(?"
236 "\\(\\sw+\\)?")
237 (1 font-lock-keyword-face)
238 (2 font-lock-function-name-face nil t))
239 ("(\\(lambda\\)\\>[ \t]*(?\\(\\sw+\\)?"
240 (1 font-lock-keyword-face)
241 (2 font-lock-variable-name-face nil t))
242 ;; data types
243 ("(\\(datatype\\)\\>[ \t]*(?\\(\\sw+\\)?"
244 (1 font-lock-keyword-face)
245 (2 font-lock-type-face nil t))
246 ;; variables
247 ("\\<\\([A-Z]\\w*\\)\\>" . font-lock-variable-name-face)
248 ;; control structures
249 (,(concat
250 "("
251 (regexp-opt
252 (append
253 '("let" "=" "eval-without-reader-macros" "freeze" "type") ; generic
254 '("if" "and" "or" "cond")) t) ; boolean
255 "\\>") . 1)
256 ;; errors
257 ("(\\(error\\)\\>" 1 font-lock-warning-face)
258 ;; built-in
259 (,(concat
260 "("
261 (regexp-opt
262 (mapcar
263 (lambda (it) (format "%s" it))
264 (append
265 '(intern function) ; symbols
266 '(pos tlstr cn str string?) ; strings
267 '(set value) ; assignment
268 '(cons hd tl cons?) ; lists
269 '(absvector address-> <-address absvector?) ; vector
270 '(pr read-byte open close) ; stream
271 '(get-time) ; time
272 '(+ - * / > < >= <= number?) ; arithmetic
273 '(fst snd tupple?) ; tuple
274 '(@s @v @p)
275 '(put get) ; property lists
276 '(simple-error trap-error error-to-string) ; error
277 ;; predicates
278 (mapcar
279 (lambda (it) (format "%s?" it))
280 '(boolean character complex congruent cons element empty float
281 integer number provable rational solved string symbol
282 tuple variable))
283 ;; misc functions
284 (mapcar #'car shen-functions)))
285 t)
286 "\\>")
287 1 font-lock-builtin-face)
288 ;; external global variables
289 (,(concat
290 (regexp-opt
291 (mapcar
292 (lambda (cnst) (format "*%s*" cnst))
293 '("language" "implementation" "port" "porters"
294 "stinput" "home-directory" "version"
295 "maximum-print-sequence-size" "printer" "macros")) t)
296 "\\>")
297 1 font-lock-builtin-face)))
298 "Default expressions to highlight in Shen mode.")
299
300 (defvar shen-mode-syntax-table
301 (let ((table (make-syntax-table)))
302 (dolist (pair '((?@ . "w")
303 (?_ . "w")
304 (?- . "w")
305 (?+ . "w")
306 (?? . "w")
307 (?! . "w")
308 (?< . "w")
309 (?> . "w")
310 (?/ . "w")
311 ;; comment delimiters
312 (?\\ . ". 14")
313 (?* . ". 23")))
314 (modify-syntax-entry (car pair) (cdr pair) table))
315 table)
316 "Syntax table to use in shen-mode.")
317
318 \f
319 ;;; Indentation
320 ;; Copied from qi-mode, which in turn is from scheme-mode and from lisp-mode
321 (defun shen-indent-function (indent-point state)
322 (let ((normal-indent (current-column)))
323 (goto-char (1+ (elt state 1)))
324 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
325 (if (and (elt state 2)
326 (not (looking-at "\\sw\\|\\s_")))
327 ;; car of form doesn't seem to be a symbol
328 (progn
329 (if (not (> (save-excursion (forward-line 1) (point))
330 calculate-lisp-indent-last-sexp))
331 (progn (goto-char calculate-lisp-indent-last-sexp)
332 (beginning-of-line)
333 (parse-partial-sexp (point)
334 calculate-lisp-indent-last-sexp 0 t)))
335 ;; Indent under the list or under the first sexp on the same
336 ;; line as calculate-lisp-indent-last-sexp. Note that first
337 ;; thing on that line has to be complete sexp since we are
338 ;; inside the innermost containing sexp.
339 (backward-prefix-chars)
340 (current-column))
341 (let ((function (buffer-substring (point)
342 (progn (forward-sexp 1) (point))))
343 method)
344 (setq method (or (get (intern-soft function) 'shen-indent-function)
345 (get (intern-soft function) 'shen-indent-hook)))
346 (cond ((or (eq method 'defun)
347 (and (null method)
348 (> (length function) 3)
349 (string-match "\\`def" function)))
350 (lisp-indent-defform state indent-point))
351 ((integerp method)
352 (lisp-indent-specform method state
353 indent-point normal-indent))
354 (method
355 (funcall method state indent-point normal-indent)))))))
356
357 (defun shen-let-indent (state indent-point normal-indent)
358 (let ((edge (- (current-column) 2)))
359 (goto-char indent-point) (skip-chars-forward " \t")
360 (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
361 ;; deeper indent because we're still defining local variables
362 (lisp-indent-specform 5 state indent-point normal-indent)
363 ;; shallow indent because we're in the body
364 edge)))
365
366 (defun shen-package-indent (state indent-point normal-indent)
367 (- (current-column) 8))
368
369 (put 'let 'shen-indent-function 'shen-let-indent)
370 (put 'lambda 'shen-indent-function 1)
371 (put 'package 'shen-indent-function 'shen-package-indent)
372 (put 'datatype 'shen-indent-function 1)
373
374 \f
375 ;;; Function documentation
376 (defun shen-current-function ()
377 (ignore-errors
378 (save-excursion
379 (backward-up-list)
380 (forward-char 1)
381 (thing-at-point 'word))))
382
383 (defun shen-mode-eldoc ()
384 (let ((func (assoc (intern (or (shen-current-function) "")) shen-functions)))
385 (when func
386 (format "%s%s:%s"
387 (propertize (symbol-name (car func))
388 'face 'font-lock-function-name-face)
389 (if (cadr func) (concat "[" (cadr func) "]") "")
390 (if (caddr func) (concat " " (caddr func)) "")))))
391
392 (defvar shen-imenu-generic-expression
393 '(("Functions" "^\\s-*(\\(define\\)" 1)))
394
395 \f
396 ;;; Major mode definition
397 ;; apparently some versions of Emacs don't have `prog-mode' defined
398 (unless (fboundp 'prog-mode)
399 (defalias 'prog-mode 'fundamental-mode))
400
401 (define-derived-mode shen-mode prog-mode "shen"
402 "Major mode for editing Shen code."
403 :syntax-table shen-mode-syntax-table
404 ;; set a variety of local variables
405 ((lambda (local-vars)
406 (dolist (pair local-vars)
407 (set (make-local-variable (car pair)) (cdr pair))))
408 `((adaptive-fill-mode . nil)
409 (fill-paragraph-function . lisp-fill-paragraph)
410 (indent-line-function . lisp-indent-line)
411 (lisp-indent-function . shen-indent-function)
412 (parse-sexp-ignore-comments . t)
413 (comment-start . "\\* ")
414 (comment-end . " *\\")
415 (comment-add . 0)
416 (comment-column . 32)
417 (parse-sexp-ignore-comments . t)
418 (comment-use-global-state . nil)
419 (comment-multi-line . t)
420 (eldoc-documentation-function . shen-mode-eldoc)
421 (imenu-case-fold-search . t)
422 (imenu-generic-expression . ,shen-imenu-generic-expression)
423 (mode-name . "Shen")
424 (font-lock-defaults . (shen-font-lock-keywords)))))
425
426 (add-to-list 'auto-mode-alist '("\\.shen\\'" . shen-mode))
427
428 (provide 'shen-mode)
429 ;;; shen-mode.el ends here