From 33518551e019f4dab7d95c9390c66b6b8b2339f2 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= <jtomas1815@gmail.com>
Date: Wed, 2 Oct 2024 22:06:16 -0300
Subject: Move the project into a new path of breadth first parsing

---
 input.lisp    | 11 +++++++++--
 monparser.asd |  3 +--
 notes.md      | 22 ++++++++++++++++++++++
 package.lisp  | 23 +++--------------------
 parser.lisp   | 55 +++++++++++++++++++++++++++++--------------------------
 5 files changed, 64 insertions(+), 50 deletions(-)
 create mode 100644 notes.md

diff --git a/input.lisp b/input.lisp
index d88d14d..dcea8f6 100644
--- a/input.lisp
+++ b/input.lisp
@@ -1,4 +1,4 @@
-(in-package #:input)
+(in-package #:monparser)
 
 (defclass input ()
   ((cursor :initarg :cursor :accessor cursor :initform 0)
@@ -28,8 +28,15 @@
 (defun from-string (str)
   (make-instance 'input :data str))
 
+(defun read-file (path)
+  (with-open-file (file path)
+    (let* ((size (file-length file))
+           (buf (make-string size)))
+      (read-sequence buf file)
+      buf)))
+
 (defun from-file (filename)
-  (make-instance 'input :file filename :data (str:read-file filename)))
+  (make-instance 'input :file filename :data (read-file filename)))
 
 (defun line-and-column (input)
   (let ((line 1) (column 1))
diff --git a/monparser.asd b/monparser.asd
index 6374e8e..2aa7290 100644
--- a/monparser.asd
+++ b/monparser.asd
@@ -1,6 +1,5 @@
-(asdf:defsystem #:monparser
+(defsystem #:monparser
   :serial t
-  :depends-on (#:utils)
   :components
   ((:file "package")
    (:file "input")
diff --git a/notes.md b/notes.md
new file mode 100644
index 0000000..9eddec5
--- /dev/null
+++ b/notes.md
@@ -0,0 +1,22 @@
+# Problem
+When in a one-of block, it's harder to tell where an error came from.
+
+# Current solution
+We have critical blocks that stop parsing when the parser inside fails.
+
+# Problem with current solution
+We need to be dilligent in placing critical blocks.
+
+# Another approach
+We could take a page from LR parsers and instead of driving the parsing from the parsers themselves we invert the flow, making the input drive the parsing. This results in a breadth first parsing, where the one-of block parses one step of every of it's children and decides which to keep. In the event there's only one children left, it is critical, so a failure stops parsing and reports the error.
+
+# How to select between BF and DF when parsing
+Add an extra argument to parser type (lambda (input)) for the parsing mode.
+one-of will be BF and comp will be DF.
+This means that the immediate children of a one-of block will be parsed step by step.
+
+# Implementing BF in bind
+Instead of calling the resulting function with the input, return it.
+It will be the caller's responsibility to call the resulting lambda with the appropiate input.
+This will give control to the one-of block to call the next parsing step.
+
diff --git a/package.lisp b/package.lisp
index 4cdb68f..deae22c 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,27 +1,10 @@
-(defpackage #:input
+(defpackage #:monparser
   (:use #:cl)
-  (:export #:file
-           #:data
-           #:cursor
-           #:line-and-column
-           #:has-data?
-           #:prefix?
-           #:peek
-           #:advance
-           #:from-string
-           #:from-file))
-
-(defpackage #:parser
-  (:use #:cl)
-  (:export #:run
-           #:parsing-tree
-           #:parsing-left
-           #:failure-place
-           #:failure-message
+  (:export #:parse-file
+           #:parse-string
            #:crit
            #:comp
            #:one-of
-           #:all-of
            #:unit
            #:literal
            #:nothing
diff --git a/parser.lisp b/parser.lisp
index 82f619e..ca13598 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -1,7 +1,13 @@
-(in-package #:parser)
+(in-package #:monparser)
 
-(defun run (p input)
-  (let ((result (funcall p input)))
+(defun parse-string (p input)
+  (let ((result (funcall p (from-string input))))
+    (if (parsing-p result)
+      (parsing-tree result)
+      result)))
+
+(defun parse-file (p input)
+  (let ((result (funcall p (from-file input))))
     (if (parsing-p result)
       (parsing-tree result)
       result)))
@@ -15,19 +21,17 @@
   message)
 
 (defmethod print-object ((obj failure) stream)
-  (let ((file (input:file (failure-place obj))))
+  (let ((file (file (failure-place obj))))
     (if file
-      (multiple-value-bind (line column) (input:line-and-column (failure-place obj))
+      (multiple-value-bind (line column) (line-and-column (failure-place obj))
         (format stream "~a:~a:~a: ~a" line column file (failure-message obj)))
-      (format stream "~a: ~a" (input:cursor (failure-place obj)) (failure-message obj)))))
+      (format stream "~a: ~a" (cursor (failure-place obj)) (failure-message obj)))))
 
 (defun new (tree)
   (lambda (input)
     (make-parsing :tree tree :left input)))
 
 (defun bind-with-input (p f)
-  (declare (optimize (speed 3))
-           (function p f))
   (lambda (input)
     (let ((r (funcall p input)))
       (if (parsing-p r)
@@ -36,8 +40,6 @@
         r))))
 
 (defun bind (p f)
-  (declare (optimize (speed 3))
-           (function p f))
   (lambda (input)
     (let ((r (funcall p input)))
       (if (parsing-p r)
@@ -46,8 +48,6 @@
         r))))
 
 (defun discarding-bind (p f)
-  (declare (optimize (speed 3))
-           (function p f))
   (lambda (input)
     (let ((r (funcall p input)))
       (if (parsing-p r)
@@ -103,19 +103,19 @@
                               (and (symbolp x)
                                    (string-equal (symbol-name x) "IT"))) predicate))))
   `(lambda (input)
-     (if (input:has-data? input)
-       (let ((it (input:peek input)))
+     (if (has-data? input)
+       (let ((it (peek input)))
          (if ,predicate
-           (make-parsing :tree it :left (input:advance input))
+           (make-parsing :tree it :left (advance input))
            (make-failure :place input
                          :message (format nil "Expected: ~a, Got: ~a" ',predicate it))))
        (make-failure :place input :message "Reached end of input."))))
 
 (defun literal (target)
   (lambda (input)
-    (if (input:has-data? input)
-      (if (input:prefix? target input)
-        (make-parsing :tree target :left (input:advance input (length target)))
+    (if (has-data? input)
+      (if (prefix? target input)
+        (make-parsing :tree target :left (advance input (length target)))
         (make-failure :place input :message "Predicate not satisfied."))
       (make-failure :place input :message "Reached end of input."))))
 
@@ -128,22 +128,25 @@
 (defun many (p)
   (comp ((x p)
          (xs (optional (many p))))
-    (cons x xs)))
+        (cons x xs)))
 
 (defun repeat (p min &optional (max 0))
   (if (> min 0)
     (comp ((x p)
            (xs (repeat p (1- min) (1- max))))
-      (cons x xs))
+          (cons x xs))
     (if (> max 0)
       (comp ((x (optional p))
              (xs (repeat p 0 (if x (1- max) 0))))
-        (if x (cons x xs) x))
+            (if x (cons x xs) x))
       nothing)))
 
+(defun whitespace? (x)
+  (some (lambda (y) (char= x y)) '(#\Space #\Newline #\Tab)))
+
 (defparameter whitespace
-  (comp ((_ (optional (many (unit char:whitespace?)))))
-    nil))
+  (comp ((_ (optional (many (unit whitespace?)))))
+        nil))
 
 (defun separated-list (p separator &key include-separator)
   (comp ((v p)
@@ -151,6 +154,6 @@
          (vn (if sep
                (crit (separated-list p separator))
                nothing)))
-    (if include-separator
-      (cons v (cons sep vn))
-      (cons v vn))))
+        (if include-separator
+          (cons v (cons sep vn))
+          (cons v vn))))
-- 
cgit v1.2.3