Package handling improved.
authorUtz-Uwe Haus <lisp@uuhaus.de>
Thu, 2 Oct 2008 08:46:33 +0000 (2 10:46 +0200)
committerUtz-Uwe Haus <lisp@uuhaus.de>
Thu, 2 Oct 2008 08:46:33 +0000 (2 10:46 +0200)
Fix generate-parser-package (still needs more factoring out of
common parts with generate-parser-file)
Use :dst-package keyword everywhere.
Add dst-package argument to generated parse-* functions, because
they need to be told where to put generated symbols at call time.

Signed-off-by: Utz-Uwe Haus <lisp@uuhaus.de>
package.lisp
pegparser-boot.lisp
pegutils.lisp

index 38a91d2..243fc25 100644 (file)
@@ -40,7 +40,8 @@
   ;; low-level user interface
   (:export #:generate-parser-file #:generate-parser-package
           #:get-string-parser #:get-file-parser #:get-stream-parser
-          #:parse-file #:parse-string #:parse-stream)
+          #:parse-file #:parse-string #:parse-stream
+          #:read-stream #:read-file)
   ;; high-level user interface
   (:export #:make-string-parser
           #:make-file-parser
index f24368c..8f6b602 100644 (file)
@@ -2,9 +2,9 @@
 (in-package :opossum-system)
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (declaim (optimize (speed 0) (safety 3) (debug 3))))
-(defun parse-file (f)
+(defun parse-file (f dst-package)
   (let ((opossum:*context* (make-instance 'opossum:context :start-index 0
-                                         :destpkg *package*
+                                         :dst-package dst-package
                                          :input (opossum::read-file f))))
     (funcall (|parse_program|) 0)))
 
index b5e928e..7a52b7a 100644 (file)
    (input       :accessor input       :initarg :input       :initform nil
                :type 'string
                :documentation "The input string being parsed.")
-   (destpkg     :accessor destpkg     :initarg :destpkg     :initform nil
+   (dst-package :accessor dst-package :initarg :dst-package :initform nil
                :type 'package
                :documentation "The package into which symbols generated during the parse are interned.")
    ;; these slots are shared by all cloned copies of a context -- use only STORE-ACTION to guarantee consistency
-   (actions     :accessor actions     :initarg :actions     :initform '(NIL)
+   (actions     :accessor actions     :initarg :actions     :initform (make-list 1 :initial-element NIL)
                :type 'list
                :documentation "The list of actions accumulated during the parse.")
    (action-counter :accessor action-counter :initarg :action-counter :initform '(0)
@@ -77,7 +77,7 @@
   "Create clone context of CTX for rule RULE."
   (make-instance 'context
                 :input (input ctx)
-                :destpkg (destpkg ctx)
+                :dst-package (dst-package ctx)
                 :actions (actions ctx)
                 :action-counter (action-counter ctx)
                 :parent ctx
                            :start-index (start-index *context*)
                            :end-index (end-index *context*)
                            ;; probably some of these copies can be saved
-                           :destpkg (destpkg *context*)
+                           :dst-package (dst-package *context*)
                            :actions (actions *context*)
                            :action-counter (action-counter *context*))))
     ;    (break "generated failure context ~A" ctx )
 ;;
 (defun make-name (string)
   (intern (concatenate 'string "parse-" string)
-         (destpkg *context*)))
+         (dst-package *context*)))
 
 (defun make-action-name (&key ctx)
   "Return a symbol suitable to name the next action."
                           (end-index ctx))
                   (format nil "opossum-action-~D-~D~D"
                           (car (action-counter *context*)))) ))
