[climacs-cvs] CVS climacs
crhodes
crhodes at common-lisp.net
Fri Jan 4 13:08:22 UTC 2008
Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv4417
Modified Files:
climacs.asd prolog-syntax.lisp
Log Message:
Make prolog syntax work
(slowly, because we've lost the incremental nature: the buffer is fully
reparsed every time, even if that work is unnecessary.)
--- /project/climacs/cvsroot/climacs/climacs.asd 2008/01/03 17:00:24 1.63
+++ /project/climacs/cvsroot/climacs/climacs.asd 2008/01/04 13:08:22 1.64
@@ -36,7 +36,7 @@
(:file "text-syntax" :depends-on ("packages"))
;; (:file "cl-syntax" :depends-on ("packages"))
;; (:file "html-syntax" :depends-on ("packages"))
-;; (:file "prolog-syntax" :depends-on ("packages"))
+ (:file "prolog-syntax" :depends-on ("packages"))
;; (:file "prolog2paiprolog" :depends-on ("prolog-syntax"))
;; (:file "ttcn3-syntax" :depends-on ("packages"))
(:file "climacs-lisp-syntax" :depends-on ("core" "groups"))
--- /project/climacs/cvsroot/climacs/prolog-syntax.lisp 2006/11/16 15:05:23 1.31
+++ /project/climacs/cvsroot/climacs/prolog-syntax.lisp 2008/01/04 13:08:22 1.32
@@ -47,17 +47,18 @@
(defmethod initialize-instance :after ((syntax prolog-syntax) &rest args)
(declare (ignore args))
- (with-slots (parser lexer buffer) syntax
- (setf parser (make-instance 'parser
- :grammar *prolog-grammar*
- :target 'prolog-text))
- (setf lexer (make-instance 'prolog-lexer :buffer (buffer syntax)))
- (let ((m (clone-mark (low-mark buffer) :left))
- (lexeme (make-instance 'start-lexeme :state (initial-state parser))))
- (setf (offset m) 0)
- (setf (start-offset lexeme) m
- (end-offset lexeme) 0)
- (insert-lexeme lexer 0 lexeme))))
+ (let ((buffer (buffer syntax)))
+ (with-slots (parser lexer) syntax
+ (setf parser (make-instance 'parser
+ :grammar *prolog-grammar*
+ :target 'prolog-text))
+ (setf lexer (make-instance 'prolog-lexer :buffer buffer :syntax syntax))
+ (let ((m (make-buffer-mark buffer 0 :left))
+ (lexeme (make-instance 'start-lexeme :state (initial-state parser))))
+ (setf (offset m) 0)
+ (setf (start-offset lexeme) m
+ (end-offset lexeme) 0)
+ (insert-lexeme lexer 0 lexeme)))))
;;; grammar
@@ -156,7 +157,8 @@
(make-instance 'layout-text :cont nil))
(defclass prolog-lexer (incremental-lexer)
- ((valid-lex :initarg :valid-lex :initform 1)))
+ ((valid-lex :initarg :valid-lex :initform 1)
+ (syntax :initarg :syntax :reader syntax)))
(defmethod next-lexeme ((lexer prolog-lexer) scan)
(let ((string (make-array 0 :element-type 'character
@@ -303,7 +305,7 @@
(t
(cond
((and (string= string ".")
- (or (whitespacep (syntax (buffer lexer))
+ (or (whitespacep (syntax lexer)
(object-after scan))
(eql (object-after scan) #\%)))
(return (make-instance 'end-lexeme)))
@@ -374,7 +376,7 @@
(when (or (end-of-buffer-p scan)
(let ((object (object-after scan)))
(or (eql object #\%)
- (whitespacep (syntax (buffer lexer))
+ (whitespacep (syntax lexer)
object))))
(bo)
(return (make-instance 'integer-lexeme)))
@@ -1124,11 +1126,44 @@
;;; update syntax
-(defmethod update-syntax-for-display (buffer (syntax prolog-syntax) top bot)
+(defmethod inter-lexeme-object-p ((lexer prolog-lexer) object)
+ (member object '(#\Space #\Newline #\Tab)))
+
+(defmethod update-syntax ((syntax prolog-syntax) prefix-size suffix-size &optional begin end)
+ (call-next-method)
+ (with-slots (lexer valid-parse) syntax
+ (let* ((low-mark (make-buffer-mark (buffer syntax) prefix-size :left))
+ (high-mark (make-buffer-mark
+ (buffer syntax) (- (size (buffer syntax)) suffix-size) :left)))
+ ;; this bit really belongs in a method on a superclass --
+ ;; something like incremental-lexer.
+ (when (mark<= low-mark high-mark)
+ (with-slots (drei-syntax::lexemes valid-lex)
+ lexer
+ (let ((start 1)
+ (end (nb-elements drei-syntax::lexemes)))
+ (loop while (< start end)
+ do (let ((middle (floor (+ start end) 2)))
+ (if (mark< (end-offset (element* drei-syntax::lexemes middle))
+ low-mark)
+ (setf start (1+ middle))
+ (setf end middle))))
+ (setf valid-lex start)
+ (setf valid-parse start))))
+ ;; this bit is truly prolog-syntax specific.
+ (when (mark<= low-mark high-mark)
+ (with-slots (operator-directives) syntax
+ (do ((directives operator-directives (cdr directives)))
+ ((null directives) (setf operator-directives nil))
+ (when (< (end-offset (car directives))
+ (offset low-mark))
+ (setf operator-directives directives)
+ (return nil)))))))
+ ;; old update-syntax-for-display
(with-slots (parser lexer valid-parse) syntax
(with-slots (drei-syntax::lexemes valid-lex) lexer
- (let ((scan (clone-mark (low-mark buffer) :left))
- (high-mark (high-mark buffer)))
+ (let ((scan (make-buffer-mark (buffer syntax) prefix-size :left))
+ (high-mark (make-buffer-mark (buffer syntax) (- (size (buffer syntax)) suffix-size) :left)))
(setf (offset scan)
(end-offset (lexeme lexer (1- valid-lex))))
;; this magic belongs in a superclass' method. (It's not the
@@ -1136,7 +1171,8 @@
(loop named relex
do (skip-inter-lexeme-objects lexer scan)
until (end-of-buffer-p scan)
- until (mark<= bot (start-offset (lexeme lexer (1- valid-lex))))
+ #+nil #+nil ; FIXME: incremental
+ until (<= end (start-offset (lexeme lexer (1- valid-lex))))
do (when (mark> scan high-mark)
(do ()
((= (nb-lexemes lexer) valid-lex))
@@ -1174,48 +1210,18 @@
;; thing) can return a delegating buffer.
(let ((*this-syntax* syntax))
(loop until (= valid-parse valid-lex)
- until (mark<= bot (start-offset (lexeme lexer (1- valid-parse))))
+ #+nil #+nil ; FIXME: incremental
+ until (<= end (start-offset (lexeme lexer (1- valid-parse))))
do (let ((current-token (lexeme lexer (1- valid-parse)))
(next-lexeme (lexeme lexer valid-parse)))
(setf (slot-value next-lexeme 'state)
(advance-parse parser (list next-lexeme)
(slot-value current-token 'state)))
(incf valid-parse)))))))
-
-(defmethod inter-lexeme-object-p ((lexer prolog-lexer) object)
- (member object '(#\Space #\Newline #\Tab)))
-
-(defmethod update-syntax (buffer (syntax prolog-syntax))
- (with-slots (lexer valid-parse) syntax
- (let* ((low-mark (low-mark buffer))
- (high-mark (high-mark buffer)))
- ;; this bit really belongs in a method on a superclass --
- ;; something like incremental-lexer.
- (when (mark<= low-mark high-mark)
- (with-slots (drei-syntax::lexemes valid-lex)
- lexer
- (let ((start 1)
- (end (nb-elements drei-syntax::lexemes)))
- (loop while (< start end)
- do (let ((middle (floor (+ start end) 2)))
- (if (mark< (end-offset (element* drei-syntax::lexemes middle))
- low-mark)
- (setf start (1+ middle))
- (setf end middle))))
- (setf valid-lex start)
- (setf valid-parse start))))
- ;; this bit is truly prolog-syntax specific.
- (when (mark<= low-mark high-mark)
- (with-slots (operator-directives) syntax
- (do ((directives operator-directives (cdr directives)))
- ((null directives) (setf operator-directives nil))
- (when (< (end-offset (car directives))
- (offset low-mark))
- (setf operator-directives directives)
- (return nil))))))))
;;; display
-
+#+nil ; old, not based on stroking pumps.
+(progn
(defvar *white-space-start* nil)
(defvar *current-line* 0)
@@ -1352,7 +1358,7 @@
do (let ((token (lexeme lexer start-token-index)))
(display-parse-tree token syntax stream drei))
(incf start-token-index)))))))))
-
+) ; PROGN
#|
(climacs-gui::define-named-command com-inspect-lex ()
(with-slots (lexer) (slot-value (buffer (climacs-gui::current-window)) 'drei-syntax::syntax)
More information about the Climacs-cvs
mailing list