Fix geb->bitc with init and move over the default backend to bitc

This commit fixes a bug with init where init a domain with less than 2
bits would cause init to crash

Further we move the default compilation pipeline to use the bitc backend

src/geb/trans.lisp

@@ -73,7 +73,7 @@
 (defmethod to-circuit ((obj <substmorph>) name)
   "Turns a @GEB-SUBSTMORPH to a Vamp-IR Term"
   (assure geb.vampir.spec:statement
-    (to-circuit (to-poly obj) name)))
+    (to-circuit (to-bitc obj) name)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Morph to Bitc Implementation
@@ -97,7 +97,11 @@
     ;; This should never occure, but if it does, it produces a
     ;; constant morphism onto an all 0s list
     (init
-     (apply #'bitc:parallel (zero-list (bitwidth (mcar obj)))))
+     (let* ((list (zero-list (bitwidth (mcar obj))))
+            (len  (length list)))
+       (cond ((= 0 len) (bitc:drop 0))
+             ((= 1 len) bitc:zero)
+             (t         (apply #'bitc:parallel list)))))
     ;; Terminal maps any bit-list onto the empty bit-list
     (terminal
      (bitc:drop (bitwidth (mcar obj))))

src/lambda/package.lisp

@@ -24,7 +24,7 @@
 (geb.utils:muffle-package-variance
  (uiop:define-package #:geb.lambda.trans
    (:documentation "A basic lambda translator into other parts of geb")
-   (:shadow #:to-poly #:to-circuit)
+   (:shadow #:to-poly #:to-circuit #:to-bitc)
    (:mix #:geb.lambda.spec #:geb.common #:common-lisp :geb.lambda.main)))
 
 (in-package #:geb.lambda.trans)
@@ -39,6 +39,7 @@
 data types"
   (compile-checked-term pax:generic-function)
   (to-poly              pax:function)
+  (to-bitc              pax:function)
   (to-circuit           pax:function)
   (@utility             pax:section))
 

src/lambda/trans.lisp

@@ -11,17 +11,21 @@
 (defgeneric compile-checked-term (context type term)
   (:documentation "Compiles a checked term into SubstMorph category"))
 
-(-> to-poly (list t <stlc>) (or geb.poly:<poly> geb.poly:poly))
+(-> to-poly (list t <stlc>) t)
+(defun to-bitc (context type obj)
+  (~>> obj
+       (compile-checked-term context type)
+       geb.common:to-bitc))
+
 (defun to-poly (context type obj)
-  (assure (or geb.poly:<poly> geb.poly:poly)
-    (~>> obj
-         (compile-checked-term context type)
-         geb.common:to-poly)))
+  (~>> obj
+       (compile-checked-term context type)
+       geb.common:to-poly))
 
 (-> to-circuit (list t <stlc> keyword) geb.vampir.spec:statement)
 (defun to-circuit (context type obj name)
   (assure geb.vampir.spec:statement
-    (~> (to-poly context type obj)
+    (~> (to-bitc context type obj)
         (geb.common:to-circuit name))))
 
 (defmethod empty ((class (eql (find-class 'list)))) nil)