Plaster
New
List
Login
common-lisp
default
phoe
2022.02.12 15:03:34
CL-USER> (ql:quickload :alexandria) To load "alexandria": Load 1 ASDF system: alexandria ; Loading "alexandria" (:ALEXANDRIA) CL-USER> (defpackage :LTPL (:use :cl) (:local-nicknames (:a :alexandria-2))) #<PACKAGE "LTPL"> CL-USER> (in-package :LTPL) #<PACKAGE "LTPL"> LTPL> (defmacro verify-token (symbol acceptable-variants) (let ((symbol-then-do (a:symbolicate :if- symbol :-then)) (symbol-search-occurance (a:symbolicate :search- symbol :-occurance))) `(progn (defun ,symbol (string) "determines if a string is a valid variant of that symbol" (dolist (pattern ',acceptable-variants) (when (string= string pattern) (return t)))) (defun ,symbol-then-do (string &rest forms) "checks if the string is a valid variant and if it evaluates to true it excutes the expressions passed in the body" (when (,symbol string) (progn forms))) (defun ,symbol-search-occurance (string) "searchs for a variant in a given string" (let ((cords '()) (start 0)) (dolist (pattern ',acceptable-variants) (setf start (search pattern string)) (unless (null start) (a:appendf cords (cons start (+ start (length pattern)))))) cords))))) VERIFY-TOKEN LTPL> (macroexpand-1 '(verify-token reader-directive ("==" "||"))) (PROGN (DEFUN READER-DIRECTIVE (STRING) "determines if a string is a valid variant of that symbol" (DOLIST (PATTERN '("==" "||")) (WHEN (STRING= STRING PATTERN) (RETURN T)))) (DEFUN IF-READER-DIRECTIVE-THEN (STRING &REST FORMS) "checks if the string is a valid variant and if it evaluates to true it excutes the expressions passed in the body" (WHEN (READER-DIRECTIVE STRING) (PROGN FORMS))) (DEFUN SEARCH-READER-DIRECTIVE-OCCURANCE (STRING) "searchs for a variant in a given string" (LET ((CORDS 'NIL) (START 0)) (DOLIST (PATTERN '("==" "||")) (SETF START (SEARCH PATTERN STRING)) (UNLESS (NULL START) (ALEXANDRIA:APPENDF CORDS (CONS START (+ START (LENGTH PATTERN)))))) CORDS))) T
Raw
Annotate
Repaste