Skip to content

Instantly share code, notes, and snippets.

@ympbyc ympbyc/.TalkingLisps.md
Last active Feb 19, 2019

Embed
What would you like to do?
Talking REPL. Experimental interaction of different Lisp implementations. In this case CL, elisp and Scheme.

Talking Lisps

My lisp terminal

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

(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)))))
;;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))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.