diff --git a/geb.asd b/geb.asd
index 8cbb1e862..e113aa4cd 100644
--- a/geb.asd
+++ b/geb.asd
@@ -9,11 +9,15 @@
   :description "Gödel, Escher, Bach, a categorical view of computation"
   :build-pathname "../build/geb.image"
   :entry-point "geb.entry::entry"
+
   :build-operation "program-op"
   :author "Mariari"
+
   :license "MIT"
+
   :pathname "src/"
   :components
+
   ((:module util
     :serial t
     :description "Internal utility functions"
@@ -60,6 +64,12 @@
     :depends-on (util geb vampir specs)
     :components ((:file package)
                  (:file poly)))
+   (:module bitc
+    :serial t
+    :description "bitc (Boolean Circuits)"
+    :depends-on (util vampir mixins specs)
+    :components ((:file package)
+                 (:file bitc)))
    (:module lambda
     :serial t
     :depends-on (geb specs)
@@ -84,6 +94,8 @@
                  (:file poly-printer)
                  (:file extension)
                  (:file extension-printer)
+                 (:file bitc)
+                 (:file bitc-printer)
                  ;; HACK: to make the package properly refer to the
                  ;; right symbols
                  (:file ../util/package)))
@@ -97,11 +109,12 @@
     :pathname "../src/"
     :components ((:file lambda/trans)
                  (:file geb/trans)
-                 (:file poly/trans)))
+                 (:file poly/trans)
+                 (:file bitc/trans)))
    (:module entry
     :serial t
     :description "Entry point for the geb codebase"
-    :depends-on (util geb vampir specs poly lambda)
+    :depends-on (util geb vampir specs poly bitc lambda)
     :components ((:file package)
                  (:file entry))))
   :in-order-to ((asdf:test-op (asdf:test-op :geb/test))))
@@ -141,6 +154,7 @@
    (:file lambda-experimental)
    (:file lambda-conversion)
    (:file poly)
