From 36ed4ab19f85d1099332b0552114f551cb27cf5f Mon Sep 17 00:00:00 2001
From: Artem Gureev <artemgureev@yahoo.com>
Date: Thu, 24 Aug 2023 17:18:30 +0600
Subject: [PATCH] Curly and Brackets Constructors

Adds two new constrictors to the VampIR spec, allowing for making of
the empty bracket used for induction on lists and of the curly
brackets for function specification.
---
 src/vampir/package.lisp |  6 ++++--
 src/vampir/print.lisp   | 10 ++++++++--
 src/vampir/spec.lisp    | 31 +++++++++++++++++++++++++++----
 3 files changed, 39 insertions(+), 8 deletions(-)

diff --git a/src/vampir/package.lisp b/src/vampir/package.lisp
index 961c4c1b1..a6d75bced 100644
--- a/src/vampir/package.lisp
+++ b/src/vampir/package.lisp
@@ -25,10 +25,12 @@
    :wire        :var
    :constant    :const
    :tuple       :wires
+   :curly       :value
+   :brackets
 
    ;; Constructors
-   :make-alias :make-pub :make-infix :make-application :make-tuples
-   :make-bind  :make-equality :make-wire :make-constant))
+   :make-alias :make-pub :make-infix :make-application :make-tuples :make-curly
+   :make-bind  :make-equality :make-wire :make-constant :make-brackets))
 
 (geb.utils:muffle-package-variance
  (defpackage #:geb.vampir
diff --git a/src/vampir/print.lisp b/src/vampir/print.lisp
index 23ba72745..e156cb2f6 100644
--- a/src/vampir/print.lisp
+++ b/src/vampir/print.lisp
@@ -93,7 +93,7 @@ of ()'s for any non normal form"
     (spc:application
      (pprint-logical-block (stream nil :prefix "(" :suffix ")")
        (print-object expr stream)))
-    ((or spc:tuple spc:normal-form)
+    ((or spc:tuple spc:normal-form spc:curly)
      (print-object expr stream))
     (geb.extension.spec:common-sub-expression
      (extract-expression (geb.spec:obj expr) stream)))
@@ -118,5 +118,11 @@ of ()'s for any non normal form"
   (pprint-logical-block (stream nil :prefix "(" :suffix ")")
     (format stream "~{~(~a~)~^, ~}" (spc:wires tup))))
 
+(defmethod print-object ((curly spc:curly) stream)
+  (format stream "{~A}" (spc:value curly)))
+
 (defmethod print-object ((const spc:constant) stream)
-  (format stream "~A" (spc:const const)))
+  (format stream "~(~a~)" (spc:const const)))
+
+(defmethod print-object ((brackets spc:brackets) stream)
+  (format stream "[]"))
diff --git a/src/vampir/spec.lisp b/src/vampir/spec.lisp
index a877462da..4dac8e854 100644
--- a/src/vampir/spec.lisp
+++ b/src/vampir/spec.lisp
@@ -21,11 +21,11 @@
 ;; called base in the file
 ;; Values are called over a normal form!?!?!?
 (deftype expression ()
-  `(or infix application normal-form tuple
+  `(or infix application normal-form tuple curly
        geb.extension.spec:common-sub-expression))
 
 (deftype normal-form ()
-  `(or wire constant))
+  `(or wire constant brackets))
 
 (deftype primitive ()
   `(or (eql :+) (eql :-) (eql :*) (eql :^) (eql :\\) (eql :%) (eql :/) (eql :|:|)))
@@ -130,20 +130,29 @@
           :type    list
           :accessor wires)))
 
+(defclass curly (mixins)
+  ((value :initarg :value
+          :accessor value
+          :type expression
+          :documentation "The wire argument inside the curly bracket")))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Normal Form Product Types
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defclass wire (mixins)
   ((var :initarg :var
-        :accessor var
-        :type     (or symbol keyword)))
+        :accessor var))
   (:documentation "A reference in vamp-ir"))
 
 (defclass constant (mixins)
   ((const :initarg :const
           :accessor const)))
 
+(defclass brackets (mixins)
+  ()
+  (:documentation "Brackets designating 0-bit integer"))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Alias
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -210,3 +219,17 @@
 
 (defun make-tuples (&key wires)
   (make-instance 'tuple :wires wires))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Curly Brackets
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun make-curly (&key value)
+  (make-instance 'curly :value value))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Brackets
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun make-brackets ()
+  (make-instance 'brackets))