From 01ec1540fbfaf96a9b8633524b1f683318a24f6a Mon Sep 17 00:00:00 2001 From: Utz-Uwe Haus Date: Thu, 2 Oct 2008 10:46:33 +0200 Subject: [PATCH] Package handling improved. 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 --- package.lisp | 3 +- pegparser-boot.lisp | 4 +- pegutils.lisp | 242 +++++++++++++++++++++++++++++++--------------------- 3 files changed, 151 insertions(+), 98 deletions(-) diff --git a/package.lisp b/package.lisp index 38a91d2..243fc25 100644 --- a/package.lisp +++ b/package.lisp @@ -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 diff --git a/pegparser-boot.lisp b/pegparser-boot.lisp index f24368c..8f6b602 100644 --- a/pegparser-boot.lisp +++ b/pegparser-boot.lisp @@ -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))) diff --git a/pegutils.lisp b/pegutils.lisp index b5e928e..7a52b7a 100644 --- a/pegutils.lisp +++ b/pegutils.lisp @@ -42,11 +42,11 @@ (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 @@ -109,7 +109,7 @@ :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 ) @@ -122,7 +122,7 @@ ;; (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." @@ -134,7 +134,7 @@ (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)) -- 2.11.4.GIT