From 9beaef57b74cd9246482d684e04a4b3fbda9b262 Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Thu, 18 Apr 2024 23:34:28 -0700
Subject: added <? and ?; refactored a little

---
 obwyn.lisp | 61 ++++++++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 44 insertions(+), 17 deletions(-)

diff --git a/obwyn.lisp b/obwyn.lisp
index db2f778..58eeff0 100644
--- a/obwyn.lisp
+++ b/obwyn.lisp
@@ -1,7 +1,8 @@
 (defpackage #:obwyn
   (:use #:cl)
   (:local-nicknames
-   (#:a #:alexandria-2)))
+   (#:a #:alexandria-2))
+  (:export #:<- #:<~ #:>> #:<? #:?))
 
 (in-package :obwyn)
 
@@ -49,18 +50,32 @@
                            `(progn ,form ,@(rest expanded)))
                           (t
                            `(progn ,form ,expanded))))
-                   (:multiple-value-bind
-                         `(multiple-value-bind
-                                ,(if (listp bindings) bindings (list bindings))
-                              ,form
-                            ,@(if (and (listp expanded) (eq 'cl:progn (first expanded)))
-                                  (rest expanded)
-                                  (list expanded))))
-                   (:destructuring-bind
-                       `(destructuring-bind ,bindings ,form
-                          ,@(if (and (listp expanded) (eq 'cl:progn (first expanded))) 
-                                (rest expanded)
-                                (list expanded))))))
+
+                   (:unless
+                    (cond ((null expanded) form)
+                          ((eq 'cl:progn (first expanded))
+                           `(progn (unless ,form (return)) ,@(rest expanded)))
+                          (t
+                           `(progn (unless ,form (return)) ,expanded))))
+
+                   (:mvbind
+                    `(multiple-value-bind
+                           ,(if (listp bindings) bindings (list bindings))
+                         ,form
+                       ,@(if (and (listp expanded) (eq 'cl:progn (first expanded)))
+                             (rest expanded)
+                             (list expanded))))
+                   (:bindif
+                    `(a:when-let (,bindings ,form) 
+                       ,@(if (and (listp expanded) (eq 'cl:progn (first expanded)))
+                             (rest expanded)
+                             (list expanded))))
+                   
+                   (:dsbind
+                    `(destructuring-bind ,bindings ,form
+                       ,@(if (and (listp expanded) (eq 'cl:progn (first expanded))) 
+                             (rest expanded)
+                             (list expanded))))))
         :finally (return
                    (if (and (listp expanded) (eq 'cl:progn (first expanded)))
                        `(block nil ,@(rest expanded))
@@ -70,7 +85,7 @@
 (defun literals-equal (a b)
   (and (symbolp a) (symbolp b) (string-equal a b)))
 
-(argot:deflanguage >>> (:literals= #'literals-equal)
+(argot:deflanguage >> (:literals= #'literals-equal)
   (<start>
    :match (:seq (:* <clause>) (:eof))
    :then (expand-clauses (first <start>)))
@@ -78,14 +93,22 @@
   (<clause>
    :match (:or <binding-clause>
                <destructuring-clause>
+               <predicate-binding-clause>
+               <predicate-clause>
                <simple-clause>)) 
   
   (<binding-clause>
    :match (:seq <values-bind> (:= :<-) (:item))
    :then (destructuring-bind (bindings _ form) <binding-clause>
            (declare (ignore _))
-           (list :multiple-value-bind bindings form)))
+           (list :mvbind bindings form)))
 
+  (<predicate-binding-clause>
+   :match (:seq (:@ var (:item)) (:= :<?) (:@ form (:item)))
+   :if (and (symbolp var) (not (keywordp var)))
+   :then (list :bindif var form)
+   :note "Bind variable to form, exit early if form evaluated to nil.")
+  
   (<values-bind>
    :match (:item)
    :if values-binding-p
@@ -95,15 +118,19 @@
    :match (:seq <destructuring-list> (:= :<~) (:item))
    :then (destructuring-bind (bindings _ form) <destructuring-clause>
            (declare (ignore _))
-           (list :destructuring-bind bindings form)))
+           (list :dsbind bindings form)))
 
   (<destructuring-list>
    :match (:item)
    :if destructuring-bind-list-p
    :note "An list that might be passed as the first argument to DESTRUCTURING-BIND.")  
+
+  (<predicate-clause>
+   :match (:seq (:= :?) (:item))
+   :then (list :unless nil (second <predicate-clause>)))
   
   (<simple-clause>
    :match (:@ simple (:item))
-   :if (not (member simple '(:<~ :<-)))
+   :if (not (member simple '(:<~ :<- :? :<?) :test #'literals-equal))
    :then (list :simple nil simple)))
 
-- 
cgit v1.2.3