#+title: Sensitive Setq

#+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