+   (:file bitc)
    (:file pipeline)
    (:module gui
     :serial t
diff --git a/src/bitc/bitc.lisp b/src/bitc/bitc.lisp
new file mode 100644
index 000000000..661fed728
--- /dev/null
+++ b/src/bitc/bitc.lisp
@@ -0,0 +1,33 @@
+(in-package :geb.bitc.main)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Domain and codomain definitions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod dom ((x <bitc>))
+  (typecase-of bitc x
+    (compose          (dom (mcadr x)))
+    (fork             (dom (mcar x)))
+    (parallel         (+ (dom (mcar x)) (dom (mcadr x))))
+    (swap             (+ (mcar x) (mcadr x)))
+    (one              0)
+    (zero             0)
+    (ident            (mcar x))
+    (drop             (mcar x))
+    (branch           (+ 1 (dom (mcar x))))
+    (otherwise
+      (subclass-responsibility x))))
+
+(defmethod codom ((x <bitc>))
+  (typecase-of bitc x
+    (compose          (codom (mcar x)))
+    (fork             (* 2 (codom (mcar x))))
+    (parallel         (+ (codom (mcar x)) (codom (mcadr x))))
+    (swap             (+ (mcar x) (mcadr x)))
+    (one              1)
+    (zero             1)
+    (ident            (mcar x))
+    (drop             0)
+    (branch           (codom (mcar x)))
+    (otherwise
+      (subclass-responsibility x))))
diff --git a/src/bitc/package.lisp b/src/bitc/package.lisp
new file mode 100644
index 000000000..3fbc981c4
--- /dev/null
+++ b/src/bitc/package.lisp
@@ -0,0 +1,46 @@
+(in-package :geb.utils)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; trans module
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(muffle-package-variance
+ (defpackage #:geb.bitc.trans
+   (:local-nicknames (:vamp :geb.vampir.spec))
+   (:use #:geb.common #:geb.bitc.spec)
+   (:shadowing-import-from #:geb.bitc.spec #:drop #:fork)
+   ))
+
+(in-package :geb.bitc.trans)
+
+(pax:defsection @bitc-trans (:title "Bits (Boolean Circuit) Transformations")
+  "This covers transformation functions from"
+  (to-vampir  pax:generic-function)
+  (to-circuit pax:function))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; bitc module
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(geb.utils:muffle-package-variance
+ (uiop:define-package #:geb.bitc.main
+   (:use #:geb.common #:geb.mixins)
+   (:shadowing-import-from #:geb.bitc.spec #:drop #:fork)
+   (:use-reexport #:geb.bitc.trans #:geb.bitc.spec)))
+
+(geb.utils:muffle-package-variance
+ (uiop:define-package #:geb.bitc
+   (:use #:geb.common)
+   (:shadowing-import-from #:geb.bitc.spec :fork :drop)
+   (:use-reexport #:geb.bitc.trans #:geb.bitc.spec #:geb.bitc.main)))
+
+(in-package :geb.bitc.main)
+
+(in-package :geb.bitc)
+
+(pax:defsection @bitc-manual (:title "Bits (Boolean Circuit) Specification")
+  "This covers a GEB view of Boolean Circuits. In particular this type will
+be used in translating GEB's view of Boolean Circuits into Vampir"
+  (@bitc              pax:section)
+  (@bitc-constructors pax:section)
+  (@bitc-trans        pax:section))
diff --git a/src/bitc/trans.lisp b/src/bitc/trans.lisp
new file mode 100644
index 000000000..a46fa67c3
--- /dev/null
+++ b/src/bitc/trans.lisp
@@ -0,0 +1,110 @@
+(in-package :geb.bitc.trans)
+
+(defgeneric to-vampir (morphism values)
+  (:documentation "Turns a BITC term into a Vamp-IR term with a given value"))
+
+(defun to-circuit (morphism name)
+  "Turns a BITC term into a Vamp-IR Gate with the given name"
+  (let* ((wire-count (dom morphism))
+         (wires (loop for i from 1 to wire-count
+                      collect (vamp:make-wire :var (intern (format nil "x~a" i))))))
+    (vamp:make-alias :name name
+                     :inputs wires
+                     :body (to-vampir morphism wires))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Bits to Vampir Implementation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod to-vampir ((obj <bitc>) values)
+  (declare (ignore values))
+  (subclass-responsibility obj))
+
+(-> direct-fields-to-list-vampir (geb.mixins:direct-pointwise-mixin) list)
+(defun direct-fields-to-list (obj)
+  (mapcar #'cdr (geb.mixins:to-pointwise-list obj)))
+
+(defun infix-creation (symbol value1 value2)
+  (vamp:make-infix :op symbol
+                   :lhs value1
+                   :rhs value2))
+
+
+(defmethod to-vampir ((obj compose) values)
+  (to-vampir (mcar obj)
+             (to-vampir (mcadr obj) values)))
+
+(defmethod to-vampir ((obj fork) values)
+  ; Copy input n intput bits into 2*n output bits
+  (append values values))
+
+(defmethod to-vampir ((obj parallel) values)
+  ; toElem[par[car_, cadr_]] :=
+  ;   Function[{inp},
+  ;     Module[{cx, inp1, inp2},
+  ;       cx = dom[car];
+  ;       inp1 = inp[[1 ;; cx]];
+  ;       inp2 = inp[[cx + 1 ;; All]];
+  ;       Flatten[{toElem[car][inp1], toElem[cadr][inp2]}, 1]
+  ;   ]]
+
+
+  ; Take n + m bits, execute car the n bits and cadr on the m bits and 
+  ; concat the results from car and cadr
+  (let* ((car (mcar obj))
+         (cadr (mcadr obj))
+         (cx (dom car))
+         (inp1 (subseq values 0 cx))
+         (inp2 (subseq values cx)))
+    (concatenate 'list (to-vampir car inp1) (to-vampir cadr inp2))))
+
+(defmethod to-vampir ((obj swap) values)
+  ; toElem[swap[n_, m_]] := Flatten[{#[[n + 1 ;; All]], #[[1 ;; n]]}, 1] &
+  ; Turn n + m bits into m + n bits by swapping
+  (let ((n (mcar obj)))
+       (append (subseq values (+ 1 n)) (subseq values 0 (+ 1 n)))))
+
+(defmethod to-vampir ((obj one) values)
+  ; toElem[True] := {1} &
+  ; Produce a bitvector of length 1 containing 1
+  (declare (ignore values))
+  (list (vamp:make-constant :const 1)))
+
+(defmethod to-vampir ((obj zero) values)
+  ; toElem[False] := {0} &
+  ; Produce a bitvector of length 1 containing 0
+  (declare (ignore values))
+  (list (vamp:make-constant :const 0)))
+
+(defmethod to-vampir ((obj ident) values)
+  ; toElem[id[_]] := # &
+  ; turn n bits into n bits by doing nothing
+  values)
+
+(defmethod to-vampir ((obj drop) values)
+  ; toElem[drop[_]] := {} &
+  ; turn n bits into an empty bitvector
+  (declare (ignore values))
+  nil)
+
+(defmethod to-vampir ((obj branch) values)
+  ; toElem[branch[f_, g_]][{x_, values__}] :=
+  ;   Thread@Plus[
+  ;     Times[1 - x, #] & /@ toElem[f][{values}],
+  ;     Times[x, #] & /@ toElem[g][{values}]
+  ;   ]
+
+  ; Look at the first bit.
+  ; If its 1, run f on the remaining bits.
+  ; If its 0, run g on the remaining bits.
+  (let* ((x (car values))
+         (xs (cdr values))
+         (f (mcar obj))
+         (g (mcadr obj))
+         (f-elems (to-vampir f xs))
+         (g-elems (to-vampir g xs)))
+    (mapcar #'(lambda (f-elem g-elem)
+                (infix-creation :+
+                  (infix-creation :* (infix-creation :- (vamp:make-constant :const 1) x) f-elem)
+                  (infix-creation :* x g-elem)))
+            f-elems g-elems)))
diff --git a/src/entry/package.lisp b/src/entry/package.lisp
index 4999f304d..787ae3b58 100644
--- a/src/entry/package.lisp
+++ b/src/entry/package.lisp
@@ -4,6 +4,7 @@
  (defpackage #:geb.entry
    (:documentation "Entry point for the geb codebase")
    (:local-nicknames  (#:poly #:geb.poly)
+                      (#:bitc #:geb.bitc)
                       (:lambda     :geb.lambda))
    (:use #:serapeum #:common-lisp)))
 
diff --git a/src/geb/package.lisp b/src/geb/package.lisp
index 4f3be4840..95977808b 100644
--- a/src/geb/package.lisp
+++ b/src/geb/package.lisp
@@ -6,7 +6,7 @@
  (defpackage #:geb.main
    (:documentation "Gödel, Escher, Bach categorical model")
    (:use #:common-lisp #:geb.generics #:serapeum #:geb.mixins #:geb.utils #:geb.spec)
-   (:local-nicknames (#:poly #:geb.poly.spec))
+   (:local-nicknames (#:poly #:geb.poly.spec) (#:bitc #:geb.bitc.spec))
    (:shadowing-import-from #:geb.spec :left :right :prod :case)
    (:export :prod :case :mcar :mcadr :mcaddr :mcdr :name :func :obj :dom :codom)))
 
@@ -48,7 +48,7 @@
  (defpackage #:geb.trans
    (:documentation "Gödel, Escher, Bach categorical model")
    (:use #:common-lisp #:serapeum #:geb.mixins #:geb.utils #:geb.spec #:geb.main)
-   (:local-nicknames (#:poly #:geb.poly.spec))
+   (:local-nicknames (#:poly #:geb.poly.spec) (#:bitc #:geb.bitc.spec))
    (:shadowing-import-from #:geb.spec :left :right :prod :case)
    (:export :prod :case :mcar :mcadr :mcaddr :mcdr :name :func :obj)))
 
@@ -58,7 +58,8 @@
   "These cover various conversions from @GEB-SUBSTMORPH and @GEB-SUBSTMU
 into other categorical data structures."
   (to-poly    pax:generic-function)
-  (to-circuit pax:function))
+  (to-circuit pax:function)
+  (to-bitc    pax:generic-function))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; bool module
diff --git a/src/geb/trans.lisp b/src/geb/trans.lisp
index 2cb275bbe..c6289f313 100644
--- a/src/geb/trans.lisp
+++ b/src/geb/trans.lisp
@@ -5,6 +5,9 @@
 (defgeneric to-poly (morphism)
   (:documentation "Turns a @GEB-SUBSTMORPH into a POLY:POLY"))
 
+(defgeneric to-bitc (morphism)
+  (:documentation "Turns a @GEB-SUBSTMORPH into a bitc:BITC"))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Morph to Poly Implementation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -78,3 +81,77 @@
   "Turns a @GEB-SUBSTMORPH to a Vamp-IR Term"
   (assure list
     (geb.poly:to-circuit (to-poly obj) name)))
+
+
+
+
+
+
+(defmethod bitwidth ((obj <substobj>))
+  (typecase-of substobj obj
+    (so0     0)
+    (so1     0)
+    (coprod  (+ 1 (max (bitwidth (mcar obj)) (bitwidth (mcadr obj)))))
+    (prod    (+ (bitwidth (mcar obj)) (bitwidth (mcadr obj))))
+    (otherwise (subclass-responsibility obj))))
+
+(defmethod to-bitc ((obj <substmorph>))
+  (typecase-of substmorph obj
+    (substobj      (bitc:ident (bitwidth obj)))
+    ;toBits[comp[f__]] := toBits /@ comp[f]
+    (comp          (bitc:compose (to-bitc (mcar obj))
+                                 (to-bitc (mcadr obj))))
+    ; toBits[init[x_]] := par @@ Table[False, bitWidth@x]
+
+    ; This should never occure, but if it does, it produces a constant morphism onto an all 0s vector
+    (init          (apply #'bitc:parallel (make-list (bitwidth (mcar obj)) :initial-element bitc:zero)))
+    ; toBits[terminal[x_]] := drop[bitWidth@x]
+
+    ; Terminal maps any bitvector onto the empty bitvector
+    (terminal      (bitc:drop (bitwidth (mcar obj))))
+    ;toBits[injectLeft[mcar_, mcadr_]] :=
+    ; par @@ Join[{False, id[bitWidth@mcar]}, Table[False, Max[bitWidth@mcar, bitWidth@mcadr] - bitWidth@mcar]]
+
+    ; Inject-left x -> x + y tags the x with a 0, indicating left, and pads the encoded x with as many zeros
+    ;   as would be needed to store either an x or a y.
+    (inject-left   (apply #'bitc:parallel (append (list bitc:zero (bitc:ident (bitwidth (mcar obj))))
+                                                  (make-list (- (max (bitwidth (mcar obj)) (bitwidth (mcadr obj))) (bitwidth (mcar obj))) :initial-element bitc:zero)
+                                          )))
+    ;toBits[injectRight[mcar_,mcadr_]]:=
+    ;  par@@Join[{True,id[bitWidth@mcadr]},Table[False, Max[bitWidth@mcar, bitWidth@mcadr] - bitWidth@mcadr]]
+
+    ; Inject-right y -> x + y tags the y with a 1, indicating right, and pads the encoded y with as many zeros
+    ;   as would be needed to store either an x or a y.
+    (inject-right  (apply #'bitc:parallel (append (list bitc:one (bitc:ident (bitwidth (mcadr obj)))) 
+                                                  (make-list (- (max (bitwidth (mcar obj)) (bitwidth (mcadr obj))) (bitwidth (mcadr obj))) :initial-element bitc:zero)
+                                          )))
+    ;toBits[case[mcar_,mcadr_]]:=
+    ;  branch[
+    ;    par[toBits@mcar,id[Max[dom@mcar,dom@mcadr]-dom@mcar]],
+    ;    par[toBits@mcadr,id[Max[dom@mcar,dom@mcadr]-dom@mcadr]]
+    ;  ]
+
+    ; Case translates directly into a branch.
+    ; The sub-morphisms of case are padded with drop so they have the same input lengths.
+    (case          (bitc:branch (bitc:parallel (to-bitc (mcar obj))  (bitc:drop (- (max (bitwidth (dom (mcar obj))) (bitwidth (dom (mcadr obj)))) (bitwidth (dom (mcar obj))))))
+                                (bitc:parallel (to-bitc (mcadr obj)) (bitc:drop (- (max (bitwidth (dom (mcar obj))) (bitwidth (dom (mcadr obj)))) (bitwidth (dom (mcadr obj))))))))
+    ; toBits[projectRight[mcar_, mcadr_]] := par[drop[bitWidth@mcar], id[bitWidth@mcadr]]
+
+    ; project-left just drops any bits not being used to encode the first component. 
+    (project-left  (bitc:parallel (bitc:ident (bitwidth (mcar obj))) (bitc:drop (bitwidth (mcadr obj)))))
+    ; toBits[projectLeft[mcar_, mcadr_]] := par[id[bitWidth@mcar], drop[bitWidth@mcadr]]
+
+    ; project-right just drops any bits not being used to encode the second component.
+    (project-right (bitc:parallel (bitc:drop (bitwidth (mcar obj))) (bitc:ident (bitwidth (mcadr obj)))))
+    ; toBits[pair[mcar_, mcdr_]] := comp[par[toBits[mcar], toBits[mcdr]], fork[dom[mcar]]]
+
+    ; Pair will copy the input and run the encoded morphisms in pair on the two copied subvetors.
+    (pair          (bitc:compose (bitc:parallel (to-bitc (mcar obj)) (to-bitc (mcdr obj))) (bitc:fork (bitwidth (dom (mcar obj))))))
+    ;toBits[distribute[mcar_, mcadr_, mcaddr_]] :=
+    ;  par[swap[bitWidth[mcar], 1], id[Max[bitWidth@mcadr, bitWidth@mcaddr]]]
+
+    ; a * (b + c) will be encoded as [a] [0 or 1] [b or c]. By swapping the [0 or 1] with [a], we get an encoding for
+    ; (a * b) + (a * c).
+    (distribute    (bitc:parallel (bitc:swap (bitwidth (mcar obj)) 1) (bitc:ident (max (bitwidth (mcadr obj)) (bitwidth (mcaddr obj))))))
+    (otherwise (subclass-responsibility obj))))
+
diff --git a/src/specs/bitc-printer.lisp b/src/specs/bitc-printer.lisp
new file mode 100644
index 000000000..a2a936fbe
--- /dev/null
+++ b/src/specs/bitc-printer.lisp
@@ -0,0 +1,29 @@
+;; TO DO: 
+
+
+(in-package #:geb.bitc.spec)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Subst Constructor Printer
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; we are going to be super lazy about this, just make a format
+(defmacro easy-printer (class-name)
+  `(defmethod print-object ((obj ,class-name) stream)
+     (print-object (cons ',class-name
+                         (mapcar #'cdr (geb.mixins:to-pointwise-list obj)))
+                   stream)))
+
+(easy-printer compose)
+(easy-printer fork)
+(easy-printer parallel)
+(easy-printer swap)
+(easy-printer one)
+(easy-printer zero)
+(easy-printer ident)
+(easy-printer drop)
+(easy-printer branch)
+
+(defmethod print-object ((obj ident) stream)
+  (print-unreadable-object (obj stream :type nil :identity nil)
+    (format stream "IDENT")))
diff --git a/src/specs/bitc.lisp b/src/specs/bitc.lisp
new file mode 100644
index 000000000..de285944d
--- /dev/null
+++ b/src/specs/bitc.lisp
@@ -0,0 +1,119 @@
+(in-package #:geb.bitc.spec)
+
+(deftype bitc ()
+  `(or compose fork parallel swap one zero ident drop branch))
+
+(defclass <bitc> (geb.mixins:direct-pointwise-mixin cat-morph) ())
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Constructor Morphisms for Bits (Objects are just natural numbers)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defclass compose (<bitc>)
+  ((mcar :initarg :mcar
+         :accessor mcar
+         :documentation "")
+   (mcadr :initarg :mcadr
+          :accessor mcadr
+          :documentation "")))
+
+(defclass fork (<bitc>)
+  ((mcar :initarg :mcar
+         :accessor mcar
+         :documentation "")))
+
+(defclass parallel (<bitc>)
+  ((mcar :initarg :mcar
+         :accessor mcar
+         :documentation "")
+   (mcadr :initarg :mcadr
+          :accessor mcadr
+          :documentation "")))
+
+(defclass swap (<bitc>)
+  ((mcar :initarg :mcar
+         :accessor mcar
+         :documentation "")
+   (mcadr :initarg :mcadr
+          :accessor mcadr
+          :documentation "")))
+
+(defclass one (<bitc>)
+  ())
+
+(defclass zero (<bitc>)
+  ())
+
+(defclass ident (<bitc>)
+  ((mcar :initarg :mcar
+         :accessor mcar
+         :documentation "")))
+
+(defclass drop (<bitc>)
+  ((mcar :initarg :mcar
+         :accessor mcar
+         :documentation "")))
+
+(defclass branch (<bitc>)
+  ((mcar :initarg :mcar
+         :accessor mcar
+         :documentation "")
+   (mcadr :initarg :mcadr
+          :accessor mcadr
+          :documentation "")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Constructors
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro make-multi (constructor)
+  `(defun ,constructor (mcar mcadr &rest args)
+     ,(format nil "Creates a multiway constructor for [~A]" constructor)
+     (reduce (lambda (x y)
+               (make-instance ',constructor :mcar x :mcadr y))
+             (list* mcar mcadr args)
+             :from-end t)))
+
+(make-multi parallel)
+(make-multi compose)
+
+(defun fork (mcar)
+  "FORK ARG1"
+  (make-instance 'fork :mcar mcar))
+
+(defun swap (mcar mcadr)
+  "swap ARG1 and ARG2"
+  (make-instance 'swap :mcar mcar :mcadr mcadr))
+
+(defvar one
+  (make-instance 'one))
+
+(defvar zero
+  (make-instance 'zero))
+
+(defun ident (mcar)
+  "ident ARG1"
+  (make-instance 'ident :mcar mcar))
+
+(defun drop (mcar)
+  "drop ARG1"
+  (make-instance 'drop :mcar mcar))
+
+(defun branch (mcar mcadr)
+  "branch with ARG1 or ARG2"
+  (make-instance 'branch :mcar mcar :mcadr mcadr))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Pattern Matching
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Ι don't do multi way pattern matching yet :(
+(make-pattern compose     mcar mcadr)
+(make-pattern fork        mcar)
+(make-pattern parallel    mcar mcadr)
+(make-pattern swap        mcar mcadr)
+(make-pattern one         )
+(make-pattern zero        )
+(make-pattern ident       mcar)
+(make-pattern drop        mcar)
+(make-pattern branch      mcar mcadr)
diff --git a/src/specs/package.lisp b/src/specs/package.lisp
index e23f5529f..feb69998a 100644
--- a/src/specs/package.lisp
+++ b/src/specs/package.lisp
@@ -9,6 +9,12 @@
    (:shadow :+ :* :/ :- :mod)
    (:use #:geb.utils #:cl)))
 
+(muffle-package-variance
+ (defpackage #:geb.bitc.spec
+   (:export :dom :codom)
+   (:shadow :drop :fork)
+   (:use #:geb.utils #:cl #:geb.mixins)))
+
 ;; please document this later.
 (muffle-package-variance
  (uiop:define-package #:geb.lambda.spec
@@ -95,6 +101,39 @@ constructors"
   (if-zero pax:function)
   (if-lt   pax:function))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Geb Bits Package Documentation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(in-package :geb.bitc.spec)
+
+(pax:defsection @bitc (:title "Bits Types")
+  "This section covers the types of things one can find in the [BITS]
+constructors"
+  (bitc     pax:type)
+  (<bitc>   pax:type)
+  (compose  pax:type)
+  (fork     pax:type)
+  (parallel pax:type)
+  (swap     pax:type)
+  (one      pax:type)
+  (zero     pax:type)
+  (ident    pax:type)
+  (drop     pax:type)
+  (branch   pax:type))
+
+(pax:defsection @bitc-constructors (:title "Bits (Boolean Circuit) Constructors")
+  "Every accessor for each of the CLASS's found here are from @GEB-ACCESSORS"
+  (compose  pax:type)
+  (fork     pax:type)
+  (parallel pax:type)
+  (swap     pax:type)
+  (one      pax:type)
+  (zero     pax:type)
+  (ident    pax:type)
+  (drop     pax:type)
+  (branch   pax:type))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Geb lambda Package Documentation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/test/bitc.lisp b/test/bitc.lisp
new file mode 100644
index 000000000..b992f0280
--- /dev/null
+++ b/test/bitc.lisp
@@ -0,0 +1,16 @@
+(in-package :geb-test)
+
+(define-test geb-bitc :parent geb-test-suite)
+
+(def test-circuit-1
+  (bitc:to-circuit 
+    (bitc:compose 
+      (bitc:branch
+        (bitc:parallel (bitc:compose (bitc:parallel bitc:zero (bitc:ident 0))  (bitc:drop 1)) (bitc:ident 0))
+        (bitc:parallel (bitc:parallel (bitc:ident 1) (bitc:drop 0)) (bitc:ident 0))) 
+      (bitc:parallel (bitc:swap 1 1) (bitc:ident 0)))
+    :tc_1))
+
+(define-test vampir-converter
+  :parent geb-bitc
+  (of-type geb.vampir.spec:alias test-circuit-1))
diff --git a/test/geb.lisp b/test/geb.lisp
index fd500b705..65debee85 100644
--- a/test/geb.lisp
+++ b/test/geb.lisp
@@ -102,6 +102,8 @@
 
 (def test-poly-2 (geb:to-poly test-morph-2))
 
+(def test-bitc-2 (geb:to-bitc test-morph-2))
+
 (def test-circuit-2 (geb:to-circuit test-morph-2 :tc_2))
 
 (define-test vampir-test-2
diff --git a/test/package.lisp b/test/package.lisp
index 60885f89d..229c7a564 100644
--- a/test/package.lisp
+++ b/test/package.lisp
@@ -4,6 +4,7 @@
   (:shadowing-import-from :serapeum  :true)
   (:shadow :value :children)
   (:local-nicknames  (#:poly #:geb.poly)
+                     (#:bitc #:geb.bitc)
                      (#:lambda #:geb.lambda))
   (:use #:geb.common #:parachute))