;;;; we add an automagical &rest, because cl-unification's cl-ppcre support
;;;; requires matching the entire string, and we're generally concerned with
;;;; just the beginning of it.
(in-package #:oh-ducks)

(defmethod make-template ((kind (eql 'regexp+)) (spec cons))
  (destructuring-bind (re-kwd regexp &optional vars &rest keys)
      spec
    (declare (ignore re-kwd))
    (make-instance 'unify::regular-expression-template
                   :spec (list* 'unify::regexp
                                (concatenate 'string regexp "(.*)$")
                                (append vars '(?&rest))
                                keys))))

;; for parsing front-to-back
(defmethod make-template ((kind (eql 'regexp^)) (spec cons))
  (destructuring-bind (re-kwd regexp &optional vars &rest keys)
      spec
    (declare (ignore re-kwd))
    (make-instance 'unify::regular-expression-template
                   :spec (list* 'unify::regexp
                                (concatenate 'string "^" regexp "(.*)$")
                                (append vars '(?&rest))
                                keys))))

;; For parsing back-to-front
(defmethod make-template ((kind (eql 'regexp$)) (spec cons))
  (destructuring-bind (re-kwd regexp &optional vars &rest keys)
      spec
    (declare (ignore re-kwd))
    (make-instance 'unify::regular-expression-template
                   :spec (list* 'unify::regexp
				(cond
				  ((stringp regexp)
				   (concatenate 'string "^(.*?)" regexp "$"))
				  ((listp regexp)
				   `(:sequence :start-anchor
					       (:register (:non-greedy-repetition 0 nil :everything))
					       ,@regexp
					       :end-anchor))
				  (t (error "Unknown regexp format.")))
                                (append '(?&rest) vars)
                                keys))))

;; (match (#t(regexp+ "^f(o+)" (?o)) "fooooooobar") (values o &rest))
;;    => "ooooooo", "bar"

;; prevent clisp from crashing when it loads .fas files with our regexp templates in them
(defmethod make-load-form ((object unify::regular-expression-template) &optional env)
  (declare (ignore env))
  `(make-template ',(first (template-spec object)) ',(template-spec object))
  #+(or) ; make-instance should be fine, too
  `(make-instance ',(class-of object) :spec ',(template-spec object)))