diff --git a/README.md b/README.md new file mode 100644 index 0000000..a0cbabc --- /dev/null +++ b/README.md @@ -0,0 +1,28 @@ +This directory contins the source code for an Emacs mode that supports +working with Coalton code. + +## Requirements + +This mode requires Emacs version 29.1 and above, because it relies on +tree-sitter. + +## Installation + +In your emacs init file (probably ~/.emacs.d/init.el), +add this directory to your load-path, and require the mode: + + ;; Coalton + + (add-to-list 'load-path "~/git/coalton/emacs") + (require 'coalton-mode) + +## Usage + +There is an example file in test/types.coal. + +The first time you open a .coal file, Emacs will ask you to approve +the installation of a parser component: + + tree-sitter-coalton is not installed. Clone, build and install it? + +(Answer 'yes') diff --git a/coalton-mode.el b/coalton-mode.el new file mode 100644 index 0000000..5711ec1 --- /dev/null +++ b/coalton-mode.el @@ -0,0 +1,271 @@ +;;; coalton-mode.el --- Major mode for working with Coalton -*- lexical-binding: t; -*- +;; +;; URL: http://github.com/coalton-lang/coaltom +;; Keywords: languages coalton lisp +;; Version: 1.0.0 +;; Package-Requires: ((emacs "29.1")) +;; +;; This file contains functions for in-Emacs structural operations on +;; Coalton code, including syntax highlighting, indentation and +;; navigation, and command integration with the in-CL operations +;; defined in `slime-coalton.el'. + +(require 'treesit) +(require 'lisp-mnt) +(require 'slime) +(require 'slime-coalton) + +(add-to-list 'slime-contribs 'slime-coalton) + +(defconst coalton-mode-version + (eval-when-compile + (lm-version (or load-file-name buffer-file-name)))) + +(defvar coalton-ts-repo + "https://github.com/coalton-lang/tree-sitter-coalton.git") + +(defvar coalton-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") 'slime-coalton--compile-form) + (define-key map (kbd "C-c C-l") 'slime-coalton--compile-file) + map)) + +(defvar coalton-mode-syntax-table + (let ((table (make-syntax-table))) + (modify-syntax-entry '(0 . 127) "_" table) + + (modify-syntax-entry '(?0 . ?9) "w" table) + (modify-syntax-entry '(?a . ?z) "w" table) + (modify-syntax-entry '(?A . ?Z) "w" table) + + (modify-syntax-entry ?\s " " table) + (modify-syntax-entry ?\t " " table) + (modify-syntax-entry ?\f " " table) + + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) + + (modify-syntax-entry ?\; "<" table) + (modify-syntax-entry ?\n ">" table) + (modify-syntax-entry ?\" "\"" table) + (modify-syntax-entry ?\\ "\\" table) + + table)) + +(defvar coalton--debug nil + "Enable debugging.") + + +;; Fontification + +(defconst coalton--builtins + '("declare" + "define" + "define-instance" + "define-type" + "do" + "let" + "lisp" + "match" + "package" + "repr")) + +(defconst coalton--builtin-symbol + (eval-and-compile + (concat "^" (regexp-opt coalton--builtins) "$"))) + +(defun coalton--font-lock-settings () + "Return settings for `treesit-font-lock-settings'." + (treesit-font-lock-rules + :feature 'builtin + :language 'coalton + `(((list :anchor (symbol (symbol_name) @font-lock-keyword-face)) + (:match ,coalton--builtin-symbol @font-lock-keyword-face))) + + :feature 'number + :language 'coalton + '((number) @font-lock-number-face) + + :feature 'paren + :language 'coalton + '((["(" ")"]) @font-lock-bracket-face) + + :feature 'comment + :language 'coalton + '((comment) @font-lock-comment-face))) + + +;; Indentation + +(defun coalton--indent-rules () + "Return rules for `treesit-simple-indent-rules'." + `((coalton + ((parent-is "list") parent 2)))) + + +;; Indexing and navigation + +(defun coalton--node-type-p (type node) + "Does NODE have tree-sitter TYPE?" + (string-equal type (treesit-node-type node))) + +(defun coalton--list-p (node) + "Is NODE a list?" + (coalton--node-type-p "list" node)) + +(defun coalton--symbol-p (node) + "Is NODE a symbol?" + (coalton--node-type-p "symbol" node)) + +(defun coalton--symbol-name (node) + "If NODE is a symbol, return its name." + (when (coalton--symbol-p node) + (treesit-node-text node t))) + +(defun coalton--symbol-name-p (name node) + "Is NODE a symbol named NAME?" + (and (coalton--symbol-p node) + (string-equal name (coalton--symbol-name node)))) + +(defun coalton--definition-type (node) + "If NODE is a definition, return the definition's type." + (when (coalton--list-p node) + (let ((node (treesit-node-child node 0 t))) + (when (coalton--symbol-p node) + (coalton--symbol-name node))))) + +(defun coalton--definition-p (type node) + "Is NODE a definition of type TYPE?" + (string-equal type (coalton--definition-type node))) + +(defun coalton--definition-name (node) + "If NODE is a definition, return its name." + (when (coalton--list-p node) + (let ((node (treesit-node-child node 1 t))) + (cond ((coalton--list-p node) + (let ((node (treesit-node-child node 0 t))) + (when (coalton--symbol-p node) + (coalton--symbol-name node)))) + ((coalton--symbol-p node) + (coalton--symbol-name node)))))) + + +;; Easy menu + +(defvar coalton-easy-menu + (let ((C '(coalton-available-p))) + `("Coalton" + ("Debug" + [ "Show AST" slime-coalton--ast-file ,C ]) + ("Compile" + [ "Compile File" slime-coalton--compile-file ,C ])))) + +(easy-menu-define menubar-coalton coalton-mode-map "Coalton" coalton-easy-menu) + + +;; Imenu + +(defun coalton--type-definition-p (node) + "Does NODE represent a type definition?" + (coalton--definition-p "define-type" node)) + +(defun coalton--instance-definition-p (node) + "Does NODE represent an instanclue definition?" + (coalton--definition-p "define-instance" node)) + +(defun coalton--function-definition-p (node) + "Does NODE represent a function definition?" + (coalton--definition-p "define" node)) + +(defvar coalton--imenu-settings + '(("Type" "list" + coalton--type-definition-p + coalton--definition-name) + ("Instance" "list" + coalton--instance-definition-p + coalton--definition-name) + ("Function" "list" + coalton--function-definition-p + coalton--definition-name)) + "The value for `treesit-simple-imenu-settings'.") + + +;; Initialization + +(defun coalton--load-grammar () + "Install grammar." + (let ((treesit-language-source-alist + `((coalton ,coalton-ts-repo "main")))) + (unless (treesit-language-available-p 'coalton nil) + (when (yes-or-no-p "treesitter-coalton is not installed. Clone, build and install it?") + (treesit-install-language-grammar 'coalton))))) + +(defun coalton-mode-variables () + "Initialize buffer-local vars." + (setq-local comment-start "; ") + (setq-local treesit-simple-imenu-settings + coalton--imenu-settings) + (setq-local treesit-font-lock-settings + (coalton--font-lock-settings)) + (setq-local treesit-font-lock-feature-list + ;; Amount of decoration, from least to most, cumulative, + ;; controlled by `treesit-font-lock-level'. + '((comment) ; 1 + () ; 2 + (number builtin) ; 3 + (paren))) ; 4 + (setq-local treesit-simple-indent-rules + (coalton--indent-rules))) + +;;;###autoload +(define-derived-mode coalton-mode prog-mode "Coalton" + "Major mode for working with Coalton. + +\\{coalton-mode-map}" + :syntax-table coalton-mode-syntax-table + (coalton--load-grammar) + (when (treesit-ready-p 'coalton) + (treesit-parser-create 'coalton) + (coalton-mode-variables) + (when coalton--debug + (setq-local treesit--indent-verbose t) + (setq-local treesit--font-lock-verbose t) + (treesit-inspect-mode)) + (treesit-major-mode-setup))) + +(add-to-list 'auto-mode-alist '("\\.coalton\\'" . coalton-mode)) + +(defvar coalton--query-package + (treesit-query-compile + 'coalton + '(((program (list + :anchor (symbol name: (symbol_name) @package) + :anchor (symbol name: (symbol_name) @package-name))) + (:equal @package "package"))))) + +(defun coalton-package () + (let ((nodes (treesit-query-capture 'coalton coalton--query-package))) + (treesit-node-text (cdr (assoc 'package-name nodes)) t))) + +(defun coalton--find-parent (node pred) + "Find first parent of NODE matching PRED." + (cond ((null node) + nil) + ((funcall pred node) + node) + (t + (coalton--find-parent (treesit-node-parent node) pred)))) + +(defun coalton--toplevel-form-p (node) + "Is NODE a toplevel program element?" + (and (coalton--list-p node) + (string-equal "program" (treesit-node-type + (treesit-node-parent node))))) + +(defun coalton-toplevel-form () + "Return the text of the toplevel form at point." + (when-let ((node (coalton--find-parent (treesit-node-at (point)) + #'coalton--toplevel-form-p))) + (treesit-node-text node t))) + +(provide 'coalton-mode) diff --git a/slime-coalton.el b/slime-coalton.el new file mode 100644 index 0000000..fbf1677 --- /dev/null +++ b/slime-coalton.el @@ -0,0 +1,77 @@ +;;; slime-coalton.el --- coalton-mode lisp integration -*- lexical-binding: t; -*- +;; +;; Slime extension via `define-slime-contrib' for interaction with a +;; Coalton instance running in a Slime-managed Lisp subprocess. + +(require 'slime) + +(defun coalton-available-p () + ;; todo: associate tests with specific connections + (and (not (null slime-net-processes)) + (eql :loaded (slime-eval `(swank:swank-coalton-status))))) + +(cl-defmacro slime-coalton--show ((name) &body body) + (declare (indent 1)) + `(with-current-buffer (get-buffer-create ,name) + (erase-buffer) + (slime-popup-buffer-mode) + ,@body + (display-buffer (current-buffer)) + (current-buffer))) + +(defun slime-coalton--buffer-name (type) + (format "*coalton-%s*" (symbol-name type))) + +(defun slime-coalton--popup-buffer (type) + (let ((name (slime-coalton--buffer-name type))) + (slime-coalton--show (name) + (current-buffer)))) + +(defun slime-coalton--popup (type value) + (pop-to-buffer (slime-coalton--popup-buffer type)) + (erase-buffer) + (insert value) + (goto-char (point-min))) + +(defun slime-coalton--eval (sexp cont) + (declare (indent 1)) + (slime-rex (cont) + (sexp "swank") + ((:ok result) + (when cont + (funcall cont result))) + ((:abort condition) + (message "Evaluation aborted on %s." condition)))) + +(defun slime-coalton--ast-file () + "Display the AST of the current file." + (interactive) + (slime-coalton--eval `(swank:swank-coalton--ast-file + ,(buffer-substring-no-properties (point-min) (point-max))) + (lambda (result) + (slime-coalton--popup 'ast result)))) + +(defun slime-coalton--compile-file () + "Compile the current file." + (interactive) + (slime-coalton--eval `(swank:swank-coalton--compile-file + ,(buffer-substring-no-properties (point-min) (point-max))) + (lambda (result) + (slime-coalton--popup 'ast result)))) + + +;;; Initialization + +(defun slime-coalton-init () + (message "slime-coalton.el: slime-coalton-init")) + +(define-slime-contrib slime-coalton + "Support Coalton language" + (:authors "Jesse Bouwman ") + (:swank-dependencies swank-coalton)) + +(defun coalton () + (interactive) + (message "slime-coalton.el: coalton")) + +(provide 'slime-coalton) diff --git a/swank-coalton.lisp b/swank-coalton.lisp new file mode 100644 index 0000000..4f7ea69 --- /dev/null +++ b/swank-coalton.lisp @@ -0,0 +1,34 @@ +;;; swank-coalton.lisp + +(in-package :swank) + +(defun system-loaded-p (system-designator) + (find system-designator (asdf:already-loaded-systems) + :test #'string=)) + +(defun system-available-p (system-designator) + (asdf:find-system system-designator)) + +(defun system-status (system-designator) + (cond ((system-loaded-p system-designator) + :loaded) + ((system-available-p system-designator) + :available) + (t + :unavailable))) + + +(defslimefun swank-coalton-status () + (system-status "coalton")) + +(defslimefun swank-coalton-init () + (asdf:load-system "coalton")) + + +(defslimefun swank-coalton--ast-file (text) + (with-input-from-string (stream text) + (coalton-impl/compiler::generate-ast stream))) + +(defslimefun swank-coalton--compile-file (text) + (with-input-from-string (stream text) + (coalton-impl/compiler::%compile-file stream))) diff --git a/test/types.coalton b/test/types.coalton new file mode 100644 index 0000000..4a21864 --- /dev/null +++ b/test/types.coalton @@ -0,0 +1,95 @@ +(package coalton-library/types + (export + Proxy + proxy-of + as-proxy-of + proxy-inner + LispType + RuntimeRepr + runtime-repr + runtime-repr-of)) + +(repr :enum) +(define-type (Proxy :a) + "Proxy holds no data, but has a phantom type parameter." + Proxy) + +(declare proxy-of (:a -> Proxy :a)) +(define (proxy-of _) + "Returns a Proxy containing the type of the parameter." + Proxy) + +(declare as-proxy-of (:a -> Proxy :a -> :a)) +(define (as-proxy-of x _) + "Returns the parameter, forcing the proxy to have the same type as the parameter." + x) + +(declare proxy-inner (Proxy (:a :b) -> Proxy :b)) +(define (proxy-inner _) + Proxy) + +(repr :native (cl:or cl:symbol cl:list)) +(define-type LispType + "The runtime representation of a Coalton type as a lisp type.") + +(define-class (RuntimeRepr :a) + "Types which have a runtime LispType representation. + +`runtime-repr` corresponds to the type emitted by the Coalton compiler for the type parameter to the given Proxy. + +The compiler will auto-generate instances of `RuntimeRepr` for all defined types." + (runtime-repr (Proxy :a -> LispType))) + +(declare runtime-repr-of (RuntimeRepr :a => :a -> LispType)) +(define (runtime-repr-of x) + "Returns the runtime representation of the type of the given value." + (runtime-repr (proxy-of x))) + +;; Additional RuntimeRepr instances for early-defined types + +(define-instance (RuntimeRepr Boolean) + (define (runtime-repr _) + (lisp LispType () 'cl:boolean))) + +(define-instance (RuntimeRepr Char) + (define (runtime-repr _) + (lisp LispType () 'cl:character))) + +(define-instance (RuntimeRepr Integer) + (define (runtime-repr _) + (lisp LispType () 'cl:integer))) + +(define-instance (RuntimeRepr Single-Float) + (define (runtime-repr _) + (lisp LispType () 'cl:single-float))) + +(define-instance (RuntimeRepr Double-Float) + (define (runtime-repr _) + (lisp LispType () 'cl:double-float))) + +(define-instance (RuntimeRepr String) + (define (runtime-repr _) + (lisp LispType () 'cl:string))) + +(define-instance (RuntimeRepr Fraction) + (define (runtime-repr _) + (lisp LispType () 'cl:rational))) + +(define-instance (RuntimeRepr (:a -> :b)) + (define (runtime-repr _) + (lisp LispType () 'coalton-impl/runtime/function-entry:function-entry))) + +(define-instance (RuntimeRepr (List :a)) + (define (runtime-repr _) + (lisp LispType () 'cl:list))) + +;; The compiler will not auto-generate RuntimeRepr instances for +;; types defined in this file to avoid circular dependencies. + +(define-instance (RuntimeRepr LispType) + (define (runtime-repr _) + (lisp LispType () '(cl:or cl:symbol cl:list)))) + +(define-instance (RuntimeRepr (Proxy :a)) + (define (runtime-repr _) + (lisp LispType () '(cl:member 'proxy/proxy))))