Update of /project/cl-unification/cvsroot/cl-unification/lib-dependent In directory cl-net:/tmp/cvs-serv30009/lib-dependent Added Files: cl-ppcre-template.lisp Log Message: Modified Files: test/unification-tests.lisp Added Files: lib-dependent/cl-ppcre-template.lisp The cl-ppcre-template reuses E. Weitz's wonderful CL-PPCRE library to provide a seamless (YMMV) reuse of regular expressions within CL-UNIFICATION. --- /project/cl-unification/cvsroot/cl-unification/lib-dependent/cl-ppcre-template.lisp 2009/04/15 10:24:28 NONE +++ /project/cl-unification/cvsroot/cl-unification/lib-dependent/cl-ppcre-template.lisp 2009/04/15 10:24:28 1.1 ;;;; -*- Mode: Lisp -*- ;;;; cl-ppcre-template.lisp -- ;;;; REGEXP template dependent on CL-PPCRE. (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow. (require "CL-PPCRE") ;;;; REGEXP Templates. ;;;; Another extension of the type specifier language. ;;;; A template can also be ;;;; ;;;; <template> ::= #| templates from template-hierarchy.lisp |# ;;;; | <regexp template> ;;;; ;;;; Hairier REGEXP template spec syntax: ;;;; ;;;; (regexp|regular-expression) <REGEXP> &optional <unification vars> &rest <keys> ;;;; ;;;; where ;;;; ;;;; <REGEXP> ::= <a CL-PPCRE regexp string or tree> ;;;; <unification vars> ::= '(' <variable>* ')' ;;;; <keys> ::= <CL-PPCRE (constant) keys to be passed to CL-PPCRE:CREATE-SCANNER> (defclass regular-expression-template (string-template) ((scanner :reader scanner) (regexp :reader regular-expression) (vars :reader variables :reader registers :type list) ) (:documentation "The Regular Expression Template. A template for matching strings using regular expressions. The actual matching is done thankes to the CL-PPCRE library.") ) (defgeneric regular-expression-template-p (x) (:method ((x regular-expression-template)) t) (:method ((x t)) nil)) (defmethod make-template ((kind (eql 'regexp)) (spec cons)) (make-instance 'regular-expression-template :spec spec)) (defmethod make-template ((kind (eql 'regular-expression)) (spec cons)) (make-template 'regexp spec)) (defmethod initialize-instance :after ((re-t regular-expression-template) &key) (destructuring-bind (re-kwd regexp &optional vars &rest keys) (template-spec re-t) (declare (ignore re-kwd)) (multiple-value-bind (scanner reg-names) (let ((cl-ppcre:*allow-named-registers* t)) (apply #'cl-ppcre:create-scanner regexp keys)) (declare (ignorable reg-names)) (setf (slot-value re-t 'scanner) scanner (slot-value re-t 'regexp) regexp (slot-value re-t 'vars) vars ; Maybe will merge with REG-NAMES... ) ))) #| (defmethod initialize-instance :after ((re-t regular-expression-template) &key) ;; FIX: handling of CL-PPCRE:CREATE-SCANNER keywords. This can be ;; done by using the "harier" syntax of SPEC (see above). (destructuring-bind (re-kwd regexp &optional vars &rest keys) (template-spec re-t) (declare (ignore re-kwd) (ignorable regexp vars keys)) (multiple-value-bind (scanner reg-names) (let ((cl-ppcre:*allow-named-registers* t)) (cl-ppcre:create-scanner (second (template-spec re-t)))) (declare (ignorable reg-names)) (setf (slot-value re-t 'scanner) scanner (slot-value re-t 'regexp) (second (template-spec re-t)) ; For the time being just stored and ; used for debugging. ) ))) |# ;;;;--------------------------------------------------------------------------- ;;;; Implementation. ;;; Unification. (defmethod unify ((ret1 regular-expression-template) (ret2 regular-expression-template) &optional (env (make-empty-environment)) &key &allow-other-keys) (if (eq ret1 ret2) env ;; I could UNIFY the result of the CL-PPCRE:PARSE-STRINGs. (error 'unification-failure :format-control "Do not know how unify the two ~ regular-expression templates: ~S and ~S." :format-arguments (list ret1 ret2)))) (defmethod unify ((re-t regular-expression-template) (s string) &optional (env (make-empty-environment)) &key (start 0) end &allow-other-keys) (declare (type (integer 0 #.most-positive-fixnum) start) (type (or null (integer 0 #.most-positive-fixnum)) end)) (let ((end (or end (length s)))) (declare (type (integer 0 #.most-positive-fixnum) end)) (multiple-value-bind (m-start m-end r-starts r-ends) (cl-ppcre:scan (scanner re-t) s :start start :end end) ;; Maybe SCAN-TO-STRINGS would be simpler to use... (declare (type (integer 0 #.most-positive-fixnum) m-start m-end) (type (vector (integer 0 #.most-positive-fixnum)) r-starts r-ends)) (unless (and (= start m-start) (= m-end end)) (error 'unification-failure :format-control "String ~S cannot be matched against ~ regular expression ~S." :format-arguments (list s (regular-expression re-t)))) (let ((vars (variables re-t))) (if (null vars) env (loop for r-start across r-starts for r-end across r-ends for r-string of-type string = (subseq s r-start r-end) for v in vars for result-env = (var-unify v r-string env) then (var-unify v r-string result-env) finally (return result-env)))) ))) (defmethod unify ((s string) (re-t regular-expression-template) &optional (env (make-empty-environment)) &key (start 0) end &allow-other-keys) (unify re-t s env :start start :end end)) ;;;; end of file -- cl-ppcre-template.lisp --