;;;; sam-d.lisp
(defpackage sam-d (:use cl cl-user))
(in-package sam-d)
(defclass ext-proc ()
((2way :accessor 2way)
(proc :accessor proc)))
(defclass sam-d (ext-proc)
((2sam :initform (list '|:-(|) :accessor 2sam)
(fsam :initform (list '|:-)|) :accessor fsam)
(dirty :initform nil :accessor dirty)))
(defmethod shared-initialize :after ((obj sam-d) names &rest args)
(declare (ignore unused names args))
(multiple-value-bind (2way unused proc)
(ext:run-program "9" '("sam" "-d") :wait nil)
(setf (slot-value obj '2way) 2way
(slot-value obj 'proc) proc)))
(defmethod wstrm ((obj sam-d))
(two-way-stream-output-stream (2way obj)))
(defmethod rstrm ((obj sam-d))
(two-way-stream-input-stream (2way obj)))
(defvar *sam-d* (make-instance 'sam-d))
(defun fin ()
(format (wstrm *sam-d*) "=~%")
(force-output (wstrm *sam-d*))
(loop for line = (read-line (rstrm *sam-d*))
do (format t "~a~%" line) while (not (search "; #" line)))
(when (listen (rstrm *sam-d*))
(loop for ch = (read-char-no-hang (rstrm *sam-d*))
while ch do (princ ch))))
(define-symbol-macro % (fin))
(defun sam (say)
(format (wstrm *sam-d*) "~a~%" say)
(force-output (wstrm *sam-d*)))
(defun sam-reader (s c n)
(declare (ignore c n))
`(progn (sam (coerce
',(loop
for ch = (read-char s)
while (not (and (char= ch #\#)
(char= (peek-char nil s) #\])))
collecting ch
finally (read-char-no-hang s))
'string))
(fin)))
(set-dispatch-macro-character #\# #\[ #'sam-reader)
(defmacro 2s (&body body)
`(with-input-from-string (s (format nil "#[~@{~a~^ ~}#]" ,@body))
(eval (read s))))
(defun rs (start end)
(with-output-to-string (*standard-output*)
(sam (format nil "~a,~a" start end))))
