;;; -*- Mode: LISP; Syntax: Common-Lisp -*-

(defun READ-AND-CHECK-ALL-ISC-FILES ()
  (mapcar #'read-and-check-isc-file
	  '("VIRGO:/virgo/shirley/projects/circuits/lisp85/c1355.lisp"
	    "VIRGO:/virgo/shirley/projects/circuits/lisp85/c17.lisp"
	    "VIRGO:/virgo/shirley/projects/circuits/lisp85/c1908.lisp"
	    "VIRGO:/virgo/shirley/projects/circuits/lisp85/c2670.lisp"
	    "VIRGO:/virgo/shirley/projects/circuits/lisp85/c3540.lisp"
	    "VIRGO:/virgo/shirley/projects/circuits/lisp85/c432.lisp"
	    "VIRGO:/virgo/shirley/projects/circuits/lisp85/c499.lisp"
	    "VIRGO:/virgo/shirley/projects/circuits/lisp85/c5315.lisp"
	    "VIRGO:/virgo/shirley/projects/circuits/lisp85/c6288.lisp"
	    "VIRGO:/virgo/shirley/projects/circuits/lisp85/c7552.lisp"
	    "VIRGO:/virgo/shirley/projects/circuits/lisp85/c880.lisp")))

(defun STATS-ON-GATE-TYPES ()
  (loop with plist = nil
	for (pathname) in (cdr (fs:directory-list "VIRGO:/virgo/shirley/projects/circuits/lisp85/c*.lisp"))
	do (multiple-value-bind (inputs outputs gates)
	       (read-isc-file pathname)
	     (loop for g in gates
		   for type = (second g)
		   for inputs = (length (cddr g))
		   do (pushnew inputs (getf plist type))))
	finally (return plist)))

; (STATS-ON-GATE-TYPES)  =>
; (XOR (2) BUFF (1) NOR (8 4 3 2) NOT (1) OR (4 5 3 2) AND (8 9 5 4 2 3) NAND (5 8 3 2 4))

(defun READ-ISC-FILE (pathname)
  (with-open-file (stream pathname :direction :input)
    (let ((inputs (read stream))
	  (outputs (read stream))
	  (gates (read stream)))
      (unless (eql :inputs (first inputs))
	(error "~&First form is not (:inputs ...)"))
      (unless (eql :outputs (first outputs))
	(error "~&Second form is not (:outputs ...)"))
      (unless (eql :gates (first gates))
	(error "~&Third form is not (:gates ...)~%"))
      (values (cdr inputs) (cdr outputs) (cdr gates)))))

(defun READ-AND-CHECK-ISC-FILE (pathname)
  ;; Print the header of the file
  (with-open-file (stream pathname :direction :input)
    (loop for line = (zl:readline stream)
	  while (char-equal #\; (aref line 0))
	  do (format t "~&~a~%" line)))
  ;; Do the work
  (multiple-value-bind (inputs outputs gates)
      (read-isc-file pathname)
    (format t "~&There are ~d inputs.~%" (length inputs))
    (format t "~&There are ~d outputs.~%" (length outputs))
    (format t "~&There are ~d gates.~%" (length gates))
    (format t "~&There are ~d nodes.~%" (length (nodes-in-circuit inputs outputs gates)))

    (check-io-for-orphans inputs outputs gates)
    (check-io-for-orphans outputs inputs gates)
    (check-gate-sizes gates)

    (format t "~&==== Finished with ~a ====~%" pathname)))

(defun nodes-in-circuit (inputs outputs gates)
  (loop with nodes = (union inputs outputs)
	for g in gates
	do (setq nodes (adjoin (first g) nodes))
	   (dolist (n (cddr g))
	     (setq nodes (adjoin n nodes)))
	finally (return nodes)))

(defun check-io-for-orphans (inputs outputs gates)
  (loop for ilist on inputs
	for i = (car ilist)
	do (when (or (member i (cdr ilist))
		     (member i outputs))
	     (format t "~&I/O node ~a appears twice as a port.~%" i))
	   (unless (find-a-gate-reference i gates)
	     (format t "~&I/O node ~a isn't referenced by a gate.~%" i))))

(defun CHECK-GATE-NODE-REFERENCES (gates inputs outputs)
  (labels ((check-node (node gates1 gates2)
	     (unless (or (member node inputs)
			 (member node outputs)
			 (find-a-gate-reference node gates1)
			 (find-a-gate-reference node gates2))
	       (format t "~&INTERNAL node ~A is an orphan.~%" node))))
    (loop with gates2 = '()
	  for gatelist on gates
	  for gate = (first gatelist)
	  do (check-node (first gate) (cdr gatelist) gates2)
	     (dolist (n (cddr gate))
	       (check-node n (cdr gatelist) gates2))
	     (push gate gates2))))

(defun FIND-A-GATE-REFERENCE (node gates)
  (loop for gate in gates
	when (or (eql node (first gate))
		 (member node (cddr gate)))
	  return gate))

(defun CHECK-GATE-SIZES (gates)
  (dolist (g gates)
    (let ((l (length g))
	  (type (second g)))
      (unless (case type
		(buff (= l 3))
		(not (= l 3))
		(and (> l 3))
		(nand (> l 3))
		(or (> l 3))
		(nor (> l 3))
		(xor (= l 4))
		(t (error "unrecognized gate type: ~s" type)))
	(format t "~&Gate ~s doesn't pass muster.~%" g)))))

;(defun CREATE-NADDER (n &aux c an bn qn as bs qs ci)
;  (setq ci (create-node 'CI :LOGIC) c ci)
;  (dotimes (i n)
;    (multiple-value (an bn qn c) (create-single-adder i c))
;    (push an as)
;    (push bn bs)
;    (push qn qs))
;  (values ci (nreverse as) (nreverse bs) (nreverse qs) c))
;
;(defun CREATE-SINGLE-ADDER (n ci &aux qn an bn x1o a2o a1o cn b bns)
;  (setq b (format nil "~D" n)
;	qn (create-node (string-append "Q" b) :LOGIC)
;	an (create-node (string-append "A" b) :LOGIC)
;	bn (create-node (setq bns (string-append "B" b)) :LOGIC)
;	cn (create-node (string-append "C" b) :LOGIC)
;	x1o (create-node (string-append "X1o" b) :LOGIC)
;	A2o (create-node (string-append "A2o" b) :LOGIC)
;	A1o (create-node (string-append "A1o" b) :LOGIC))
;  (n-and-model (string-append bns ".A1")
;	       (list an bn)
;	       A1o)
;  (n-and-model (string-append bns ".A2")
;	       (list ci x1o)
;	       A2o)
;  (xor-model (string-append bns ".X1")
;	     an bn
;	     X1o)
;  (xor-model (string-append bns ".X2")
;	     ci X1o
;	     qn)
;  (or-model (string-append bns ".O1")
;	    A2o A1o
;	    cn)
;  (values an bn qn cn))