Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 101 lines (92 sloc) 3.93 kB
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
1 (in-package :parser-combinators)
2
7155de1 @Ramarren Move `define-oneshot-result` earlier.
authored
3 (defmacro define-oneshot-result (inp is-unread &body body)
4 `(function (lambda (,inp)
5 (let ((,is-unread t))
6 #'(lambda ()
7 (when ,is-unread
8 (setf ,is-unread nil)
9 ,@body))))))
10
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
11 (declaim (inline sat))
12 (def-cached-arg-parser sat (predicate)
13 "Parser: return a token satisfying a predicate."
14 #'(lambda (inp)
15 (typecase inp
16 (end-context (constantly nil))
17 (context
18 (if (funcall predicate (context-peek inp))
19 (let ((closure-value
20 (make-instance 'parser-possibility
21 :tree (context-peek inp) :suffix (context-next inp))))
22 #'(lambda ()
23 (when closure-value
24 (prog1
25 closure-value
26 (setf closure-value nil)))))
27 (constantly nil))))))
28
29 (def-cached-arg-parser char? (character)
30 "Parser: accept token eql to argument"
31 (sat (curry #'eql character)))
32
ca500ba @intronic case-insensitive matching
intronic authored
33 (def-cached-arg-parser char-equal? (character)
34 "Parser: accept token char-equal to argument"
35 (sat (curry #'char-equal character)))
36
3e09648 @Ramarren Add string?-using-context.
authored
37 (defgeneric string?-using-context (input vector test)
38 (:documentation "Implementation of string? specialized on context type. Returns as multiple
39 values result and new context or nil on failure.")
40 (:method ((input context) vector test)
41 (iter (for c in-vector vector)
42 (for inp-iter initially input then (context-next inp-iter))
43 (when (end-context-p inp-iter)
44 (return nil))
45 (for inp-data = (context-peek inp-iter))
46 (unless (funcall test c inp-data)
47 (return (values nil nil)))
48 (finally (return
49 (values (context-interval input inp-iter)
50 inp-iter)))))
51 (:method ((input vector-context) vector test)
31d36fa @Ramarren Add parameter to gathering functions to allow zero width matches, als…
authored
52 (check-type vector vector)
3e09648 @Ramarren Add string?-using-context.
authored
53 (let ((input-vector (storage-of input))
54 (l (length vector))
55 (p (position-of input)))
31d36fa @Ramarren Add parameter to gathering functions to allow zero width matches, als…
authored
56 (check-type input-vector vector)
3e09648 @Ramarren Add string?-using-context.
authored
57 (if (> (+ l p)
58 (length input-vector))
59 (values nil nil)
60 (let ((mismatch (mismatch input-vector vector
61 :test test
62 :start1 p
63 :end1 (+ p l))))
64 (if mismatch
65 (values nil nil)
66 (values (subseq input-vector p (+ p l))
d93f913 @Ramarren Return end-context when the input vector is done.
authored
67 (if (= (+ p l) (length input-vector))
68 (make-instance 'end-context
69 :common (common-of input)
70 :position (+ p l))
71 (make-instance 'vector-context
72 :common (common-of input)
73 :position (+ p l))))))))))
3e09648 @Ramarren Add string?-using-context.
authored
74
e0d2d8f @Ramarren Make string? parser return the input substring, rather that copy of t…
authored
75 (def-cached-arg-parser string? (sequence &key (test #'eql) (result-type 'string))
7fd3c5f @Ramarren Remove code duplication.
authored
76 "Non-backtracking parser: accept a sequence of elements with equality tested by TEST."
ca500ba @intronic case-insensitive matching
intronic authored
77 (let ((vector (coerce sequence 'vector)))
78 (define-oneshot-result inp is-unread
3e09648 @Ramarren Add string?-using-context.
authored
79 (multiple-value-bind (result new-input)
80 (string?-using-context inp vector test)
81 (when new-input
82 (make-instance 'parser-possibility
83 :tree (coerce result result-type)
84 :suffix new-input))))))
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
85
86 (defun ensure-parser (parser)
87 (typecase parser
88 (function parser)
89 (list (if (cdr parser)
90 (string? parser)
91 (char? (car parser))))
92 (vector (if (length= 1 parser)
bfef16b @Ramarren Fix ensure-parser bug
authored
93 (char? (aref parser 0))
a1c55d9 @Ramarren Make vectors and characters accepted as parsers.
authored
94 (string? parser)))
95 (t (char? parser))))
96
97 (defmacro with-parsers ((&rest parsers) &body body)
98 `(let ,(iter (for p in parsers)
99 (collect `(,p (ensure-parser ,p))))
8a398a7 @Ramarren Add newline-at-end-of-file
authored
100 ,@body))
Something went wrong with that request. Please try again.