let's write a dsl code example

lets-write-a-dsl.lisp

#!/usr/local/bin/sbcl --script

; this is the full DSL example described in this blog post:
; https://inconvergent.net/2023/lets-write-a-dsl/
; the code is explained in more detail in the post

(defun mkstr (&rest args)
  (with-output-to-string (s)
    (dolist (a args) (princ a s))))

(defun symb (&rest args)
  (values (intern (apply #'mkstr args))))

(defun startswith? (s pre)
  (let ((s (mkstr s)))
    (and (>= (length s) (length pre))
         (string= pre s :end2 (length pre)))))

(defun has-trigger? (body trig)
  (and (listp body)
       (startswith? (car body) trig)))

(defun do-trigger (l body)
  (let ((fx (subseq (mkstr (car body)) 2)))
    (if (equal "ITR" fx)
        `(loop for $ in ,l
               if (startswith? (car $) ,(second body))
               do ,@(rec l (subseq body 2)))
        `(,(symb fx) $ ,@(rec l (cdr body))))))

(defun rec (l body)
  (cond ((atom body) body)
        ((has-trigger? body ".&")
           (do-trigger l body))
        (t `(,(rec l (car body))
             ,@(rec l (cdr body))))))

(defmacro select (l &body body)
  (let ((l* (gensym "L")))
    (print `(let ((,l* ,l))
              ,@(rec l* body)))))

; ex1:
(select `((urq 77) (abc 3) (abcd 2) (dec 8))
  (.&itr "DE" (.&print)))

; ex2:
(select `((urq 77) (abc 3) (abcd 2) (dec 8))
  (.&itr "DE" (print (list 'hit $)))    ; explicit $
  ; two forms in the body of itr:
  (.&itr "AB" (print 'hi)               ; no $
              (print (.&list 'ohhai)))) ; implicit $






;;;;; BELOW are some extra examples that might be useful for
;;;;; understanding macros better

(print (macroexpand-1
  '(select l ((urq 77) (abc 3) (abcd 2) (dec 8))
             (.&itr "DE" (.&print)))))
; output
;; (LET ((#:L94 L))
;;   ((URQ 77) (ABC 3) (ABCD 2) (DEC 8))
;;   (LOOP FOR $ IN #:L94
;;         IF (STARTSWITH? (CAR $) "DE")
;;         DO (PRINT $)))

(defmacro dummy (a b)
  (format t "~&compiling dummy:~%~a ~a~&" a b)
  ; this is the actual code that will be returned:
  `(format t "~&executing expanded code:~%~a ~a~&" ,a ,b))

(dummy 1 2)

(let ((a* 1) (b* 2)) (dummy a* b*))

; (macroexpand-1 '(dummy 1 2))
;; (FORMAT T "~&executing expanded code:~%~a ~a~&" 1 2)

; (macroexpand-1 '(dummy a* b*))
;; (FORMAT T "~&executing expanded code:~%~a ~a~&" A* B*)