1 ;;;; we add an automagical &rest, because cl-unification's cl-ppcre support 2 ;;;; requires matching the entire string, and we're generally concerned with 3 ;;;; just the beginning of it. 4 (in-package #:oh-ducks) 5 6 (defmethod make-template ((kind (eql 'regexp+)) (spec cons)) 7 (destructuring-bind (re-kwd regexp &optional vars &rest keys) 8 spec 9 (declare (ignore re-kwd)) 10 (make-instance 'unify::regular-expression-template 11 :spec (list* 'unify::regexp 12 (concatenate 'string regexp "(.*)$") 13 (append vars '(?&rest)) 14 keys)))) 15 16 ;; for parsing front-to-back 17 (defmethod make-template ((kind (eql 'regexp^)) (spec cons)) 18 (destructuring-bind (re-kwd regexp &optional vars &rest keys) 19 spec 20 (declare (ignore re-kwd)) 21 (make-instance 'unify::regular-expression-template 22 :spec (list* 'unify::regexp 23 (concatenate 'string "^" regexp "(.*)$") 24 (append vars '(?&rest)) 25 keys)))) 26 27 ;; For parsing back-to-front 28 (defmethod make-template ((kind (eql 'regexp$)) (spec cons)) 29 (destructuring-bind (re-kwd regexp &optional vars &rest keys) 30 spec 31 (declare (ignore re-kwd)) 32 (make-instance 'unify::regular-expression-template 33 :spec (list* 'unify::regexp 34 (cond 35 ((stringp regexp) 36 (concatenate 'string "^(.*?)" regexp "$")) 37 ((listp regexp) 38 `(:sequence :start-anchor 39 (:register (:non-greedy-repetition 0 nil :everything)) 40 ,@regexp 41 :end-anchor)) 42 (t (error "Unknown regexp format."))) 43 (append '(?&rest) vars) 44 keys)))) 45 46 ;; (match (#t(regexp+ "^f(o+)" (?o)) "fooooooobar") (values o &rest)) 47 ;; => "ooooooo", "bar" 48 49 ;; prevent clisp from crashing when it loads .fas files with our regexp templates in them 50 (defmethod make-load-form ((object unify::regular-expression-template) &optional env) 51 (declare (ignore env)) 52 `(make-template ',(first (template-spec object)) ',(template-spec object)) 53 #+(or) ; make-instance should be fine, too 54 `(make-instance ',(class-of object) :spec ',(template-spec object)))