From f753bfdffbd7ce0975b97ad44098b857f25c39a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= Date: Thu, 15 Jan 2026 01:55:29 -0300 Subject: Improve usability --- base.lisp | 31 +++++++++++++++++++------------ core.lisp | 28 +++++++++++++++------------- extra.lisp | 8 ++++---- main.lisp | 15 +++++++++------ package.lisp | 1 + 5 files changed, 48 insertions(+), 35 deletions(-) diff --git a/base.lisp b/base.lisp index fe28cd0..0599a3c 100644 --- a/base.lisp +++ b/base.lisp @@ -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.")))))) diff --git a/core.lisp b/core.lisp index 43dd234..9fef78f 100644 --- a/core.lisp +++ b/core.lisp @@ -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) diff --git a/extra.lisp b/extra.lisp index c0a6a8a..9805ca0 100644 --- a/extra.lisp +++ b/extra.lisp @@ -4,7 +4,7 @@ (or (char= it #\Space) (not (graphic-char-p it)))) -(declaim (ftype (function (parser integer integer) parser) repeat)) +(declaim (ftype (function (parser integer &optional integer) parser) repeat)) (defun repeat (p min &optional (max 0)) (if (> min 0) (comp ((x p) @@ -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)) diff --git a/main.lisp b/main.lisp index 3e6f255..683b70f 100644 --- a/main.lisp +++ b/main.lisp @@ -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 -- cgit v1.2.3