#+title: Sensitive Setq
#+author: screwtape
* Description
We would like to use ==#:trivial-sensitivities== in the way Reichenbacher seems to think
is great. Basically this means replacing eager function evaluation deferment to a queue.

This queue is the list ==*deferred*==. The macro ==(dsetq foo 'bar)== defers assigning
 =='bar== to variable ==foo== to the end of ==*deferred*==: It then also nconcs the
 ==#'find-sensitives== of ==foo== to ==*deferred*==. A list in *deferred* is always
 ==(foo 'bar)== resulting like (setq foo 'bar), whereas atoms refer to programs to
 call with no arguments, so everything operates by side effects, propagating via
 ==#'dsetq==.

The gist is that in contrast to highly rigid languages and programming systems, a
lisp package can be grown and debugged organically in and as a lisp system.

There's an example at the end of this file of some trivial "pipelining".

I guess worth noting are ==#'advance== which does a number of steps in ==*deferred*==
and ==#'keep-advancing== which is similar to waiting for a new rising_edge.

There's a utility for defining multiple, sensitive signals and signal-setting
processes. It's assumed that a signal (symbol-value 'foo) is set by a
(symbol-function 'foo) after a signal it is sensitive to is resolved from the queue,
the macro ==#'sdefineq==

* Exports
| deferred-setq  | 'symbol value &optional pkg                         |
| dsetq          | symbol value                                        |
| *deferred*     | list                                                |
| sdefineq       | {(name initial-value (&rest sensitivities) lambda)} |
| advance        | n-steps                                             |
| keep-advancing | ()                                                  |

* ASD
#+name: sensitive-setq-system
#+HEADER: :tangle ~/common-lisp/sensitive-setq/sensitive-setq.asd
#+begin_src lisp
  (defsystem "sensitive-setq"
    :class :package-inferred-system
    :depends-on (:sensitive-setq/deferment))

  (register-system-packages "sensitive-setq/deferment" '(:sensitive-setq))
#+end_src
* Deferment
#+name: deferment
#+HEADER: :tangle ~/common-lisp/sensitive-setq/deferment.lisp
#+begin_src lisp
      (uiop:define-package :sensitive-setq
	(:mix :cl)
	(:mix-reexport :trivial-sensitivities)
	(:export #:deferred-setq #:dsetq #:*deferred* #:sdefineq #:advance #:keep-advancing)
	(:nicknames :sssetq))
      (in-package :sssetq)
      (defvar *deferred* (list))

      (defun deferred-setq (symbol value &optional (pkg (symbol-package symbol))) "
      nconcs ((symbol value)) onto *deferred*
      then nconcs (find-sensitives symbol pkg) onto *deferred*
      Args: symbol, value &optional (pkg (symbol-package symbol))
      do what you might imagine.
      "
	(setf *deferred*
	      (nconc *deferred* (list (list symbol value))))
	(setf *deferred*
	      (nconc *deferred* (find-sensitives symbol pkg)))
	(values (last *deferred*)))

      (defmacro dsetq (name value &rest pkg)
	`(deferred-setq ',name ,value ,@pkg))

      (defmacro sdefineq (&rest sensitive-defineqs) "
		defvars, setfs symbol-function and #'make-sensitive s from
		(name initially sensitivities lambda)
		Lambda should take no arguments:
		It works via deferred side effects and sensitivities (dsetq)
		sensitivities is an unquoted list of unquoted symbols
		name is similarly unquoted
		initially will be evaluated I think
		"
	`(progn
	   ,@(loop for definition in sensitive-defineqs
		   for (name initially senss lambda) = definition
		   collect
		   `(progn
		      (defvar ,name ,initially)
		      (setf (symbol-function ',name) ,lambda)
		      (apply #'make-sensitive ',name ',senss)))))

      (defun execute-deferred-set (item)
	(set (car item) (cadr item)))
      (defun execute-deferred-funcall (item)
	(funcall (symbol-function item)))

      (defun advance (n-steps)
	(loop repeat n-steps
	      for item = (pop *deferred*)
	      when (consp item)
		do (execute-deferred-set item)
	      when (atom item)
		do (execute-deferred-funcall item)))

  (defun keep-advancing () "
    basically get to the next clock tick
  " (loop while *deferred*
	  for len = (length *deferred*)
	  do (advance len)))

#+end_src
* Smoke

#+name: smoke
#+HEADER: :results output verbatim
#+begin_src lisp
  (asdf:load-system :sensitive-setq)
  (use-package :sensitive-setq)

  (sdefineq (*a-in*  #16(U U U U U U U U U U U U U U U U)
		    () (lambda ()))
	    (*a-out* #16(U U U U U U U U U U U U U U U U)
		     (*b-in*)
		     (lambda () (dsetq *a-out* *a-in*)))
	    (*b-in* #16(U U U U U U U U U U U U U U U U)
		    (*a-in*)
		    (lambda () (dsetq *b-in* *a-out*)))
	    (*b-out* #16(U U U U U U U U U U U U U U U U)
		     (*c-in*)
		     (lambda () (dsetq *b-out* *b-in*)))
	    (*c-in* #16(U U U U U U U U U U U U U U U U)
		    (*b-in*)
		    (lambda () (dsetq *c-in* *b-out*)))
	    (*c-out* #16(U U U U U U U U U U U U U U U U)
		  (*d-in*)
		     (lambda () (dsetq *c-out* *c-in*)))
	    (*d-in* #16(U U U U U U U U U U U U U U U U)
		    (*c-in*)
		    (lambda () (dsetq *d-in* *c-out*))))

  (dolist (in (list #(U U U U U U U U U U U U U U U 1)
		    #(U U U U U U U U U U U U U U 1 0)
		    #(U U U U U U U U U U U U U U 1 1)
		    #(U U U U U U U U U U U U U 1 0 0)
		    #(U U U U U U U U U U U U U 1 0 1)
		    #(U U U U U U U U U U U U U 1 1 1)))
    (dsetq *a-in* in)
    (keep-advancing)
    (print "*a-in* ")
    (princ *a-in*)
    (print "*c-out* ")
    (princ *c-out*)
    (terpri))
#+end_src

#+RESULTS: smoke
#+begin_example

"*a-in* " #(U U U U U U U U U U U U U U U 1)
"*c-out* " #(U U U U U U U U U U U U 1 1 0 0)

"*a-in* " #(U U U U U U U U U U U U U U 1 0)
"*c-out* " #(U U U U U U U U U U U U 1 1 0 1)

"*a-in* " #(U U U U U U U U U U U U U U 1 1)
"*c-out* " #(U U U U U U U U U U U U U U U 1)

"*a-in* " #(U U U U U U U U U U U U U 1 0 0)
"*c-out* " #(U U U U U U U U U U U U U U 1 0)

"*a-in* " #(U U U U U U U U U U U U U 1 0 1)
"*c-out* " #(U U U U U U U U U U U U U U 1 1)

"*a-in* " #(U U U U U U U U U U U U U 1 1 1)
"*c-out* " #(U U U U U U U U U U U U U 1 0 0)
#+end_example