diff options
| -rw-r--r-- | input.lisp | 3 | ||||
| -rw-r--r-- | package.lisp | 3 | ||||
| -rw-r--r-- | parser.lisp | 58 |
3 files changed, 42 insertions, 22 deletions
@@ -25,6 +25,9 @@ :file (file input) :cursor (+ (cursor input) amount))) +(defun input-sub (input1 input2) + (- (cursor input1) (cursor input2))) + (defun from-string (str) (make-instance 'input :data str)) diff --git a/package.lisp b/package.lisp index d742fbb..c352bd4 100644 --- a/package.lisp +++ b/package.lisp @@ -10,4 +10,5 @@ #:many #:repeat #:whitespace - #:separated-list)) + #:separated-list + #:surrounded)) diff --git a/parser.lisp b/parser.lisp index 32d9d50..9d4be57 100644 --- a/parser.lisp +++ b/parser.lisp @@ -14,7 +14,8 @@ (defstruct parsing tree - left) + left + limit) (defstruct failure place @@ -32,7 +33,6 @@ (declare (ignore lazy limit)) (make-parsing :tree tree :left input))) -; (parser<a> (a -> parser<b>) -> b) (defun bind (p f &key (greedy t)) (lambda (input &key limit lazy) (let (r) @@ -40,9 +40,10 @@ (setf r (funcall p input)) (let ((next-parser (funcall f nil input)) (limit -1)) - (do ((sweep-input input (advance sweep-input))) (limit nil) - (when (and (has-data? sweep-input) - (functionp (funcall next-parser sweep-input t))) + (do ((sweep-input input (advance sweep-input))) + ((or (not (has-data? sweep-input)) + (> limit -1)) nil) + (when (functionp (funcall next-parser sweep-input :lazy t)) (setf limit (input-sub sweep-input input)))) (if (< limit 0) (setf r (make-failure :place input @@ -55,30 +56,37 @@ (funcall (funcall f (parsing-tree r) input) (parsing-left r) :lazy lazy - :limit (if limit (1- limit)))) + :limit (parsing-limit r))) (funcall (funcall f (parsing-tree r) input) (parsing-left r) - :limit (if limit (1- limit)))) + :limit (parsing-limit r))) r)))) (defmacro comp (bindings &body body) (if (null bindings) `(new (progn ,@body)) - (let ((v (first (car bindings))) - (p (second (car bindings))) + (let ((var (first (car bindings))) + (parser (second (car bindings))) + (lazy (third (car bindings))) (unused (gensym))) - (if (symbolp v) - (if (string= (symbol-name v) "_") - `(bind ,p (lambda (&rest ,unused) - (declare (ignore ,unused)) - (comp ,(cdr bindings) ,@body))) - `(bind ,p (lambda (,v &rest ,unused) - (declare (ignore ,unused)) - (comp ,(cdr bindings) ,@body)))) - (if (and (consp v) (symbolp (car v)) (symbolp (cdr v))) - `(bind ,p (lambda (,(car v) ,(cdr v) &rest ,unused) - (declare (ignore ,unused)) - (comp ,(cdr bindings) ,@body))) + (if (symbolp var) + (if (string= (symbol-name var) "_") + `(bind ,parser + (lambda (&rest ,unused) + (declare (ignore ,unused)) + (comp ,(cdr bindings) ,@body)) + :greedy ,(not lazy)) + `(bind ,parser + (lambda (,var &rest ,unused) + (declare (ignore ,unused)) + (comp ,(cdr bindings) ,@body)) + :greedy ,(not lazy))) + (if (and (consp var) (symbolp (car var)) (symbolp (cdr var))) + `(bind ,parser + (lambda (,(car var) ,(cdr var) &rest ,unused) + (declare (ignore ,unused)) + (comp ,(cdr bindings) ,@body)) + :greedy ,(not lazy)) (error "Binding must be either a symbol or a cons of symbols.")))))) (defun one-of (first-parser second-parser &rest other-parsers) @@ -174,3 +182,11 @@ (if include-separator (cons v (cons sep vn)) (cons v vn)))) + +(defun surrounded (left p right &key include-surrounding) + (comp ((l left) + (body p :lazy) + (r right)) + (if include-surrounding + (list l body r) + body))) |