From 1d39b7aea67aedc4a1ecc51af1bb1615ae3a4f15 Mon Sep 17 00:00:00 2001 From: fiddlerwoaroof Date: Thu, 21 Apr 2016 02:02:32 -0400 Subject: [PATCH 1/2] Make the restart work correctly. When the restart is active, it can be triggered via the (replace-invalid) function. For this to work, the parser that throws the error cannot be being run directly, but must be called by another parser. When the restart is triggered, it unwinds the parser stack one parser higher than the parser that signaled the condition and then fixes its input and reruns it. --- smug.lisp | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/smug.lisp b/smug.lisp index 7e7356f..2d34547 100644 --- a/smug.lisp +++ b/smug.lisp @@ -48,27 +48,32 @@ ,@body)))) `(progn ,@body))) -(defun replace-subseq (needle haystack replacement) - (let* ((haystack (copy-seq haystack)) - (idx (search needle haystack :test 'equal))) - (when idx - (replace haystack replacement :start1 idx)) - haystack)) - -(defun replace-invalid (old new) +(defun replace-beginning (needle haystack replacement) + (let* ((needle-length (length needle))) + (if (string= haystack needle :end1 needle-length) + (concatenate 'string + replacement + (subseq haystack needle-length)) + haystack))) + +(defun replace-invalid (old new &optional was-equal) (let ((replace-invalid (find-restart 'replace-invalid))) (when replace-invalid - (invoke-restart replace-invalid old new)))) + (invoke-restart replace-invalid old new was-equal)))) (defun run (parser input) + (declare (optimize (debug 3))) + (loop (restart-case - (progn - (funcall parser input)) - (replace-invalid (old new) - (let ((next-replace-invalid (find-restart 'replace-invalid))) - (if (and next-replace-invalid (not (search old input))) - (invoke-restart 'replace-invalid old new) - (funcall parser (replace-subseq old (copy-seq input) new))))))) + (return (funcall parser input)) + + (replace-invalid (old new &optional was-equal) + (let* ((old-length (length old)) + (begins-with (and (<= old-length (length input)) + (string= old input :end2 old-length)))) + (if (and begins-with was-equal) + (setf input (replace-beginning old input new)) + (replace-invalid old new begins-with))))))) (defun parse (parser input) (let ((result (run parser input))) From 792ded795301de1dafa5ca62df9b0c609cb30ad2 Mon Sep 17 00:00:00 2001 From: fiddlerwoaroof Date: Thu, 21 Apr 2016 02:17:53 -0400 Subject: [PATCH 2/2] Removing a stray debug declaration. --- smug.lisp | 1 - 1 file changed, 1 deletion(-) diff --git a/smug.lisp b/smug.lisp index 2d34547..a49ee30 100644 --- a/smug.lisp +++ b/smug.lisp @@ -62,7 +62,6 @@ (invoke-restart replace-invalid old new was-equal)))) (defun run (parser input) - (declare (optimize (debug 3))) (loop (restart-case (return (funcall parser input))