;;;; 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))))