Last active
November 15, 2023 18:17
-
-
Save inconvergent/8d2ac65d0990f1ea8a25c4c607adab56 to your computer and use it in GitHub Desktop.
let's write a dsl code example
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/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*) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment