baa10688fee2bf73aae7a7308e2ed6862cc97991
[lisp/ebnf-parser.git] / parser.lisp
1 ;; A simple top-down, backtracking parser
2 ;; Modelled after EBNF notation
3
4 (defun starts-with (string prefix &key (start 0))
5   "Does 'string' begin with 'prefix'?"
6   (let ((end (+ start (length prefix)))
7         (l (length string)))
8     (if (> end l)
9         nil
10         (string= prefix string :start2 start :end2 end))))
11
12 ;; return a list of the children
13 ;; return the end of the last child
14 (defun kleene* (f string &key (start 0))
15   (multiple-value-bind (flag value end) (funcall f string :start start)
16     (if flag
17         (multiple-value-bind (f v e) (kleene* f string :start end)
18           (values f (cons value v) e))
19         (values t nil start))))
20
21 (defun kleene+ (f string &key (start 0))
22   "<rule>+ == <rule> <rule>*"
23   (multiple-value-bind (flag value end) (funcall f string :start start)
24     (if flag
25         (multiple-value-bind (f v e) (kleene* f string :start end)
26           (values f (cons value v) e))
27         nil)))
28
29 ;; Construction macros
30 (defmacro grammar-string (str)
31   `(if (starts-with string ,str :start start)
32     (values t ,str (+ start ,(length str)))))
33
34 (defmacro grammar-and (first &rest rest)
35   (if (null rest)
36       first
37       `(multiple-value-bind (flag value end) ,first
38         (if flag
39             (multiple-value-bind (f v e) (grammar-and ))))))
40
41
42 (defmacro grammar-or (first &rest rest)
43   (if (null rest)
44       first
45       `(multiple-value-bind (flag value end) ,first
46         (if flag
47             (values flag value end)
48             (grammar-or ,@rest)))))
49
50
51 (defun parse-test (string &key (start 0))
52   "token := 'a' | 'b'"
53 ;  (grammar-string "a"))
54   (grammar-or
55    (grammar-string "a")
56    (grammar-string "b")))
57
58
59 ;; Simple grammar
60 ; token := "a" | "b"
61 ; list := "(" token+ ")"
62
63 (defun parse-token (string &key (start 0))
64   "token := 'a' | 'b'"
65   (grammar-or
66    (grammar-string "a")
67    (grammar-string "b")))
68
69 ; First writing
70 (defun parse-list (string &key (start 0))
71   "list := '(' token* ')'"
72   (if (starts-with string "(" :start start)
73       (multiple-value-bind (flag value end) (kleene* 'parse-token string :start (+ start (length "(")))
74         (if flag
75             (when (starts-with string ")" :start end)
76               (values t (list "(" value ")") (+ end (length ")"))))))))
77
78 ; Refactored
79 (defun parse-list (string &key (start 0))
80   "list := '(' token* ')'"
81   (multiple-value-bind (f0 v0 e0) (grammar-string "(")
82     (if f0
83       (multiple-value-bind (flag value end) (kleene* 'parse-token string :start (+ start (length "(")))
84         (if flag
85             (when (starts-with string ")" :start end)
86               (values t (list "(" value ")") (+ end (length ")")))))))))
87
88
89
90 ;;;; Special conditions
91
92 ;; Flag whether to ignore whitespace between tokens
93 (defparameter *grammar-no-white* nil)
94
95 ;; List of restricted keywords
96 (defparameter *grammar-keywords* (make-hash-table :test #'equal))