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(a)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)
