;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.dises.test)

;;;;;;
;;; Signal processing

(defun probe (name)
  (lambda (a)
    (format t "~%At ~A the probe ~A became ~A" (simulation-time-of *simulator*) name a)))

(defun set-signal (wire value)
  (funcall wire value))

(defun gate (function delay output)
  (bind ((current-a #f)
         (current-b #f))
    (lambda (&key (a nil a-provided?) (b nil b-provided?))
      (with-call/cc
        (wait delay)
        (when a-provided?
          (setf current-a a))
        (when b-provided?
          (setf current-b b))
        ;; NOTE: this might do some flickering on the due to setting one input signal at a time
        ;; that should be treated as if the last value would be the real value
        (funcall output (funcall function current-a current-b))))))

(defun and-gate (delay output)
  (gate (lambda (&rest args)
          (every #'identity args))
        delay output))

(defun or-gate (delay output)
  (gate (lambda (&rest args)
          (every #'identity args))
        delay output))

(defun not-gate (delay output)
  (lambda (input)
    (with-call/cc
      (wait delay)
      (funcall output (not input)))))

(defun wire (&rest outputs)
  (lambda (input)
    (iter (for output :in outputs)
          (funcall output input))))

(defun pin (gate name)
  (lambda (input)
    (funcall gate name input)))

(deftest test/signal ()
  "One bit adder
   (probe c (and a b))
   (probe s (and (or a b)
                 (not (and a b))))"
  (run-with-new-simulator
    (bind ((s (probe "s"))
           (c (probe "c"))
           (a2 (and-gate 2 (wire s)))
           (o1 (or-gate 2 (wire (pin a2 :a))))
           (n1 (not-gate 1 (wire (pin a2 :b))))
           (a1 (and-gate 2 (wire c n1))))
      (schedule :now
        (iter (for (a b) :in '((#f #f)
                               (#f #t)
                               (#t #f)
                               (#t #t)))
              (set-signal (wire (pin a1 :a) (pin o1 :a)) a)
              (set-signal (wire (pin a1 :b) (pin o1 :b)) b)
              (wait 10))))
    (finish-at 100)))