Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 123 lines (95 sloc) 4.401 kb
aabfc88 @VincentToups multi-method update, utils added.
VincentToups authored
1 (require 'utils)
2 (require 'monad-parse)
3 (require 'functional)
4 (provide 'simplified-lambda-list-parser)
5
6 (defun not-lambda-list-sentinal (symbol)
7 "Returns true for anything that isn't in '(&rest &optional &key)."
8 (and (not (eq '&rest symbol))
9 (not (eq '&key symbol))
10 (not (eq '&optional symbol))))
11 (defun lambda-list-sentinal (symbol)
12 "Returns true for anything that is in '(&rest &optional &key)."
13 (or (eq '&rest symbol)
14 (eq '&optional symbol)
15 (eq '&key symbol)))
16 (defun lambda-list-tail-sentinal (symbol)
17 "Returns true for either '&rest or '&key, which are mutually exclusive in a lambda list."
18 (or (eq '&rest symbol)
19 (eq '&key symbol)))
20
21
22 (defun =not-lambda-list-sentinal ()
23 "Return a parser which parses a single item which is not a lambda list sentinal."
24 (=satisfies #'not-lambda-list-sentinal))
25 (defun =lambda-list-tail-sentinal ()
26 "Return a parser which parses a single item which is a lambda list sentinal."
27 (=satisfies #'lambda-list-tail-sentinal))
28
29 (defun =regular-args ()
30 "Return a parser which gets the regular argument symbols of a lambda list,
31 that is, the symbols up to the first lambda list sentinal."
32 (=let* [_ (zero-or-more (=not-lambda-list-sentinal))]
33 _))
34
35 (defun symbol-or-proper-pair (o)
36 "Returns true for either a naked symbol, a list of only one symbol, or a list
37 with two elements, a symbol and a form, which is an arbitrary lisp expression."
38 (or (not-lambda-list-sentinal o)
39 (and (listp o)
40 (symbolp (car o))
41 (<= (length o) 2))))
42
43 (defun =maybe-optional-arg ()
44 "Returns a parser which parses a single argument representing a symbol and its
45 default value, or a symbol. That is, x, (x) or (x 10), as examples."
46 (=satisfies #'symbol-or-proper-pair))
47
48 (defun =optional-args ()
49 "Returns a parser which parses optional arguments from a lambda list. The
50 parses returns a list of these args."
51 (=let* [sentinal (=satisfies (par #'eq '&optional))
52 args (zero-or-more (=maybe-optional-arg))]
53 args))
54
55 (defun =key-args ()
56 "Returns a parser which parses the arguments of the &key part of a lambda list,
57 and returns the list of argument forms."
58 (=let* [sentinal (=satisfies (par #'eq '&key))
59 args (zero-or-more (=maybe-optional-arg))]
60 args))
61
62 (defun =rest-arg ()
63 "Returns a parser which parses the arguments of the &rest part of a lambda list,
64 and returns the symbol which will contain the tail of the passed in args."
65 (=let* [sentinal (=satisfies (par #'eq '&rest))
66 arg (=not-lambda-list-sentinal)]
67 (if arg arg (error "Lambda list parser error - &rest needs a symbol to bind the rest to."))))
68
69 (defun =lambda-list-tail ()
70 "Returns a parser which parses the tail of a lambda list, either an &key for, or an &rest form,
71 but not both. The context using this parser should check to see that this form exhausts the lambda list,
72 because not doing so indicates an error."
73 (=let* [sentinal (=satisfies #'lambda-list-tail-sentinal)
74 part/s
75 (cond ((eq sentinal '&rest)
76 (=satisfies #'not-lambda-list-sentinal))
77 ((eq sentinal '&key)
78 (zero-or-more (=maybe-optional-arg))))]
79 (list (case sentinal
80 (&rest :rest)
81 ('&key :key))
82 part/s)))
83
84 (defun =lambda-list ()
85 "Returns a parser which parses a lambda list into an alist with :normal,
86 :optional, :key or :rest entries, containing the appropriate forms."
87 (=let* [normals (zero-or-more (=regular-args))
88 optionals (=maybe (=optional-args))
89 tail (=maybe (=lambda-list-tail))]
90 (let ((table (alist>> :optional optionals :normal normals)))
91 (if tail
92 (cons tail table)
93 table))))
94
95 (defun simple-parse-lambda-list (lambda-list)
96 "Parse the lambda list in LAMBDA-LIST and return a table of the lambda list information where
97 :normal holds the normal argument symbols
98 :optional holds the optional arguments, as either symbol or symbol/form pairs
99 :rest holds the symbol to bind the tail of the arguments to
100 and :key holds the key symbols or symbol/val pairs.
101
102 Pairs are proper lists, rather than PAIRS in the strict sense. Throws errors if the lambda
103 list is not parsable."
104 (let* ((result-and-state (funcall (=lambda-list) (->in lambda-list)))
105 (result (car (car result-and-state)))
106 (remainder (input-as-list (cdr (car result-and-state)))))
107 (if remainder (error "Can't figure out how to parse the lambda-list tail %S" remainder)
108 result)))
109
110
111
112
113
114
115
116
117
118
119
120
121
122
Something went wrong with that request. Please try again.