blob: a9e9246115717b3e890b14a931b784ce4420940f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
|
(in-package #:monparser)
(defparameter nothing
(new nil))
(defmacro unit (&optional predicate)
(cond ((null predicate)
(setf predicate 't))
((symbolp predicate)
(setf predicate `(,predicate it)))
((characterp predicate)
(setf predicate `(char-equal ,predicate it)))
((listp predicate)
(if (eq (car predicate) 'function)
(setf predicate `(funcall ,predicate it))
(setf predicate
(symbol:normalize 'it predicate))))
(t (error (format nil "Invalid predicate: ~a." predicate))))
`(lambda (input)
(if (cursed:has-data? input)
(let ((it (cursed:peek input)))
(if ,predicate
(make-parsing :tree it
:start input
:end (cursed:advance input))
(make-failure :place input
:message (format nil "Expected: ~a, Got: ~:c." ',predicate it))))
(make-failure :place input
:message (format nil "Reached end of input. Expected: ~a." ',predicate)))))
(defun one-of (first-parser second-parser &rest other-parsers)
(lambda (input)
(let ((parsers (cons first-parser (cons second-parser other-parsers)))
(result (make-failure :place input)))
(dolist (p parsers)
(let ((r (funcall p input)))
(cond ((parsing-p r)
(when (or (not (parsing-p result))
(> (cursed:distance (parsing-end result)
(parsing-end r))
0))
(setf result r)))
((failure-p r)
(when (failure-p result)
(let ((priority-cmp (- (failure-priority r)
(failure-priority result))))
(when (or (> priority-cmp 0)
(and (= priority-cmp 0)
(>= (cursed:distance (failure-place result)
(failure-place r))
0)))
(setf result r)))))
(t (error (format nil "Invalid return value: ~a." r))))))
result)))
(defun optional (p)
(one-of p nothing))
(defun many (p &key all)
(lambda (input)
(let* ((result '())
(input-left input)
(last-failure
(do ((r (funcall p input-left) (funcall p input-left))) ((failure-p r) r)
(when (parsing-p r)
(setf input-left (parsing-end r))
(when (parsing-tree r)
(push (parsing-tree r) result))))))
(if (or (not result)
(and result all (cursed:has-data? (failure-place last-failure))))
(make-failure :place (failure-place last-failure)
:message (failure-message last-failure))
(make-parsing :tree (reverse result)
:start input
:end input-left)))))
|
