From 9566e92321a1ed29a7f5903a3ba4ab16de3783b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= Date: Wed, 31 Dec 2025 16:14:31 -0300 Subject: Type check functions --- base.lisp | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) (limited to 'base.lisp') diff --git a/base.lisp b/base.lisp index e8aac7d..fe28cd0 100644 --- a/base.lisp +++ b/base.lisp @@ -1,14 +1,19 @@ (in-package #:monparser) -(defstruct parsing +(defstruct result) + +(defstruct (parsing (:include result)) tree - start - end) + (start (make-instance 'cursor) :type cursor) + (end (make-instance 'cursor) :type cursor)) + +(defstruct (failure (:include result)) + (place (make-instance 'cursor) :type cursor) + (message "" :type string) + (priority 0 :type integer)) -(defstruct failure - place - (message "") - (priority 0)) +(deftype parser () + `(function (cursor cursor) result)) (defun line-and-column (str index) (let ((line 1) (column 1)) @@ -22,22 +27,23 @@ (cons line column))) (defmethod print-object ((obj failure) stream) - (if (failure-place obj) - (let ((linecol (line-and-column (data (failure-place obj)) - (index (failure-place obj))))) - (format stream "~a:~a: ~a~&~a~&" - (car linecol) (cdr linecol) (failure-message obj) (failure-place obj))) - (format stream "~a~&" (failure-message obj)))) + (let ((linecol (line-and-column (data (failure-place obj)) + (index (failure-place obj))))) + (format stream "~a:~a: ~a~&~a~&" + (car linecol) (cdr linecol) (failure-message obj) (failure-place obj)))) +(declaim (ftype (function (t &key (:priority integer)) parser) fail)) (defun fail (message &key (priority 1)) (lambda (start input) (declare (ignore start)) (make-failure :place input :message message :priority priority))) +(declaim (ftype (function (t) parser) new)) (defun new (tree) (lambda (start input) (make-parsing :tree tree :start start :end input))) +(declaim (ftype (function (parser (function (result) parser)) parser) bind)) (defun bind (parser f) (lambda (start input) (let ((r (funcall parser input input))) -- cgit v1.2.3