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)))