Control flow macros

control-flow.lisp

@@ -0,0 +1,44 @@
+(in-package #:syrup)
+
+(defun translate-if* (test body)
+  (let ((then-forms
+          ;; Collect all un-enclosed forms at the start of the body, and skip past them.
+          ;; These forms are considered part of an implicit :THEN clause.
+          (loop :for tail :on body
+                :for form := (car tail)
+                :until (and (consp form) (find (car form) '(:then :else-if :else)))
+                :collect form
+                :finally (setf body tail)))
+        (else-if-forms nil)
+        (else-forms nil))
+    ;; Handle :THEN, :ELSE, and :ELSE-IF clauses
+    (loop :for tail :on body
+          :for form := (car tail)
+          :do
+          (unless (consp form) (error "Not a valid IF* clause: ~S" form))
+          (case (car form)
+            (:then
+             (when then-forms (error "Duplicate :THEN clause"))
+             (setf then-forms (cdr form)))
+            (:else
+             (when (cdr tail) (error "Junk after :ELSE clause: ~S" (cdr tail)))
+             (setf else-forms (cdr form))
+             (loop-finish))
+            (:else-if ;; handle these recursively
+             (setf else-forms (list (translate-if* (cadr form) `((:then ,@(cddr form)) ,@(cdr tail)))))
+             (loop-finish))
+            (t (error "Not a valid IF* clause: ~S" form))))
+    ;; Now build the if statement
+    (labels ((maybe-progn (x)
+               (if (cdr x) (cons 'progn x) (car x))))
+      (if else-forms
+          `(if ,test ,(maybe-progn then-forms) ,(maybe-progn else-forms))
+          `(when ,test ,@then-forms)))))
+(defmacro if* (test &body body)
+  "An easier-to-read conditional statement."
+  (translate-if* test body))
+
+(defmacro while (test &body body)
+  "Repeatedly evaluate BODY while TEST is true. Return the result of the last iteration, a la PROGN."
+  (let ((result-var (gensym)))
+    `(do (,result-var) ((not ,test) ,result-var) (setf ,result-var (progn ,@body)))))

exports.lisp

@@ -1,7 +1,8 @@
 (in-package #:syrup)
+;; Support for inline and in-file symbol exports.
 
 (defvar *capture-exports* nil
-  "If non-nil, #^ doesn't export symbols. Either T, NIL, or the package to be monitored.")
+  "If non-nil, #^ won't export symbols, and will instead add to *exports*. Either T, NIL, or a specific package to monitor.")
 (defvar *exports* nil
   "List of captured symbol exports.")
 
@@ -50,7 +51,7 @@
   "Read Lisp source code from STREAM to determine the list of symbols it exports."
   (when target-package
     (let ((pkg (find-package target-package)))
-      (assert pkg () "No such package ~S" target-package)
+      (unless pkg (error "No such package: ~S" target-package))
       (setf target-package pkg)))
   (let ((*package* *package*)
         (*readtable* *readtable*)
@@ -60,15 +61,16 @@
     (loop for form = (read stream nil eof-sentinel)
           until (eq form eof-sentinel)
           do (when (consp form)
-               (if (eql (car form) 'in-package)
-                   (let ((pkg (find-package (cadr form))))
-                     (assert pkg () "No such package ~S" (cadr form))
-                     (setf *package* pkg)
-                     (if (eq t *capture-exports*)
-                         (setf *capture-exports* pkg)))
-                   (when (and (eql (car form) 'export*)
-                              (eq *package* *capture-exports*))
-                     (setf *exports* (nconc (mapcar #'ensure-symbol (cdr form)) *exports*))))))
+               (case (car form)
+                 (in-package
+                  (let ((pkg (find-package (cadr form))))
+                    (unless pkg (error "No such package: ~S" (cadr form)))
+                    (setf *package* pkg)
+                    (when (eq t *capture-exports*)
+                      (setf *capture-exports* pkg))))
+                 (export*
+                  (when (eq *package* *capture-exports*)
+                    (setf *exports* (nconc (mapcar #'ensure-symbol (cdr form)) *exports*)))))))
     *exports*))
 
 (defmacro defpackage* (package-name &rest options)
@@ -76,6 +78,8 @@
   (let ((extra-exports nil)
         (pkg (find-package package-name)))
     (when pkg
+      ;; We're redefining the package, so let's scan the files we know about for exported symbols.
+      ;; This prevents them from being un-exported if the files are re-loaded out of order.
       (dolist (pathname (gethash pkg *package-files-table*))
         (let ((exports (with-open-file (stream pathname :if-does-not-exist nil)
                          (read-stream-for-exports stream pkg))))

syrup.asd

@@ -1,9 +1,10 @@
 (asdf:defsystem "syrup"
   :description "Assorted syntactic sugar for Lisp."
-  :version "1.0"
+  :version "1.1"
   :author "~keith <keith@keithhacks.cyou>"
   :homepage "https://bytes.keithhacks.cyou/keith/syrup"
   :license "Public Domain/CC0"
   :components ((:file "syrup")
-               (:file "exports"))
+               (:file "exports")
+               (:file "control-flow"))
   :serial t)

syrup.lisp

@@ -1,7 +1,12 @@
 (defpackage #:syrup
   (:use #:cl)
   (:export
-   #:*capture-exports* #:*exports* #:export* #:defpackage* #:mark-package-file))
+   #:simple-reader-error
+   ;; exports.lisp
+   #:export* #:defpackage*
+   ;; control-flow.lisp
+   #:if* #:while
+   ))
 (in-package #:syrup)
 
 (define-condition simple-reader-error (simple-condition reader-error) ())