diff options
Diffstat (limited to 'base.lisp')
| -rw-r--r-- | base.lisp | 44 |
1 files changed, 36 insertions, 8 deletions
@@ -2,7 +2,8 @@ (defstruct parsing tree - left) + start + end) (defstruct failure place @@ -11,21 +12,48 @@ (defmethod print-object ((obj failure) stream) (if (failure-place obj) - (multiple-value-bind (line column) (line-and-column (failure-place obj)) + (let ((linecol (str:line-and-column (cursed:data (failure-place obj)) + (cursed:index (failure-place obj))))) (format stream "~a:~a: ~a~&~a~&" - line column (failure-message obj) (failure-place obj))) + (car linecol) (cdr linecol) (failure-message obj) (failure-place obj))) (format stream "~a~&" (failure-message obj)))) (defun new (tree) (lambda (input) - (make-parsing :tree tree :left input))) + (make-parsing :tree tree :start input :end input))) + +(defun fail (message &key (priority 1)) + (lambda (input) + (make-failure :place input :message message :priority priority))) (defun bind (parser f) (lambda (input) (let ((r (funcall parser input))) (cond ((parsing-p r) - (funcall (funcall f (parsing-tree r) input) - (parsing-left r))) - ((failure-p r) - r) + (funcall (funcall f r) (parsing-end r))) + ((failure-p r) r) (t (error (format nil "Invalid return value: ~a" r))))))) + +(defmacro comp (bindings &body body) + (if (null bindings) + `(new (progn ,@body)) + (let ((var (first (car bindings))) + (parser (second (car bindings))) + (unused (gensym))) + (cond ((symbolp var) + (if (string= (symbol-name var) "_") + `(bind ,parser + (lambda (&rest ,unused) + (declare (ignore ,unused)) + (comp ,(cdr bindings) ,@body))) + `(bind ,parser + (lambda (,var &rest ,unused) + (let ((,var (parsing-tree ,var))) + (declare (ignore ,unused)) + (comp ,(cdr bindings) ,@body)))))) + ((and (listp var) (= (length var) 1) (symbolp (car var))) + `(bind ,parser + (lambda (,(first var) &rest ,unused) + (declare (ignore ,unused)) + (comp ,(cdr bindings) ,@body)))) + (t (error "Binding must be either a symbol or a list of one symbol.")))))) |