begin swank api

query before installing grammar dylib

emacs/coalton-mode.el

@@ -8,7 +8,7 @@
 ;; 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 `inferior-coalton.el'.
+;; defined in `slime-coalton.el'.
 
 (require 'treesit)
 (require 'lisp-mnt)
@@ -140,6 +140,19 @@
             ((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 ,C ])
+      ("Compile"
+       [ "Compile File"     slime-coalton--compile-file ,C ]))))
+
+(easy-menu-define menubar-coalton coalton-mode-map "Coalton" coalton-easy-menu)
+
 
 ;; Imenu
 
@@ -172,11 +185,11 @@
 
 (defun coalton--load-grammar ()
   "Install grammar."
-  (let ((grammars `((coalton ,coalton-ts-repo "main"))))
-    (dolist (grammar grammars)
-      (unless (treesit-language-available-p (car grammar) nil)
-        (let ((treesit-language-source-alist grammars))
-          (treesit-install-language-grammar (car 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."
@@ -240,12 +253,9 @@
        (string-equal "program" (treesit-node-type
                                 (treesit-node-parent node)))))
 
-(defun coalton--node-at-point ()
-  (treesit-node-at (point)))
-
 (defun coalton-toplevel-form ()
   "Return the text of the toplevel form at point."
-  (when-let ((node (coalton--find-parent (coalton--node-at-point)
+  (when-let ((node (coalton--find-parent (treesit-node-at (point))
                                          #'coalton--toplevel-form-p)))
     (treesit-node-text node t)))
 

emacs/slime-coalton.el

@@ -0,0 +1,68 @@
+;;; 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 ()
+  (and (not (null slime-net-processes))
+       (fboundp 'xxx)))
+
+(cl-defmacro slime-coalton--show ((name) &body body)
+  (declare (indent 1))
+  `(with-current-buffer (get-buffer-create ,name)
+     (erase-buffer)
+     ,@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 ()
+  "Display the AST of the definition at point."
+  (interactive)
+  (let ((form (coalton-definition-at-point))
+        (package (coalton-package)))
+    (slime-coalton--eval `(swank:swank-coalton-ast `,form `,package)
+      (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 <[email protected]>")
+  (:swank-dependencies swank-coalton))
+
+(defun coalton ()
+  (interactive)
+  (message "slime-coalton.el: coalton"))
+
+(provide 'slime-coalton)

emacs/swank-coalton.lisp

@@ -0,0 +1,39 @@
+;;; 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 (form package)
+  :xyz)
+
+(provide :swank-coalton)
+
+
+
+(swank-coalton--ast "(define (symbol-name sym)
+  (match sym
+    ((Symbol s) s)))"
+                    "(package diff-example)")
+