-    (intern aname (destpkg *context*))))
+    (intern aname (dst-package *context*))))
 
 (defun char-list-to-string (char-list)
   (coerce char-list 'string))
@@ -373,35 +373,6 @@ returns the result of that function, or a failure context if none succeeded."
   (make-package (gensym "opossum-parser")
                :documentation (format T "Opossum parser for grammar ~A" grammarfile)))
 
-(defun generate-parser-package (grammarfile &key (dst-package (make-package (gensym "opossum-parser-")))
-                               start-rule (parse-file-fun #'opossum:parse-file))
-  "Create functions to parse using GRAMMARFILE in DST-PACKAGE, starting ar rule named HEAD.
-DST-PACKAGE will contain the 3 functions PARSE-STRING, PARSE-FILE and PARSE-STREAM as exported entrypoints."
-  (error "This is broken and needs to be merged with g-p-f.")
-  (let ((*package* dst-package))
-    (multiple-value-bind (form actions)
-       (funcall parse-file-fun grammarfile)
-      (format *debug-io* "Injecting parser functions into ~A~%" dst-package)
-      (loop :for aform :in form
-           :do (progn
-                 (format *debug-io* "Skipping aform ~A~%" aform)))
-      (loop :for (sym code) :in actions
-           :do (intern (compile sym `(lambda (data) (declare (ignorable data)) ,code)))
-           :do (format *debug-io* "Compiled ~A~%" sym))
-      (intern (compile 'parse-string
-                      #'(lambda (s)
-                          `,(format nil "Parse S using grammar ~A starting at ~A" grammarfile start-rule)
-                          (let ((*context* (make-instance 'opossum:context :dstpkg *package* :input s)))
-                            (funcall (make-name start-rule) 0)))))
-      (intern (compile 'parse-file
-                      #'(lambda (f) (parse-string (read-file f)))))
-      (intern (compile 'parse-stream
-                      #'(lambda (s) (parse-string (read-stream s)))))
-      (intern '*trace*)
-      (setf (documentation '*trace* 'cl:variable)
-           "When non-nil, the generated parser function log to cl:*trace-output*.")
-      (export '(parse-string parse-file parse-stream *trace*)))))
-
 (defun get-iso-time ()
   "Return a string in ISO format for the current time"
   (multiple-value-bind (second minute hour date month year day daylight-p zone)
@@ -417,69 +388,150 @@ DST-PACKAGE will contain the 3 functions PARSE-STRING, PARSE-FILE and PARSE-STRE
   (subseq code 0
          (when (char= #\Newline (char code (1- (length code))))
            (1+ (position #\Newline code :from-end T :test #'char/=)))))
-  
+
+(defmacro checking-parse (grammarfile parse-file-fun)
+  (let ((res (gensym "resultctx")))
+    `(let ((,res (funcall ,parse-file-fun ,grammarfile *package*)))
+      (cond
+       ((ctx-failed-p ,res)
+        (format *error-output* "Failed to parse PEG grammar ~A~%" ,grammarfile)
+        (error "Parsing ~A failed: ~A" ,grammarfile ,res))
+       ((< (end-index ,res) (length (input ,res)))
+        (format *error-output* "Parsed only ~D characters of grammar ~A~%" (end-index ,res) ,grammarfile)
+        ,res)
+       (T ,res)))))
+
 (defun generate-parser-file (grammarfile dst-package dst-file &key start-rule (parse-file-fun #'opossum:parse-file))
   "Create lisp code in DST-FILE that can be loaded to yield functions to parse using GRAMMARFILE in DST-PACKAGE.
 DST-PACKAGE will contain the 3 functions PARSE-STRING, PARSE-FILE and PARSE-STREAM as exported entrypoints."
-  (let ((*package* dst-package))
-    (let ((result (funcall parse-file-fun grammarfile)))
-      ;; FIXME: check for complete parse
-      (let ((*context* result))        ;; routines in pegutils.lisp expect *context* to be bound properly
-       (let ((forms (transform (value result)))
-             (actions (actions result)))
-         (with-open-file (s dst-file :direction :output :if-exists :supersede)
-           (let ((*print-readably* T)
-                 (*print-pretty* T)
-                 (*print-circle* NIL)
-                 (dpkg (intern (package-name dst-package) :keyword)))
-             (format s ";; This is a Common Lisp peg parser automatically generated by OPOSSUM -*- mode:lisp -*-~%")
-             (format s ";; generated from ~A on ~A~%" grammarfile (get-iso-time))
-             (prin1
-              `(eval-when (:load-toplevel :compile-toplevel :execute)
-                (declaim (optimize (speed 0) (safety 3) (debug 3))))
-              s) (terpri s) 
-             (prin1
-              `(defpackage ,dpkg
-                (:use :cl :opossum)
-                (:export :parse-string :parse-file :parse-stream))
-              s) (terpri s)
-             (prin1 `(in-package ,dpkg) s) (terpri s)
-             ;; First form is taken to be the start rule
-             (let ((entryrule (or (and start-rule (make-name start-rule))
-                                  (and forms (cadr (first forms))))))
-               (if (not entryrule)
-                   (format *error-output* "Cannot find entry rule for parser")
-                   (progn
-                     (when *trace*
-                       (format *trace-output* "Inserting definitions for parser entry points through ~A~%"
-                               entryrule))
-                     (terpri s)
-                     (prin1 `(defun parse-string (,(intern :s dst-package))
-                              ,(format nil "Parse S using grammar ~A starting at ~A" grammarfile entryrule)
-                              (let ((*context* (make-instance 'opossum:context
-                                                              :dstpkg ,dpkg
-                                                              :input ,(intern :s dst-package))))
-                                (funcall (,entryrule) 0)))
-                            s)
-                     (fresh-line s))))
-             (loop :for aform :in forms
-                   :do (when *trace* (format *trace-output* "Inserting form ~A~%" aform))
-                   :do (terpri s)
-                   :do (prin1 aform s)
-                   :do (fresh-line s))
-             (terpri s)
-             (prin1
-              `(defparameter ,(intern "*trace*" dst-package) nil
-                "When non-nil, the generated parser function log to cl:*trace-output*.")
-              s)
-             (terpri s)
+  (let* ((*package* dst-package)
+        (result (checking-parse grammarfile parse-file-fun))
+        ;; FIXME: check for complete parse
+        (*context* result)  ;; routines in pegutils.lisp expect *context* to be bound properly
+        (dpkg (intern (package-name dst-package) :keyword)))
+    (let ((forms (transform (value result)))
+         (actions (actions result)))
+      (with-open-file (s dst-file :direction :output :if-exists :supersede)
+       (let ((*print-readably* T)
+             (*print-pretty* T)
+             (*print-circle* NIL))
+         (format s ";; This is a Common Lisp peg parser automatically generated by OPOSSUM -*- mode:lisp -*-~%")
+         (format s ";; generated from ~A on ~A~%" grammarfile (get-iso-time))
+         (prin1 `(eval-when (:load-toplevel :compile-toplevel :execute)
+                  (declaim (optimize (speed 0) (safety 3) (debug 3))))
+                s)
+         (terpri s) 
+         (prin1 `(defpackage ,dpkg
+                  (:use :cl :opossum)
+                  (:export :parse-string :parse-file :parse-stream :*trace*))
+                s)
+         (terpri s)
+         (prin1 `(in-package ,dpkg) s) (terpri s)
+         ;; First form is taken to be the start rule
+         (let ((entryrule (or (and start-rule (make-name start-rule))
+                              (and forms (cadr (first forms))))))
+           (if (not entryrule)
+               (format *error-output* "Cannot find entry rule for parser")
+               (progn
+                 (when *trace*
+                   (format *trace-output* "Inserting definitions for parser entry points through ~A~%"
+                           entryrule))
+                 (terpri s)
+                 (prin1 `(defun parse-string (,(intern :s dst-package) dst-package)
+                          ,(format nil "Parse S using grammar ~A starting at ~A" grammarfile entryrule)
+                          (let ((*context* (make-instance 'opossum:context
+                                                          :dst-package dst-package
+                                                          :input ,(intern :s dst-package))))
+                            (funcall (,entryrule) 0)))
+                        s)
+                 (terpri s)
+                 (prin1 `(defun parse-file (,(intern :f dst-package) dst-package)
+                          ,(format nil "Parse file F using grammar ~A starting at ~A" grammarfile entryrule)
+                          (parse-string (opossum:read-file ,(intern :f dst-package)) dst-package))
+                        s)
+                 (terpri s)
+                 (prin1 `(defun parse-stream (,(intern :stream dst-package) dst-package)
+                          ,(format nil "Parse stream F using grammar ~A starting at ~A" grammarfile entryrule)
+                          (parse-string (opossum:read-stream ,(intern :stream dst-package)) dst-package))
+                        s)
+                 (fresh-line s))))
+         (loop :for aform :in forms
+               :do (when *trace* (format *trace-output* "Inserting form ~A~%" aform))
+               :do (terpri s)
+               :do (prin1 aform s)
+               :do (fresh-line s))
+         (terpri s)
+         (prin1
+          `(defparameter ,(intern "*trace*" dst-package) nil
+            "When non-nil, the generated parser function log to cl:*trace-output*.")
+          s)
+         (terpri s)
              
-             (loop :for (sym code) :in actions
-                   :when sym ;; the final action is named NIL because we push a
-                   ;; NIL ahead of us in store-actions
-                   :do (when *trace* (format *trace-output* "Inserting defun for ~A~%" sym))
-                   :and :do (format s "~%(defun ~S (data)~% ~A)~%"
-                                    sym (cleanup-action-code code))))))))))
+         (loop :for (sym code) :in actions
+               :when sym ;; the final action is named NIL because we push a
+               ;; NIL ahead of us in store-actions
+               :do (when *trace* (format *trace-output* "Inserting defun for ~A~%" sym))
+               :and :do (format s "~%(defun ~S (data)~% (declare (ignorable data))~% ~A)~%"
+                                sym (cleanup-action-code code))))))))
+
+(defun generate-parser-package (grammarfile &key (dst-package (make-package (gensym "opossum-parser-")))
+                               start-rule (parse-file-fun #'opossum:parse-file))
+  "Create functions to parse using GRAMMARFILE in DST-PACKAGE, starting ar rule named HEAD.
+DST-PACKAGE will contain the 3 functions PARSE-STRING, PARSE-FILE and PARSE-STREAM as exported entrypoints."
+  (let* ((*package* dst-package)
+        (result (checking-parse grammarfile parse-file-fun))
+        ;; FIXME: check for complete parse
+        (*context* result)) ;; routines in pegutils.lisp expect *context* to be bound properly)
+    (let ((forms (transform (value result)))
+         (actions (actions result)))
+      (format *trace-output* "Injecting parser functions into ~A~%" dst-package)
+      (break "~A, ~A" forms actions)
+      (use-package '(:cl :opossum) dst-package)
+      (let ((entryrule (or (and start-rule (make-name start-rule))
+                          (and forms (cadr (first forms))))))
+       (if (not entryrule)
+           (format *error-output* "Cannot find entry rule for parser")
+           (progn
+             (when *trace*
+               (format *trace-output* "Inserting definitions for parser entry points through ~A~%"
+                       entryrule))
+             (intern (compile 'parse-string
+                              `(lambda (,(intern :s dst-package))
+                                ,(format nil "Parse S using grammar ~A starting at ~A" grammarfile entryrule)
+                                (let ((*context* (make-instance 'opossum:context
+                                                                :dst-package ,dst-package
+                                                                :input ,(intern :s dst-package))))
+                                  (funcall (,entryrule) 0))))
+                     dst-package)
+             (intern (compile 'parse-file
+                              `(lambda (,(intern :f dst-package))
+                                ,(format nil "Parse file F using grammar ~A starting at ~A" grammarfile entryrule)
+                                (parse-string (opossum:read-file ,(intern :f dst-package)))))
+                     dst-package)
+             
+             (intern (compile 'parse-stream
+                              `(lambda (,(intern :stream dst-package))
+                                ,(format nil "Parse stream F using grammar ~A starting at ~A" grammarfile entryrule)
+                                (parse-string (opossum:read-stream ,(intern :stream dst-package)))))
+                     dst-package))))
+      (intern '*trace* dst-package)
+      (setf (documentation '*trace* 'cl:variable)
+           "When non-nil, the generated parser function log to cl:*trace-output*.")
+      (export '(:parse-string :parse-file :parse-stream :*trace*) dst-package)
+
+      (loop :for aform :in forms
+           :do (when *trace*
+                 (format *trace-output* "Injecting form ~A~%" aform))
+           :do (destructuring-bind (defun-sym name args &rest body)
+                   aform
+                 (declare (ignore defun-sym))
+                 (intern (compile name `(lambda ,args ,@body)) dst-package)))
+      (loop :for (sym code) :in actions
+           :when sym
+           :do (when *trace* (format *trace-output* "Injecting definition for ~A~%" sym))
+           :and :do (intern (compile sym `(lambda (data) (declare (ignorable data)) ,code)) dst-package)))))
+
+
 
 (defun transform (tree &optional (depth 0))
   (if (and tree
@@ -495,7 +547,7 @@ DST-PACKAGE will contain the 3 functions PARSE-STRING, PARSE-FILE and PARSE-STRE
                  :when (and (listp el)
                             (eq (first el) ':action)
                             (symbolp (third el)))
-                 :do (let ((*package* (destpkg *context*))
+                 :do (let ((*package* (dst-package *context*))
                            (action (third el)))
                        (when *trace*
                          (format *trace-output* "~&Applying action ~A to ~A~%" action data))