Merge remote-tracking branches 'origin/artem/vampir-lists' and 'origi…

…n/artem/vampir-exponential'
anoma · Jun 30, 2023 · e914e7d · e914e7d
3 parents 91db30f + e5d5bfd + 8b47964
commit e914e7d
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 12 deletions.
diff --git a/src/vampir/package.lisp b/src/vampir/package.lisp
@@ -43,8 +43,11 @@
     ;; vampir api functions
     :*bool*
     :bool
+    :*base-range*
     :*next-range*
     :next-range
+    :*range-n*
+    :range-n
     :*range32*
     :range32
 

diff --git a/src/vampir/spec.lisp b/src/vampir/spec.lisp
@@ -28,7 +28,8 @@
   `(or wire constant))
 
 (deftype primitive ()
-  `(or (eql :+) (eql :-) (eql :*) (eql :^) (eql :\\) (eql :%) (eql :/)))
+  `(or (eql :+) (eql :-) (eql :*) (eql :^) (eql :\\)
+       (eql :%) (eql :/) (eql :|:|) (eql :^)))
 
 (deftype constraint-list ()
   `(satisfies constraint-list))

diff --git a/src/vampir/vampir.lisp b/src/vampir/vampir.lisp
@@ -122,6 +122,14 @@
    :func :negative31
    :arguments (list a)))
 
+
+(defparameter *base-range*
+  (make-alias
+   :name :base_range
+   :inputs (list (make-constant :const 0))
+   :body
+   (list (make-wire :var :[]))))
+
 (defparameter *next-range*
   (let ((a-wire (make-wire :var :a)))
     (make-alias
@@ -149,18 +157,25 @@
                                     (make-infix :op :\\
                                                 :lhs a-wire
                                                 :rhs (make-constant :const 2)))))
-      (make-equality :lhs a-wire
-                     :rhs
-                     (make-infix :op :+
-                                 :lhs (make-wire :var :a0)
-                                 :rhs (make-infix :op :*
-                                                  :lhs (make-constant :const 2)
-                                                  :rhs (make-wire :var :a1))))
-      (make-tuples :wires (list
-                           (make-wire :var :a0)
-                           (make-application :func :range
+      (make-infix :op :|:|
+                      :lhs (make-wire :var :a0)
+                      :rhs (make-application :func :range
                                              :arguments
-                                             (list (make-wire :var :a1)))))))))
+                                             (list (make-wire :var :a1))))))))
+(defparameter *range-n*
+  (make-alias
+   :name :range-n
+   :inputs (list :n)
+   :body
+   (list (make-application :func :iter
+                           :arguments (list (make-wire :var :n)
+                                            (make-wire :var :next_range)
+                                            (make-wire :var :base_range))))))
+
+(defun range-n (n a)
+  (make-application :func :range-n
+                    :arguments (list n
+                                     a)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Range