From a8b56704b52488f2865387d8cded8e5f13cdf919 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= <jtomas1815@gmail.com>
Date: Mon, 16 Jan 2023 00:30:57 -0300
Subject: Add alien call similar to what chezscheme has

---
 alien.lisp   | 12 ++++++++++++
 package.lisp |  4 ++++
 queue.lisp   | 11 ++++-------
 utils.asd    |  1 +
 4 files changed, 21 insertions(+), 7 deletions(-)
 create mode 100644 alien.lisp

diff --git a/alien.lisp b/alien.lisp
new file mode 100644
index 0000000..3451dc9
--- /dev/null
+++ b/alien.lisp
@@ -0,0 +1,12 @@
+(in-package #:alien)
+
+(defmacro call (fname rtype &rest types-n-values)
+  (let ((tlist (queue:new))
+        (vlist (queue:new)))
+    (dolist (item types-n-values)
+      (queue:add tlist (first item))
+      (queue:add vlist (second item)))
+    `(alien-funcall (extern-alien ,fname
+                                  (function ,rtype
+                                            ,@(queue:to-list tlist)))
+                    ,@(queue:to-list vlist))))
diff --git a/package.lisp b/package.lisp
index ebbe43b..f4158be 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,3 +1,7 @@
+(defpackage #:alien
+  (:use #:cl #:sb-alien)
+  (:export #:call))
+
 (defpackage #:print
   (:use #:cl)
   (:export #:table))
diff --git a/queue.lisp b/queue.lisp
index cc91eb8..c900731 100644
--- a/queue.lisp
+++ b/queue.lisp
@@ -1,6 +1,6 @@
 (in-package #:queue)
 
-(declaim (optimize (speed 3) (safety 0)))
+(declaim (optimize (speed 3) (safety 1)))
 
 (defun new ()
   (cons nil nil))
@@ -8,12 +8,9 @@
 (defun add (q datum)
   (let ((element (cons datum nil)))
     (if (car q)
-      (progn
-        (setf (cddr q) element)
-        (setf (cdr q) (cddr q)))
-      (progn
-        (setf (car q) element)
-        (setf (cdr q) element)))
+      (setf (cddr q) element)
+      (setf (car q) element))
+    (setf (cdr q) element)
     q))
 
 (defun sub (q)
diff --git a/utils.asd b/utils.asd
index a810c67..bd97c0c 100644
--- a/utils.asd
+++ b/utils.asd
@@ -3,5 +3,6 @@
   :components
   ((:file "package")
    (:file "queue")
+   (:file "alien")
    (:file "print")
    (:file "str")))
-- 
cgit v1.2.3