From 9e7eadc46cf385a193ecb8c39328536e1ae869aa Mon Sep 17 00:00:00 2001
From: "Juan M. Bello-Rivas" <jbellorivas@rigetti.com>
Date: Wed, 29 Jan 2020 11:19:42 -0800
Subject: [PATCH] Basic infrastructure.

---
 magicl.asd                                 |  1 +
 src/high-level/specialize-constructor.lisp |  6 ++++
 src/high-level/types/bit.lisp              | 34 ++++++++++++++++++++++
 3 files changed, 41 insertions(+)
 create mode 100644 src/high-level/types/bit.lisp

diff --git a/magicl.asd b/magicl.asd
index a313b46e..d8b4d730 100755
--- a/magicl.asd
+++ b/magicl.asd
@@ -50,6 +50,7 @@
                  (:file "types/complex-single-float")
                  (:file "types/complex-double-float")
                  (:file "types/int32")
+                 (:file "types/bit")
                  (:file "lapack-templates")
                  (:file "lapack-bindings")
                  (:file "constructors")
diff --git a/src/high-level/specialize-constructor.lisp b/src/high-level/specialize-constructor.lisp
index eb215344..be9750b2 100644
--- a/src/high-level/specialize-constructor.lisp
+++ b/src/high-level/specialize-constructor.lisp
@@ -14,6 +14,7 @@
            ((subtypep type 'double-float) 'vector/double-float)
            ((subtypep type '(complex single-float)) 'vector/complex-single-float)
            ((subtypep type '(complex double-float)) 'vector/complex-double-float)
+           ((subtypep type 'bit) 'vector/bit)
            ((subtypep type '(signed-byte 32)) 'vector/int32)
            (t (error "no compatible tensor constructor for type ~a" type))))
         ((cl:= 2 (length shape))
@@ -22,6 +23,7 @@
            ((subtypep type 'double-float) 'matrix/double-float)
            ((subtypep type '(complex single-float)) 'matrix/complex-single-float)
            ((subtypep type '(complex double-float)) 'matrix/complex-double-float)
+           ((subtypep type 'bit) 'matrix/bit)
            ((subtypep type '(signed-byte 32)) 'matrix/int32)
            (t (error "no compatible tensor constructor for type ~a" type))))
         (t
@@ -30,6 +32,7 @@
            ((subtypep type 'double-float) 'tensor/double-float)
            ((subtypep type '(complex single-float)) 'tensor/complex-single-float)
            ((subtypep type '(complex double-float)) 'tensor/complex-double-float)
+           ((subtypep type 'bit) 'tensor/bit)
            ((subtypep type '(signed-byte 32)) 'tensor/int32)
            (t (error "no compatible tensor constructor for type ~a" type)))))
       (cond
@@ -39,6 +42,7 @@
            (double-float 'vector/double-float)
            ((complex single-float) 'vector/complex-single-float)
            ((complex double-float) 'vector/complex-double-float)
+           (bit 'vector/bit)
            ((signed-byte 32) 'vector/int32)))
         ((cl:= 2 (length shape))
          (etypecase val
@@ -46,11 +50,13 @@
            (double-float 'matrix/double-float)
            ((complex single-float) 'matrix/complex-single-float)
            ((complex double-float) 'matrix/complex-double-float)
+           (bit 'matrix/bit)
            ((signed-byte 32) 'matrix/int32)))
         (t (etypecase val
              (single-float 'tensor/single-float)
              (double-float 'tensor/double-float)
              ((complex single-float) 'tensor/complex-single-float)
              ((complex double-float) 'tensor/complex-double-float)
+             (bit 'tensor/bit)
              ((signed-byte 32) 'tensor/int32))))))
 
diff --git a/src/high-level/types/bit.lisp b/src/high-level/types/bit.lisp
new file mode 100644
index 00000000..d1730a7f
--- /dev/null
+++ b/src/high-level/types/bit.lisp
@@ -0,0 +1,34 @@
+;;;; bit.lisp
+;;;;
+;;;; Author: Juan M. Bello-Rivas
+
+(in-package #:magicl)
+
+(deftensor tensor/bit bit)
+
+(defmatrix matrix/bit bit tensor/bit)
+
+(defvector vector/bit bit tensor/bit)
+
+(defcompatible
+    (lambda (tensor)
+      (case (order tensor)
+        (1 '(vector/bit tensor/bit))
+        (2 '(matrix/bit tensor/bit))
+        (t '(tensor/bit))))
+  tensor/bit
+  matrix/bit
+  vector/bit)
+
+(defun mod2+ (source1 source2 &optional target)
+  (binary-operator (lambda (x y) (mod (+ x y) 2)) source1 source2 target))
+
+;;; TODO improve this.
+(defmethod .+ ((source1 vector/bit) (source2 vector/bit) &optional target)
+  (mod2+ source1 source2 target))
+
+(defmethod .+ ((source1 matrix/bit) (source2 matrix/bit) &optional target)
+  (mod2+ source1 source2 target))
+
+(defmethod .+ ((source1 tensor/bit) (source2 tensor/bit) &optional target)
+  (mod2+ source1 source2 target))