Author: ctian Date: Wed Oct 17 09:07:49 2007 New Revision: 75

Modified: vendor/zebu/zebu-asdf-setup.lisp vendor/zebu/zebu-compile-mg.lisp vendor/zebu/zebu-compiler.asd vendor/zebu/zebu-driver.lisp vendor/zebu/zebu-generator.lisp vendor/zebu/zebu-loader.lisp vendor/zebu/zebu-loadgram.lisp vendor/zebu/zebu-mg.zb vendor/zebu/zebu-package.lisp vendor/zebu/zebu-regex.lisp vendor/zebu/zebu-tree-attributes.lisp Log: * 10_clc-debian.dpatch * 20_comment-start.dpatch * 30_ansi.dpatch

Modified: vendor/zebu/zebu-asdf-setup.lisp ============================================================================== --- vendor/zebu/zebu-asdf-setup.lisp (original) +++ vendor/zebu/zebu-asdf-setup.lisp Wed Oct 17 09:07:49 2007 @@ -1,4 +1,3 @@ - (in-package :asdf)

(defclass zebu-source-file (source-file) ()) @@ -9,8 +8,8 @@ (zebu:zebu-compile-file (component-pathname c)))

(defmethod perform ((o load-op) (c zebu-source-file)) - (let* ((co (make-sub-operation o 'compile-op)) - (output-files (output-files co c))) + (let* ((co (make-instance 'compile-op)) + (output-files (output-files co c))) (setf (component-property c 'last-loaded) (file-write-date (car output-files))) (zb:zebu-load-file (car output-files))))

Modified: vendor/zebu/zebu-compile-mg.lisp ============================================================================== --- vendor/zebu/zebu-compile-mg.lisp (original) +++ vendor/zebu/zebu-compile-mg.lisp Wed Oct 17 09:07:49 2007 @@ -20,11 +20,25 @@

(eval-when (:compile-toplevel) (ignore-errors - (delete-file (merge-pathnames "zebu-mg.tab" *compile-file-truename*)) - (delete-file (merge-pathnames "zmg-dom.lisp" *compile-file-truename*))) + (delete-file (merge-pathnames "zebu-mg.tab" + #-common-lisp-controller + *compile-file-truename* + #+common-lisp-controller + (clc::source-root-path-to-fasl-path + *compile-file-truename*))) + (delete-file (merge-pathnames "zmg-dom.lisp" + #-common-lisp-controller + *compile-file-truename* + #+common-lisp-controller + (clc::source-root-path-to-fasl-path + *compile-file-truename*)))) (zebu-compile-file - (merge-pathnames "zebu-mg.zb" *compile-file-truename*))) - + (merge-pathnames "zebu-mg.zb" *compile-file-truename*) + #+common-lisp-controller :output-file + #+common-lisp-controller (merge-pathnames + "zebu-mg.tab" + (clc::source-root-path-to-fasl-path + *compile-file-truename*))))

(eval-when (:load-toplevel) (zebu-load-file

Modified: vendor/zebu/zebu-compiler.asd ============================================================================== --- vendor/zebu/zebu-compiler.asd (original) +++ vendor/zebu/zebu-compiler.asd Wed Oct 17 09:07:49 2007 @@ -1,6 +1,6 @@ -;;; -*- Lisp -*- +;;;; -*- Mode: Lisp -*-

-;;;(in-package "CL-USER") +(in-package :cl-user)

(asdf:defsystem #:zebu-compiler ;; Compile time system for LALR(1) parser: Converts a grammar to a @@ -9,73 +9,38 @@ :components ((:file "zebu-regex") (:file "zebu-oset") - (:file "zebu-kb-domain") ; not explicitly in ZEBU-sys.lisp - (:file "zebu-g-symbol" - :in-order-to ((compile-op (load-op "zebu-oset")))) - (:file "zebu-loadgram" - :in-order-to ((compile-op (load-op "zebu-g-symbol") - (load-op "zebu-oset")))) - (:file "zebu-generator" - :in-order-to ((compile-op (load-op "zebu-loadgram") - (load-op "zebu-kb-domain")))) - (:file "zebu-lr0-sets" - :in-order-to ((compile-op (load-op "zebu-g-symbol") - (load-op "zebu-loadgram")))) - (:file "zebu-empty-st" - :in-order-to ((compile-op (load-op "zebu-loadgram")))) - (:file "zebu-first" - :in-order-to ((compile-op (load-op "zebu-loadgram") - (load-op "zebu-oset"))) - ;; :recompile-on "zebu-oset" - ) - (:file "zebu-follow" - :in-order-to ((compile-op (load-op "zebu-loadgram") - (load-op "zebu-first")))) - (:file "zebu-tables" - :in-order-to ((compile-op (load-op "zebu-g-symbol") - (load-op "zebu-loadgram") - (load-op "zebu-lr0-sets")))) - (:file "zebu-printers" - :in-order-to ((compile-op (load-op "zebu-loadgram") - (load-op "zebu-lr0-sets") - (load-op "zebu-tables")))) + (:file "zebu-kb-domain") ; not explicitly in ZEBU-sys.lisp + (:file "zebu-g-symbol" :depends-on ("zebu-oset")) + (:file "zebu-loadgram" :depends-on ("zebu-g-symbol" + "zebu-oset")) + (:file "zebu-generator" :depends-on ("zebu-loadgram" + "zebu-kb-domain")) + (:file "zebu-lr0-sets" :depends-on ("zebu-g-symbol" + "zebu-loadgram")) + (:file "zebu-empty-st" :depends-on ("zebu-loadgram")) + (:file "zebu-first" :depends-on ("zebu-loadgram" + "zebu-oset")) + (:file "zebu-follow" :depends-on ("zebu-loadgram" + "zebu-first")) + (:file "zebu-tables" :depends-on ("zebu-g-symbol" + "zebu-loadgram" + "zebu-lr0-sets")) + (:file "zebu-printers" :depends-on ("zebu-loadgram" + "zebu-lr0-sets" + "zebu-tables")) (:file "zebu-slr") - (:file "zebu-closure" - :in-order-to ((compile-op (load-op "zebu-oset") - (load-op "zebu-g-symbol") - (load-op "zebu-first")))) - (:file "zebu-lalr1" - :in-order-to ((compile-op (load-op "zebu-oset") - (load-op "zebu-lr0-sets") - (load-op "zebu-follow")))) - (:file "zebu-dump" - :in-order-to ((compile-op (load-op "zebu-loadgram") - (load-op "zebu-slr") - (load-op "zebu-lalr1")))) - (:file "zebu-compile" - :in-order-to ((compile-op (load-op "zebu-dump")))) - (:file "zebu-compile-mg" - :in-order-to ((compile-op (load-op "zebu-compile") - (load-op "zebu-dump") - (load-op "zebu-empty-st") - (load-op "zebu-closure") - (load-op "zebu-tables") - (load-op "zebu-generator")) - ((load-op (compile-op "zebu-compile-mg") - (load-op "zebu-compile") - (load-op "zebu-dump") - (load-op "zebu-empty-st") - (load-op "zebu-closure") - (load-op "zebu-tables") - (load-op "zebu-generator"))))) - (:file "zmg-dom" - :in-order-to ((compile-op (load-op "zebu-compile-mg")))) - (:file "zebu-kb-domain" - :in-order-to ((compile-op (load-op "zmg-dom")))) - ;;; Hook it into asdf - (:file "zebu-asdf-setup" - :in-order-to ((compile-op (load-op "zebu-kb-domain")))))) - - - - + (:file "zebu-closure" :depends-on ("zebu-oset" + "zebu-g-symbol" + "zebu-first")) + (:file "zebu-lalr1" :depends-on ("zebu-oset" + "zebu-lr0-sets" + "zebu-follow")) + (:file "zebu-dump" :depends-on ("zebu-loadgram" + "zebu-slr" + "zebu-lalr1")) + (:file "zebu-compile" :depends-on ("zebu-empty-st" + "zebu-closure" + "zebu-generator" + "zebu-dump")) + (:file "zebu-compile-mg" :depends-on ("zebu-compile")) + (:file "zebu-asdf-setup" :depends-on ("zebu-kb-domain"))))

Modified: vendor/zebu/zebu-driver.lisp ============================================================================== --- vendor/zebu/zebu-driver.lisp (original) +++ vendor/zebu/zebu-driver.lisp Wed Oct 17 09:07:49 2007 @@ -125,7 +125,7 @@ (defvar *terminal-alist-SEQ*)

(defvar *lexer-debug* nil) -(eval-when (compile) +(eval-when (:compile-toplevel) (setq *lexer-debug* nil))

#| @@ -980,7 +980,7 @@ ;; returned by read-parser

(defvar *comment-brackets* '(("#|" . "|#")) ) -(defvar *comment-start* #; ) +(defvar *comment-start* ";;")

(defun file-parser (file &key (error-fn #'error) @@ -1003,32 +1003,53 @@ (subseq l (+ p (length end)))))) (if (string= l-rest "") (next-line stream) - l-rest)) - (skip-lines stream end))) - l))) - (next-line (stream) ; ignore comments + l-rest)) + (skip-lines stream end))) + l))) + (next-line (stream) ;; ignore comments (let ((l (read-line stream nil eof))) (when verbose (terpri) (princ l)) (if (stringp l) (let ((l-length (length (setq l (string-left-trim - '(#\Space #\Tab) l))))) - (if (zerop l-length) - (next-line stream) - (if (char= *comment-start* (schar l 0)) - (next-line stream) - ;; does this line start a comment - (dolist (comment *comment-brackets* l) - (let* ((start (car comment)) - (start-length (length start))) - (when (and - (>= l-length start-length) - (string= l start :end1 start-length)) - ;; a comment found - (return - (setq l (skip-lines - stream - (cdr comment)))))))))) - l)))) + '(#\Space #\Tab) l))))) + (if (zerop l-length) + ;; blank lines, pass ... + (next-line stream) + ;; search comment-start + (let ((pos (search *comment-start* l))) + (if pos ;; match a comment-start! + (if (zerop pos) + ;; at begin of line? pass ... + (next-line stream) + (progn + ;; return part from begin to comment-start + (setq l (subseq l 0 pos)) + ;; does this line start a comment + (dolist (comment *comment-brackets* l) + (let* ((start (car comment)) + (start-length (length start))) + (when (and + ;; binghe: we must recalc l's length + (>= (length l) start-length) + (string= l start :end1 + start-length)) + ;; a comment found + (return + (setq l (skip-lines + stream + (cdr comment))))))))) + (dolist (comment *comment-brackets* l) + (let* ((start (car comment)) + (start-length (length start))) + (when (and + (>= l-length start-length) + (string= l start :end1 start-length)) + ;; a comment found + (return + (setq l (skip-lines + stream + (cdr comment))))))))))) + l)))) (do ((line (next-line stream))) ((eq line eof) (nreverse R)) (multiple-value-bind (expr rest) @@ -1043,15 +1064,15 @@ (if (eq line eof) (if error-fn (funcall error-fn) - (error "Reached end of file ~S while parsing" - stream)) - line))) + (error "Reached end of file ~S while parsing" + stream)) + line))) ;; (when verbose (let ((*print-structure* t)) (print expr))) (push expr R) (when (eq line eof) (return (nreverse R))) (setq line (if rest (subseq line rest) - (next-line stream))))))) + (next-line stream)))))))

;----------------------------------------------------------------------------; ; debug-parser

Modified: vendor/zebu/zebu-generator.lisp ============================================================================== --- vendor/zebu/zebu-generator.lisp (original) +++ vendor/zebu/zebu-generator.lisp Wed Oct 17 09:07:49 2007 @@ -421,7 +421,7 @@ ; return: (1) ((<test for print-case> <format stmt derived from syntax>) ..) ; (2) a lambda-list binding the %u .. variables used to accessors ; derived from the paths. -(defconstant *vars-to-use* '("%R" "%S" "%T" "%U" "%V" "%W" "%X" "%Y" "%Z")) +(defvar *vars-to-use* '("%R" "%S" "%T" "%U" "%V" "%W" "%X" "%Y" "%Z"))

(defun gen-clauses (clauses KB-sequence-print-fn-AL &aux (vars-to-use (mapcar #'intern *vars-to-use*))

Modified: vendor/zebu/zebu-loader.lisp ============================================================================== --- vendor/zebu/zebu-loader.lisp (original) +++ vendor/zebu/zebu-loader.lisp Wed Oct 17 09:07:49 2007 @@ -240,11 +240,11 @@ x 'nil)))

-(eval-when (compile) +(eval-when (:compile-toplevel) (setq *grammar-debug* nil))

#|| -(eval-when (eval) +(eval-when (:execute) (setq *grammar-debug* T)) ||#

Modified: vendor/zebu/zebu-loadgram.lisp ============================================================================== --- vendor/zebu/zebu-loadgram.lisp (original) +++ vendor/zebu/zebu-loadgram.lisp Wed Oct 17 09:07:49 2007 @@ -716,15 +716,15 @@ (make-pathname :name (format nil "~A-domain" (get-grammar-options-key ':NAME)))) - (merge-pathnames (merge-pathnames (make-pathname :type (first *load-source-pathname-types*)) - grammar-file) - *default-pathname-defaults*))) + (clc::source-root-path-to-fasl-path + grammar-file)))) (*print-array* t) ; bit-vectors of regex code *print-level* *print-length* *print-circle* written?) - #-MCL (when (probe-file domain-file) + #-(or MCL sbcl) + (when (probe-file domain-file) (warn "Renaming existing domain file ~a" domain-file)) (with-open-file (port domain-file :if-does-not-exist :create @@ -757,7 +757,7 @@ (terpri port) ;; for lexical categories: compile the rx-token parsers! (when *lex-cats* - (pprint '(eval-when (compile) + (pprint '(eval-when (:compile-toplevel) (unless (member "zebu-regex" *modules* :test #'equal) (WARN "Load the Zebu Compiler!"))) port)

Modified: vendor/zebu/zebu-mg.zb ============================================================================== --- vendor/zebu/zebu-mg.zb (original) +++ vendor/zebu/zebu-mg.zb Wed Oct 17 09:07:49 2007 @@ -1,20 +1,20 @@ -; -*- mode: Lisp -*- --------------------------------------------------- ; -; File: zebu-mg.zb -; Description: Metagrammar for Zebu -; Author: Joachim H. Laubsch -; Created: 13-Apr-92 -; Modified: Thu Dec 21 16:26:28 1995 (Joachim H. Laubsch) -; Language: Lisp -; Package: ZEBU -; Status: Experimental (Do Not Distribute) -; RCS $Header: $ -; -; (c) Copyright 1992, Hewlett-Packard Company -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Revisions: -; RCS $Log: $ -; 10-Mar-93 (Joachim H. Laubsch) -; add domain definition +;;; -*- Mode: Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; File: zebu-mg.zb +;;; Description: Metagrammar for Zebu +;;; Author: Joachim H. Laubsch +;;; Created: 13-Apr-92 +;;; Modified: Thu Dec 21 16:26:28 1995 (Joachim H. Laubsch) +;;; Language: Lisp +;;; Package: ZEBU +;;; Status: Experimental (Do Not Distribute) +;;; RCS $Header: $ +;;; +;;; (c) Copyright 1992, Hewlett-Packard Company +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Revisions: +;;; RCS $Log: $ +;;; 10-Mar-93 (Joachim H. Laubsch) +;;; add domain definition ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (:name "zebu-mg" :domain-file "zmg-dom"

Modified: vendor/zebu/zebu-package.lisp ============================================================================== --- vendor/zebu/zebu-package.lisp (original) +++ vendor/zebu/zebu-package.lisp Wed Oct 17 09:07:49 2007 @@ -21,7 +21,7 @@ (provide "zebu-package")

#+LUCID ; while not up tp CLtL2 -(eval-when (compile load eval) +(eval-when (:compile-toplevel :load-toplevel :execute) (defmacro LCL::DECLAIM (decl-spec) `(proclaim ',decl-spec)))

;;; 2000-03-25 by rschlatte@ist.tu-graz.ac.at:

Modified: vendor/zebu/zebu-regex.lisp ============================================================================== --- vendor/zebu/zebu-regex.lisp (original) +++ vendor/zebu/zebu-regex.lisp Wed Oct 17 09:07:49 2007 @@ -86,7 +86,7 @@ (if *regex-debug* `(format *standard-output* ,message ,@args)))

-(eval-when (compile) +(eval-when (:compile-toplevel) (setq *regex-debug* nil))

;;;

Modified: vendor/zebu/zebu-tree-attributes.lisp ============================================================================== --- vendor/zebu/zebu-tree-attributes.lisp (original) +++ vendor/zebu/zebu-tree-attributes.lisp Wed Oct 17 09:07:49 2007 @@ -83,7 +83,7 @@ writers)) (push setter setters))) `(progn - (eval-when (compile eval) ,@writers) + (eval-when (:compile-toplevel :execute) ,@writers) (setf (get ',class 'KB-TREE-ATTRIBUTES) (cons ',slots @@ -114,7 +114,7 @@ writers)) (push setter setters))) `(progn - (eval-when (compile eval #+CLISP load) ,@writers) + (eval-when (:compile-toplevel :execute #+CLISP :load-toplevel) ,@writers) ,@(mapcar #'(lambda (set-valued-slot) (let ((type (second set-valued-slot))) (if (eq type :set)