repos
/
cl-unification
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Delete trailing whitespace. In lambda-list-parsing.lisp this fixes a bug
Annotate for file lib-dependent/cl-ppcre-template.lisp
2004-11-17 mantoniotti
1
;;;; -*- Mode: Lisp -*-
22:19:54 '
2
'
3
;;;; cl-ppcre-template.lisp --
'
4
;;;; REGEXP template dependent on CL-PPCRE.
'
5
'
6
(in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow.
'
7
'
8
'
9
;;;; REGEXP Templates.
'
10
;;;; Another extension of the type specifier language.
'
11
'
12
;;;; A template can also be
'
13
;;;;
'
14
;;;; <template> ::= #| templates from template-hierarchy.lisp |#
'
15
;;;; | <regexp template>
'
16
;;;;
'
17
;;;; Hairier REGEXP template spec syntax:
'
18
;;;;
'
19
;;;; (regexp|regular-expression) <REGEXP> &optional <unification vars> &rest <keys>
'
20
;;;;
'
21
;;;; where
'
22
;;;;
'
23
;;;; <REGEXP> ::= <a CL-PPCRE regexp string or tree>
'
24
;;;; <unification vars> ::= '(' <variable>* ')'
'
25
;;;; <keys> ::= <CL-PPCRE (constant) keys to be passed to CL-PPCRE:CREATE-SCANNER>
'
26
'
27
(defclass regular-expression-template (string-template)
'
28
((scanner :reader scanner)
'
29
(regexp :reader regular-expression)
'
30
(vars :reader variables
'
31
:reader registers
'
32
:type list)
'
33
)
'
34
(:documentation "The Regular Expression Template.
'
35
'
36
A template for matching strings using regular expressions.
'
37
The actual matching is done thankes to the CL-PPCRE library.")
'
38
)
'
39
'
40
'
41
'
42
(defgeneric regular-expression-template-p (x)
'
43
(:method ((x regular-expression-template)) t)
'
44
(:method ((x t)) nil))
'
45
'
46
'
47
(defmethod make-template ((kind (eql 'regexp)) (spec cons))
'
48
(make-instance 'regular-expression-template :spec spec))
'
49
'
50
(defmethod make-template ((kind (eql 'regular-expression)) (spec cons))
'
51
(make-template 'regexp spec))
'
52
'
53
'
54
(defmethod initialize-instance :after ((re-t regular-expression-template) &key)
'
55
(destructuring-bind (re-kwd regexp &optional vars &rest keys)
'
56
(template-spec re-t)
'
57
(declare (ignore re-kwd))
'
58
(multiple-value-bind (scanner reg-names)
'
59
(let ((cl-ppcre:*allow-named-registers* t))
'
60
(apply #'cl-ppcre:create-scanner regexp keys))
'
61
(declare (ignorable reg-names))
'
62
(setf (slot-value re-t 'scanner)
'
63
scanner
'
64
'
65
(slot-value re-t 'regexp)
'
66
regexp
'
67
'
68
(slot-value re-t 'vars)
'
69
vars ; Maybe will merge with REG-NAMES...
'
70
)
'
71
)))
'
72
'
73
#|
'
74
(defmethod initialize-instance :after ((re-t regular-expression-template) &key)
'
75
;; FIX: handling of CL-PPCRE:CREATE-SCANNER keywords. This can be
'
76
;; done by using the "harier" syntax of SPEC (see above).
'
77
(destructuring-bind (re-kwd regexp &optional vars &rest keys)
'
78
(template-spec re-t)
'
79
(declare (ignore re-kwd)
'
80
(ignorable regexp vars keys))
'
81
(multiple-value-bind (scanner reg-names)
'
82
(let ((cl-ppcre:*allow-named-registers* t))
'
83
(cl-ppcre:create-scanner (second (template-spec re-t))))
'
84
(declare (ignorable reg-names))
'
85
(setf (slot-value re-t 'scanner)
'
86
scanner
'
87
'
88
(slot-value re-t 'regexp)
'
89
(second (template-spec re-t)) ; For the time being just stored and
'
90
; used for debugging.
'
91
)
'
92
)))
'
93
|#
'
94
'
95
;;;;---------------------------------------------------------------------------
'
96
;;;; Implementation.
'
97
'
98
;;; Unification.
'
99
'
100
(defmethod unify ((ret1 regular-expression-template)
'
101
(ret2 regular-expression-template)
'
102
&optional (env (make-empty-environment))
'
103
&key &allow-other-keys)
'
104
(if (eq ret1 ret2)
'
105
env
'
106
;; I could UNIFY the result of the CL-PPCRE:PARSE-STRINGs.
'
107
(error 'unification-failure
'
108
:format-control "Do not know how unify the two ~
'
109
regular-expression templates: ~S and ~S."
'
110
:format-arguments (list ret1 ret2))))
'
111
'
112
'
113
(defmethod unify ((re-t regular-expression-template) (s string)
'
114
&optional (env (make-empty-environment))
'
115
&key
'
116
(start 0)
'
117
end
'
118
&allow-other-keys)
'
119
(declare (type (integer 0 #.most-positive-fixnum) start)
'
120
(type (or null (integer 0 #.most-positive-fixnum)) end))
'
121
(let ((end (or end (length s))))
'
122
(declare (type (integer 0 #.most-positive-fixnum) end))
'
123
2009-12-17 mantoniotti
124
(multiple-value-bind (matched-p strings)
16:57:45 '
125
(cl-ppcre:scan-to-strings (scanner re-t) s :start start :end end)
'
126
(unless matched-p
2004-11-17 mantoniotti
127
(error 'unification-failure
22:19:54 '
128
:format-control "String ~S cannot be matched against ~
'
129
regular expression ~S."
'
130
:format-arguments (list s
'
131
(regular-expression re-t))))
'
132
(let ((vars (variables re-t)))
'
133
(if (null vars)
'
134
env
2009-12-17 mantoniotti
135
(loop for r-string of-type string across strings
2004-11-17 mantoniotti
136
for v in vars
22:19:54 '
137
for result-env = (var-unify v r-string env)
'
138
then (var-unify v r-string result-env)
'
139
finally (return result-env))))
'
140
)))
'
141
'
142
'
143
(defmethod unify ((s string) (re-t regular-expression-template)
'
144
&optional (env (make-empty-environment))
'
145
&key (start 0) end &allow-other-keys)
'
146
(unify re-t s env :start start :end end))
2011-04-02 rbrown
147
2004-11-17 mantoniotti
148
22:19:54 '
149
;;;; end of file -- cl-ppcre-template.lisp --