Talking REPL. Experimental interaction of different Lisp implementations. In this case CL, elisp and Scheme.

.TalkingLisps.md

Talking Lisps

This is a sketch illustrating dynamic interactions between three different implementations of Lisp.
Common Lisp, Emacs Lisp, and an very old Scheme are engaged in a conversation and producing a very crude talking REPL.

It's by no means complete nor useful at this point but it's a good starting point.

You will need:

• Emacs
• Common Lisp
• SLIME
• Festival
• scheme functions: map, filter, and iota
• the files in this gist. (rename festivalrc.scm to .festivalrc and place it in your $HOME)

Good luck!

very short demo:
https://twitter.com/ympbyc/status/1097851893181628416

festivalrc.scm

(load "srfi-1.scm") ;;you pretty much have to roll your own stripped down version of list library

(define (apropos sym)
    (let ((name (format nil "%s" sym)))
      (filter (lambda (x)
		(and
		 (symbol-bound? x)
		 (string-matches 
		  (format nil "%s" x) 
		  (string-append ".*" name ".*"))))
	      (oblist))))

(define (duplicate n x)
    (map (lambda (_) x)
	 (iota nil 0 n)))

(define bt2w builtin_english_token_to_words)

(define (token_to_words token name)
    (let ((prepunc (item.feat token "prepunctuation"))
	  (punc    (item.feat token "punc"))
	  (tok-name (item.feat token "name")))
      (cond
	((string-matches tok-name ".*\-.*")
	 (append (bt2w token (string-before tok-name "-"))
	       '("dash")
	       (bt2w token (string-after tok-name "-"))))
	((string-equal name "(")
	 (cons "khakho" (bt2w token name)))
	((string-equal name ")")
	 (append (bt2w token name) (list "kohkha")))
	((string-matches prepunc "\(+")
	 (append (duplicate (length prepunc) "khakho")
		 (bt2w token name)
		 (if (string-matches punc "\)+")
		     (duplicate (length punc) "kohkha")
		     '())))
	((string-matches punc "\)+")
	 (append (bt2w token name) 
		 (duplicate (length punc) "kohkha")))

	((string-matches prepunc "'")
	 (cons "quote" (bt2w token name)))
	
	(t (bt2w token name)))))


(define (name->words name)
    (cond ((string-matches name ".*-.*")
	   (append (name->words (string-before name "-"))
		   (list "dash")
		   (name->words (string-after name "-"))))
	  
	  ((string-equal name "*")
	   (list "star"))
	  ((string-equal name "/")
	   (list "division"))
	  
	  (t (let ((utt0 (eval (list 'Utterance 'Text name))))
	       ;;just needs to get Token from name. Don't do this if possible.
	       (utt.synth utt0)
	       (token_to_words (cadr (utt.relation.items utt0 'Token)) name)))))


(define (sexpr->words expr)
    (cond
      ((pair? expr)
       (append '("khakho")
	       (apply append (map sexpr->words expr))
	       '("khohkha")))
      (t (name->words (format nil "%s" expr)))))

init.el

;;festival
;;(load "/usr/share/emacs/site-lisp/festival.el")
(require 'festival)
(festival-load "~/.festivalrc")
(festival-say-string "Emacs started. Let's get hacking.")

(defun festival-say-sexpr (sexpr)
  (message (format "%s" sexpr))
  (festival-send-command
   `(set! utt1 (eval (list 'Utterance 'Words 
			   (sexpr->words ',sexpr)))))
  (festival-send "(utt.synth utt1)\n")
  (festival-send "(utt.play utt1)\n"))


(defun readout-slime-output (event)
  (cond
   ((and (eq (car event) :write-string)
	 (not (equal "\n" (cadr event))))
    (festival-say-string (cadr event)))
   ((and (eq (car event) :emacs-rex)
	 (eq (car (cadr event)) 'swank-repl:listener-eval))
    (festival-say-sexpr 
     (car (read-from-string (cadr (cadr event)))))))
  nil)


(defun festival-slime-hook-start ()
  (interactive)
  (add-hook 'slime-event-hooks 'readout-slime-output))