Skip to content

Instantly share code, notes, and snippets.

Last active November 15, 2023 18:17
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
What would you like to do?
let's write a dsl code example
#!/usr/local/bin/sbcl --script
; this is the full DSL example described in this blog post:
; 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
;; 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*)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment