diff options
| -rw-r--r-- | base.lisp | 31 | ||||
| -rw-r--r-- | core.lisp | 28 | ||||
| -rw-r--r-- | extra.lisp | 6 | ||||
| -rw-r--r-- | main.lisp | 15 | ||||
| -rw-r--r-- | package.lisp | 1 |
5 files changed, 47 insertions, 34 deletions
@@ -15,6 +15,13 @@ (deftype parser () `(function (cursor cursor) result)) +(defmacro lazy (parser &rest args) + (let ((start (gensym)) + (input (gensym))) + `(the parser + (lambda (,start ,input) + (funcall (,parser ,@args) ,start ,input))))) + (defun line-and-column (str index) (let ((line 1) (column 1)) (dotimes (i index) @@ -56,22 +63,22 @@ (if (null bindings) `(new (progn ,@body)) (let ((var (first (car bindings))) - (parser (second (car bindings))) - (unused (gensym))) + (parser (second (car bindings)))) (cond ((symbolp var) (if (string= (symbol-name var) "_") `(bind ,parser - (lambda (&rest ,unused) - (declare (ignore ,unused)) - (comp ,(cdr bindings) ,@body))) + (the (function (result) parser) + (lambda (,var) + (declare (ignore ,var)) + (comp ,(cdr bindings) ,@body)))) `(bind ,parser - (lambda (,var &rest ,unused) - (let ((,var (parsing-tree ,var))) - (declare (ignore ,unused)) - (comp ,(cdr bindings) ,@body)))))) + (the (function (result) parser) + (lambda (,var) + (let ((,var (parsing-tree ,var))) + (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)))) + (the (function (result) parser) + (lambda (,(first var)) + (comp ,(cdr bindings) ,@body))))) (t (error "Binding must be either a symbol or a list of one symbol.")))))) @@ -25,19 +25,21 @@ (setf predicate (normalize 'it predicate)))) (t (error (format nil "Invalid predicate: ~a." predicate)))) - `(the parser - (lambda (start input) - (declare (ignore start)) - (if (has-data? input) - (let ((it (peek input))) - (if ,predicate - (make-parsing :tree it - :start input - :end (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)))))) + (let ((start (gensym)) + (input (gensym))) + `(the parser + (lambda (,start ,input) + (declare (ignore ,start)) + (if (has-data? ,input) + (let ((it (peek ,input))) + (if ,predicate + (make-parsing :tree it + :start ,input + :end (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))))))) (declaim (ftype (function (parser parser &rest parser) parser) one-of)) (defun one-of (first-parser second-parser &rest other-parsers) @@ -29,11 +29,11 @@ `(comp ,(reverse binding-list) ,(cons 'list (reverse name-list))))) -(declaim (ftype (function (parser parser parser) parser) within)) -(defun within (left p right) +(declaim (ftype (function (parser parser &optional parser) parser) within)) +(defun within (left p &optional right) (comp ((_ left) (cell p) - (_ right)) + (_ (or right left))) cell)) (declaim (ftype (function (parser parser) parser) interlinked)) @@ -18,9 +18,12 @@ (defmacro defparser (name args parser) (let ((message (format nil "In ~a:~&" name))) - (cond ((equal args :const) - `(defparameter ,name (append-on-failure ,parser ,message))) - ((listp args) - `(defun ,name ,args (append-on-failure ,parser ,message))) - (t (error - (format nil "Cannot define ~a: ~a is not :const or a list." name args)))))) + (if (and (listp args) (every #'symbolp args)) + (let (definition) + (when (= (length args) 0) + (push `(defparameter ,name (,name)) definition)) + (push `(defun ,name (,@args) (append-on-failure ,parser ,message)) + definition) + (push 'progn definition) + definition) + (error "Malformed argument list.")))) diff --git a/package.lisp b/package.lisp index acdefef..80036ab 100644 --- a/package.lisp +++ b/package.lisp @@ -2,6 +2,7 @@ (:use #:cl) (:export #:parse #:defparser + #:lazy #:parsing #:parsing-p #:parsing-tree |