Introduce Test Flag For Binary

Introduces `--test` flag using `-t` for binary usage. When used with
`-p`, given a compiled VampIR function of form `def foo x1 ... xn =
{body};` produces a test equality `foo x1 ... xn = y;` printed after
the entry function.

src/entry/entry.lisp

@@ -13,6 +13,8 @@
      :type boolean :optional t :documentation "Prints the current version of the compiler")
     (("vampir" #\p)
      :type string :optional t :documentation "Return a vamp-ir expression")
+    (("test" #\t)
+     :type boolean :optional t :documentation "Prints a test equality with public parameters")
     (("help" #\h #\?)
      :type boolean :optional t :documentation "The current help message")))
 
@@ -26,7 +28,7 @@
 (defparameter *no-input-text*
   "Please provide an input file with -p or see the help command with -h")
 
-(defun argument-handlers (&key help stlc output input entry-point vampir version)
+(defun argument-handlers (&key help stlc output input entry-point vampir test version)
   (flet ((run (stream)
            (cond (help
                   (command-line-arguments:show-option-help +command-line-spec+
@@ -40,6 +42,7 @@
                   (compile-down :vampir vampir
                                 :stlc stlc
                                 :entry entry-point
+                                :test test
                                 :stream stream)))))
     (if output
         (with-open-file (file output :direction :output
@@ -49,12 +52,26 @@
         (run *standard-output*))))
 
 ;; this code is very bad please abstract out many of the components
-(defun compile-down (&key vampir stlc entry (stream *standard-output*))
+(defun compile-down (&key vampir stlc entry test (stream *standard-output*))
   (let* ((name        (read-from-string entry))
          (eval        (eval name))
          (vampir-name (renaming-scheme (intern (symbol-name name) 'keyword))))
-    (cond ((and vampir stlc)
+    (cond ((and vampir stlc test)
+           (let ((circuit (to-circuit eval vampir-name)))
+             (geb.vampir:extract (append circuit
+                                         (geb.seqn.trans:test-call
+                                          (car circuit)))
+                                 stream)
+             (format stream ";")))
+          ((and vampir stlc)
            (geb.vampir:extract (to-circuit eval vampir-name) stream))
+          ((and vampir test)
+           (let ((circuit (to-circuit eval vampir-name)))
+             (geb.vampir:extract (append circuit
+                                         (geb.seqn.trans:test-call
+                                          (car circuit)))
+                                 stream)
+             (format stream ";")))
           (stlc
            (format stream "~A" (to-cat nil eval)))
           (vampir

src/entry/package.lisp

@@ -82,5 +82,10 @@ expects a symbol.
 
 the -l flag means that we are not expecting a geb term, but rather a
 lambda frontend term, this is to simply notify us to compile it as a
-lambda term rather than a geb term. In time this will go away"
+lambda term rather than a geb term. In time this will go away
+
+The flag -t after -p signals that the user wants to make an
+automatically generated test equality. Given a compiled VampIR
+function with name foo and arguments x1...xn prints an equality as
+foo x1 ... xn = y"
   (compile-down function))

src/seqn/package.lisp

@@ -41,6 +41,7 @@
 (pax:defsection @seqb-trans (:title "Seqn Transformations")
   "This covers transformation functions from"
   (to-circuit (method () (<seqn> t)))
+  (test-call  function)
   (to-vampir  (method () (id t t)))
   (to-vampir  (method () (composition t t)))
   (to-vampir  (method () (parallel-seq t t)))

src/seqn/trans.lisp

@@ -44,6 +44,17 @@ and skip 0es, making non-zero entries into wires"
                                     (prod-list (cod morphism)
                                                (to-vampir morphism wires nil)))))))))))
 
+(defun test-call (circuit)
+  "Given a compiled VampIR function with name foo and arguments x1...xn prints
+an equality as foo x1 ... xn = y"
+  (let ((inputs (vamp:inputs circuit))
+        (name   (vamp:name circuit)))
+    (list (vamp:make-equality
+           :lhs (if (zerop (length inputs))
+                    (vamp:make-wire :var name)
+                    (vamp:make-application :func name :arguments inputs))
+           :rhs (vamp:make-wire :var :y)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SeqN to Vamp-IR Compilation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;