March 2005 - climacs-cvs@common-lisp.net - mailman3.common-lisp.net

[climacs-cvs] CVS update: climacs/Persistent/persistent-buffer.lisp
by abakic＠common-lisp.net 05 Mar '05

05 Mar '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv20289/Persistent Modified Files: persistent-buffer.lisp Log Message: Cursor-adjustment performance improvements. Date: Sat Mar 5 12:56:15 2005 Author: abakic Index: climacs/Persistent/persistent-buffer.lisp diff -u climacs/Persistent/persistent-buffer.lisp:1.7 climacs/Persistent/persistent-buffer.lisp:1.8 --- climacs/Persistent/persistent-buffer.lisp:1.7 Fri Feb 25 21:45:11 2005 +++ climacs/Persistent/persistent-buffer.lisp Sat Mar 5 12:56:15 2005 @@ -55,7 +55,7 @@ (defclass persistent-buffer (buffer) ((low-mark :reader low-mark) (high-mark :reader high-mark) - (cursors :reader cursors :initform nil) + (cursors :accessor cursors :initform nil) (modified :initform nil :reader modified-p)) (:documentation "The Climacs persistent buffer base class \(non-instantiable).")) @@ -481,42 +481,53 @@ (end-of-buffer (low-mark buffer)) (setf (slot-value buffer 'modified) nil)) -;;; I hope the code below is not wrong, although it is slow for now. It should -;;; look like flexichain::adjust-cursors, but I am planning to write that in -;;; a more compact form. The two functions below should not return anything. +(defmacro filter-and-update (l filter-fn update-fn) + (let ((prev (gensym)) + (curr (gensym)) + (kept (gensym))) + `(loop + with ,prev = nil + and ,curr = ,l + and ,kept = nil + do (cond + ((null ,curr) (return)) + ((setf ,kept (funcall ,filter-fn (car ,curr))) + (funcall ,update-fn ,kept) + (setf ,prev ,curr + ,curr (cdr ,curr))) + (t (if ,prev + (setf (cdr ,prev) (cdr ,curr)) + (setf ,l (cdr ,l))) + (setf ,curr (cdr ,curr))))))) + (defun adjust-cursors-on-insert (buffer start &optional (increment 1)) - (loop for c in (cursors buffer); TODO: use side-effects to get rid of consing - as wpc = (flexichain::weak-pointer-value c buffer) - when wpc - collect (progn - (when (<= start (slot-value wpc 'pos)) - (incf (slot-value wpc 'pos) increment)) - c))) + (filter-and-update + (cursors buffer) + #'(lambda (c) (flexichain::weak-pointer-value c buffer)) + #'(lambda (wpc) + (when (<= start (slot-value wpc 'pos)) + (incf (slot-value wpc 'pos) increment))))) (defun adjust-cursors-on-delete (buffer start n) - (loop with end = (+ start n) ; TODO: use side-effects to get rid of consing - for c in (cursors buffer) - as wpc = (flexichain::weak-pointer-value c buffer) - when wpc - collect (progn - (cond - ((<= (cursor-pos wpc) start)) - ((< start (cursor-pos wpc) end) - (setf (cursor-pos wpc) start)) - (t (decf (cursor-pos wpc) n))) - c))) + (let ((end (+ start n))) + (filter-and-update + (cursors buffer) + #'(lambda (c) (flexichain::weak-pointer-value c buffer)) + #'(lambda (wpc) + (cond + ((<= (cursor-pos wpc) start)) + ((< start (cursor-pos wpc) end) + (setf (cursor-pos wpc) start)) + (t (decf (cursor-pos wpc) n))))))) (defmethod insert-buffer-object :after ((buffer persistent-buffer) offset object) - (with-slots (cursors) buffer - (setf cursors (adjust-cursors-on-insert buffer offset)))) + (adjust-cursors-on-insert buffer offset)) (defmethod insert-buffer-sequence :after ((buffer persistent-buffer) offset sequence) - (with-slots (cursors) buffer - (setf cursors (adjust-cursors-on-insert buffer offset (length sequence))))) + (adjust-cursors-on-insert buffer offset (length sequence))) (defmethod delete-buffer-range :after ((buffer persistent-buffer) offset n) - (with-slots (cursors) buffer - (setf cursors (adjust-cursors-on-delete buffer offset n)))) + (adjust-cursors-on-delete buffer offset n))

1 0

[climacs-cvs] CVS update: climacs/Persistent/README
by abakic＠common-lisp.net 05 Mar '05

05 Mar '05

Update of /project/climacs/cvsroot/climacs/Persistent In directory common-lisp.net:/tmp/cvs-serv20268/Persistent Modified Files: README Log Message: Update related to the intro of delegating-buffer. Date: Sat Mar 5 12:55:10 2005 Author: abakic Index: climacs/Persistent/README diff -u climacs/Persistent/README:1.3 climacs/Persistent/README:1.4 --- climacs/Persistent/README:1.3 Sat Feb 5 21:59:51 2005 +++ climacs/Persistent/README Sat Mar 5 12:55:10 2005 @@ -3,14 +3,8 @@ used as just balanced trees. To use any of these buffer implementations (binseq-buffer or -obinseq-buffer), substitute "standard-buffer" in the superclass list -of climacs-buffer class in pane.lisp (marked by a "PB" comment). At -all other places marked with "PB" comments, substitute "standard" for -"persistent" in order to use the corresponding mark classes. +obinseq-buffer), pass them as the :implementation argument when +instatiating climacs-buffer class in pane.lisp. NOTE: There is a dependency of Persistent/persistent-buffer.lisp on -Flexichain/utilities.lisp (the weak pointer handling). - -NOTE: Package :binseq is now used by package :climacs-buffer, and -the latter also exports persistent buffer and mark related symbols -mentioned above in connection to "PB" comments. +Flexichain/utilities.lisp (the weak pointer handling). \ No newline at end of file

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by abakic＠common-lisp.net 05 Mar '05

05 Mar '05

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv20229/Doc Modified Files: climacs-internals.texi Log Message: Typo fixes. Date: Sat Mar 5 12:53:52 2005 Author: abakic Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.15 climacs/Doc/climacs-internals.texi:1.16 --- climacs/Doc/climacs-internals.texi:1.15 Tue Mar 1 05:56:27 2005 +++ climacs/Doc/climacs-internals.texi Sat Mar 5 12:53:52 2005 @@ -1212,7 +1212,7 @@ @deffn {generic function} parse-stack buffer-stream Return the current parse stack of the buffer stream. The parse stack -contains either all nonterminal, or all but the top element +contains either all nonterminals, or all but the top element nonterminal. The list of entries is initially a list of a single entry corresponding to the syntactic category `program-entry' with a start offset of 0 and an expression count of 0. @@ -1908,7 +1908,7 @@ Returns the value of a kill ring's maximum size. @end deffn -@deffn {generic function} {(setf kill-ring-max-size)} kill-ring size +@deffn {generic function} {(setf kill-ring-max-size)} size kill-ring Alters the maximum size of a kill ring even if it means dropping elements to do so. @end deffn

1 0

[climacs-cvs] CVS update: climacs/gui.lisp climacs/html-syntax.lisp climacs/packages.lisp climacs/pane.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 05 Mar '05

05 Mar '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv3124 Modified Files: gui.lisp html-syntax.lisp packages.lisp pane.lisp syntax.lisp Log Message: Split off the climacs-html-syntax package from the climacs-syntax package. Exported some more symbols from the climacs-syntax package. Implemented a few more functions in the climacs-syntax package that can be used to travarse the parse stack. The redisplay-pane function now calls a generic function redisplay-pane-with-syntax that also takes a syntax object as argument. Date: Sat Mar 5 08:03:53 2005 Author: rstrandh Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.126 climacs/gui.lisp:1.127 --- climacs/gui.lisp:1.126 Mon Feb 28 09:51:33 2005 +++ climacs/gui.lisp Sat Mar 5 08:03:52 2005 @@ -146,7 +146,7 @@ (defun display-win (frame pane) "The display function used by the climacs application frame." (declare (ignore frame)) - (redisplay-pane pane (eq pane (car (windows *application-frame*))))) + (redisplay-pane pane (eq pane (current-window)))) (defmethod handle-repaint :before ((pane extended-pane) region) (declare (ignore region)) Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.5 climacs/html-syntax.lisp:1.6 --- climacs/html-syntax.lisp:1.5 Fri Mar 4 08:17:44 2005 +++ climacs/html-syntax.lisp Sat Mar 5 08:03:53 2005 @@ -20,7 +20,7 @@ ;;; Syntax for analysing HTML -(in-package :climacs-syntax) ;;; Put this in a separate package once it works +(in-package :climacs-html-syntax) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -34,7 +34,11 @@ (and (eq (class-of t1) (class-of t2)) (< (badness t1) (badness t2)))) -(defclass words (html-sym) ()) +(defclass html-nonterminal (html-sym) + ((start-offset :initarg :start-offset :reader start-offset) + (end-offset :initarg :end-offset :reader end-offset))) + +(defclass words (html-nonterminal) ()) (defclass empty-words (words) ()) @@ -42,7 +46,7 @@ ((words :initarg :words) (word :initarg :word))) -(defclass html-balanced (html-sym) +(defclass html-balanced (html-nonterminal) ((start :initarg :start) (end :initarg :end))) @@ -195,17 +199,24 @@ (tag-end (= (end-offset word) (start-offset tag-end)))) :start-mark (start-mark tag-start)) (html -> (<html> head body </html>) + :start-offset (start-offset <html>) :end-offset (end-offset </html>) :start <html> :head head :body body :end </html>) (head -> (<head> title </head>) + :start-offset (start-offset <head>) :end-offset (end-offset </head>) :start <head> :title title :end </head>) (title -> (<title> words </title>) + :start-offset (start-offset <title>) :end-offset (end-offset </title>) :start <title> :words words :end </title>) (body -> (<body> words </body>) + :start-offset (start-offset <body>) :end-offset (end-offset </body>) :start <body> :words words :end </body>) (words -> () - (make-instance 'empty-words)) + (make-instance 'empty-words :start-offset nil)) (words -> (words word) - (make-instance 'nonempty-words :words words :word word)))) + (make-instance 'nonempty-words + :start-offset (or (start-offset words) (start-offset word)) + :end-offset (end-offset word) + :words words :word word)))) (defmethod initialize-instance :after ((syntax html-syntax) &rest args) (declare (ignore args)) @@ -220,6 +231,10 @@ :size 0 :state (initial-state parser))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; update syntax + (defmethod update-syntax-for-display (buffer (syntax html-syntax) top bot) (with-slots (parser tokens valid-parse) syntax (loop until (= valid-parse (nb-elements tokens)) @@ -267,4 +282,10 @@ do (setf start-mark (clone-mark scan)) (insert* tokens guess-pos (next-token scan)) (incf guess-pos)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; display + + Index: climacs/packages.lisp diff -u climacs/packages.lisp:1.52 climacs/packages.lisp:1.53 --- climacs/packages.lisp:1.52 Mon Feb 28 09:51:35 2005 +++ climacs/packages.lisp Sat Mar 5 08:03:53 2005 @@ -90,6 +90,11 @@ (:export #:syntax #:define-syntax #:basic-syntax #:update-syntax #:update-syntax-for-display + #:grammar #:parser #:initial-state + #:advance-parse + #:parse-stack-top #:target-parse-tree + #:parse-stack-next #:parse-stack-symbol + #:parse-stack-parse-trees #:map-over-parse-trees #:syntax-line-indentation #:beginning-of-paragraph #:end-of-paragraph)) @@ -126,7 +131,12 @@ #:query-replace-state #:string1 #:string2 #:query-replace-mode #:with-undo + #:redisplay-pane-with-syntax #:url)) + +(defpackage :climacs-html-syntax + (:use :clim-lisp :clim :climacs-buffer :climacs-base + :climacs-syntax :flexichain :climacs-pane)) (defpackage :climacs-gui (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax Index: climacs/pane.lisp diff -u climacs/pane.lisp:1.19 climacs/pane.lisp:1.20 --- climacs/pane.lisp:1.19 Sun Feb 27 19:52:01 2005 +++ climacs/pane.lisp Sat Mar 5 08:03:53 2005 @@ -487,6 +487,11 @@ (+ cursor-x 2) (+ cursor-y (* 0.8 height)) :ink cursor-ink))))) +(defgeneric redisplay-pane-with-syntax (pane syntax current-p)) + +(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax basic-syntax) current-p) + (display-cache pane (if current-p +red+ +blue+))) + (defgeneric redisplay-pane (pane current-p)) (defmethod redisplay-pane ((pane climacs-pane) current-p) @@ -497,7 +502,7 @@ (adjust-cache pane)) (fill-cache pane) (update-syntax-for-display (buffer pane) (syntax (buffer pane)) (top pane) (bot pane)) - (display-cache pane (if current-p +red+ +blue+))) + (redisplay-pane-with-syntax pane (syntax (buffer pane)) current-p)) (defgeneric full-redisplay (pane)) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.33 climacs/syntax.lisp:1.34 --- climacs/syntax.lisp:1.33 Fri Mar 4 08:17:44 2005 +++ climacs/syntax.lisp Sat Mar 5 08:03:53 2005 @@ -312,6 +312,37 @@ ;;; ;;; Code for analysing parse stack +(defun parse-stack-top (state) + "for a given state, return the top of the parse stack, or NIL if the parse stack +is empty in that state." + (when (plusp (hash-table-count (incomplete-items state))) + (maphash (lambda (state items) + (declare (ignore state)) + (return-from parse-stack-top (car items))) + (incomplete-items state)))) + +(defun target-parse-tree (state) + "for a given state, return a target parse tree, or NIL if this state does not +represent a complete parse of the target." + (state-contains-target-p state)) + +(defun parse-stack-next (parse-stack) + "given a parse stack frame, return the next frame in the stack." + (assert (not (null parse-stack))) + (predicted-from parse-stack)) + +(defun parse-stack-symbol (parse-stack) + "given a parse stack frame, return the target symbol of the frame." + (assert (not (null parse-stack))) + (left-hand-side (rule parse-stack))) + +(defun parse-stack-parse-trees (parse-stack) + "given a parse stack frame, return a list (in the reverse order of +analysis) of the parse trees recognized. The return value reveals +internal state of the parser. Do not alter it!" + (assert (not (null parse-stack))) + (parse-trees parse-stack)) + (defun map-over-parse-trees (function state) (labels ((map-incomplete-item (item) (unless (null (predicted-from item))

1 0

[climacs-cvs] CVS update: climacs/html-syntax.lisp climacs/syntax.lisp
by rstrandh＠common-lisp.net 04 Mar '05

04 Mar '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv18478 Modified Files: html-syntax.lisp syntax.lisp Log Message: Intoduced a function `map-over-parse-trees' that syntax modules can use to traverse the parse tree. This function traverses but one of the paths through the parser data structure. In general, there can be an exponential number of such paths, but we assume anyone will do as far as buffer syntax is concerned. Date: Fri Mar 4 08:17:44 2005 Author: rstrandh Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.4 climacs/html-syntax.lisp:1.5 --- climacs/html-syntax.lisp:1.4 Mon Feb 28 09:51:34 2005 +++ climacs/html-syntax.lisp Fri Mar 4 08:17:44 2005 @@ -223,7 +223,7 @@ (defmethod update-syntax-for-display (buffer (syntax html-syntax) top bot) (with-slots (parser tokens valid-parse) syntax (loop until (= valid-parse (nb-elements tokens)) - while (mark< (end-offset (element* tokens valid-parse)) bot) + while (mark<= (end-offset (element* tokens valid-parse)) bot) do (let ((current-token (element* tokens (1- valid-parse))) (next-token (element* tokens valid-parse))) (setf (slot-value next-token 'state) Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.32 climacs/syntax.lisp:1.33 --- climacs/syntax.lisp:1.32 Wed Mar 2 06:21:07 2005 +++ climacs/syntax.lisp Fri Mar 4 08:17:44 2005 @@ -143,6 +143,7 @@ (defclass incomplete-item (rule-item) ((orig-state :initarg :orig-state :reader orig-state) + (predicted-from :initarg :predicted-from :reader predicted-from) (rule :initarg :rule :reader rule) (dot-position :initarg :dot-position :reader dot-position) (parse-trees :initarg :parse-trees :reader parse-trees) @@ -172,6 +173,7 @@ ((functionp remaining) (make-instance 'incomplete-item :orig-state (orig-state prev-item) + :predicted-from (predicted-from prev-item) :rule (rule prev-item) :dot-position (1+ (dot-position prev-item)) :parse-trees (cons parse-tree (parse-trees prev-item)) @@ -205,7 +207,8 @@ (incomplete-items :initform (make-hash-table :test #'eq) :reader incomplete-items) (parse-trees :initform (make-hash-table :test #'eq) - :reader parse-trees))) + :reader parse-trees) + (last-nonempty-state :initarg :last-nonempty-state :accessor last-nonempty-state))) (defun map-over-incomplete-items (state fun) (maphash (lambda (key incomplete-items) @@ -251,6 +254,7 @@ (handle-item (if (functionp (right-hand-side rule)) (make-instance 'incomplete-item :orig-state to-state + :predicted-from item :rule rule :dot-position 0 :parse-trees '() @@ -269,6 +273,7 @@ (declare (ignore args)) (with-slots (grammar initial-state) parser (setf initial-state (make-instance 'parser-state :parser parser)) + (setf (last-nonempty-state initial-state) initial-state) (loop for rule in (rules grammar) do (when (let ((sym (left-hand-side rule))) (or (subtypep (target parser) sym) @@ -276,6 +281,7 @@ (handle-item (if (functionp (right-hand-side rule)) (make-instance 'incomplete-item :orig-state initial-state + :predicted-from nil :rule rule :dot-position 0 :parse-trees '() @@ -284,45 +290,39 @@ :parse-tree (right-hand-side rule))) initial-state initial-state))))) +(defun state-contains-target-p (state) + (loop with target = (target (parser state)) + for parse-tree in (gethash (initial-state (parser state)) + (parse-trees state)) + when (typep parse-tree target) + do (return parse-tree))) + (defun advance-parse (parser tokens state) (let ((new-state (make-instance 'parser-state :parser parser))) (loop for token in tokens do (potentially-handle-parse-tree token state new-state)) + (setf (last-nonempty-state new-state) + (if (or (plusp (hash-table-count (incomplete-items new-state))) + (state-contains-target-p new-state)) + new-state + (last-nonempty-state state))) new-state)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Code for analysing parse stack -(defun parse-stack-top (state) - "given a parse state, return a list of all incomplete items that did -not originate in that state, or if no such items exist, a list of all -parse trees of state that originated in the initial state." - (let ((items '())) - (map-over-incomplete-items - state - (lambda (key item) - (unless (eq key state) - (push item items)))) - (unless items - (loop with target = (target (parser state)) - for parse-tree in (gethash (initial-state (parser state)) - (parse-trees state)) - when (subtypep parse-tree target) - do (push parse-tree items))) - items)) - -(defun parse-stack-next (incomplete-item) - "given an incomplete item, return a list of all incomplete items it -could have been predicted from." - (let ((items '()) - (orig-state (orig-state incomplete-item)) - (sym1 (left-hand-side (rule incomplete-item)))) - (map-over-incomplete-items - orig-state - (lambda (key item) - (unless (eq key orig-state) - (when (let ((sym2 (aref (symbols (rule item)) (dot-position item)))) - (or (subtypep sym1 sym2) (subtypep sym2 sym1))) - (push item items))))) - items)) +(defun map-over-parse-trees (function state) + (labels ((map-incomplete-item (item) + (unless (null (predicted-from item)) + (map-incomplete-item (predicted-from item))) + (loop for parse-tree in (reverse (parse-trees item)) + do (funcall function parse-tree)))) + (let ((state (last-nonempty-state state))) + (if (plusp (hash-table-count (incomplete-items state))) + (maphash (lambda (state items) + (declare (ignore state)) + (map-incomplete-item (car items)) + (return-from map-over-parse-trees nil)) + (incomplete-items state)) + (funcall function (state-contains-target-p state))))))

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 02 Mar '05

02 Mar '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv8925 Modified Files: syntax.lisp Log Message: A parser state now stores its parser instead of just the grammar of the parser so that we can get to the initial state and the target of the parser from a given state. Added functions for analysing parse stack. Date: Wed Mar 2 06:21:08 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.31 climacs/syntax.lisp:1.32 --- climacs/syntax.lisp:1.31 Wed Mar 2 05:07:26 2005 +++ climacs/syntax.lisp Wed Mar 2 06:21:07 2005 @@ -135,10 +135,9 @@ ;;; parser (defclass parser () - ((grammar :initarg :grammar) + ((grammar :initarg :grammar :reader parser-grammar) (target :initarg :target :reader target) - (initial-state :reader initial-state) - (lexer :initarg :lexer))) + (initial-state :reader initial-state))) (defclass rule-item () ()) @@ -202,7 +201,7 @@ nil) (defclass parser-state () - ((grammar :initarg :grammar :reader state-grammar) + ((parser :initarg :parser :reader parser) (incomplete-items :initform (make-hash-table :test #'eq) :reader incomplete-items) (parse-trees :initform (make-hash-table :test #'eq) @@ -245,7 +244,7 @@ nil) (t (push item (gethash orig-state (incomplete-items to-state))) - (loop for rule in (rules (state-grammar to-state)) + (loop for rule in (rules (parser-grammar (parser to-state))) do (when (let ((sym1 (aref (symbols (rule item)) (dot-position item))) (sym2 (left-hand-side rule))) (or (subtypep sym1 sym2) (subtypep sym2 sym1))) @@ -269,7 +268,7 @@ (defmethod initialize-instance :after ((parser parser) &rest args) (declare (ignore args)) (with-slots (grammar initial-state) parser - (setf initial-state (make-instance 'parser-state :grammar grammar)) + (setf initial-state (make-instance 'parser-state :parser parser)) (loop for rule in (rules grammar) do (when (let ((sym (left-hand-side rule))) (or (subtypep (target parser) sym) @@ -286,12 +285,44 @@ initial-state initial-state))))) (defun advance-parse (parser tokens state) - (with-slots (grammar) parser - (let ((new-state (make-instance 'parser-state :grammar grammar))) - (loop for token in tokens - do (potentially-handle-parse-tree token state new-state)) - new-state))) - -(defclass lexer () ()) - -(defgeneric lex (lexer)) + (let ((new-state (make-instance 'parser-state :parser parser))) + (loop for token in tokens + do (potentially-handle-parse-tree token state new-state)) + new-state)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Code for analysing parse stack + +(defun parse-stack-top (state) + "given a parse state, return a list of all incomplete items that did +not originate in that state, or if no such items exist, a list of all +parse trees of state that originated in the initial state." + (let ((items '())) + (map-over-incomplete-items + state + (lambda (key item) + (unless (eq key state) + (push item items)))) + (unless items + (loop with target = (target (parser state)) + for parse-tree in (gethash (initial-state (parser state)) + (parse-trees state)) + when (subtypep parse-tree target) + do (push parse-tree items))) + items)) + +(defun parse-stack-next (incomplete-item) + "given an incomplete item, return a list of all incomplete items it +could have been predicted from." + (let ((items '()) + (orig-state (orig-state incomplete-item)) + (sym1 (left-hand-side (rule incomplete-item)))) + (map-over-incomplete-items + orig-state + (lambda (key item) + (unless (eq key orig-state) + (when (let ((sym2 (aref (symbols (rule item)) (dot-position item)))) + (or (subtypep sym1 sym2) (subtypep sym2 sym1))) + (push item items))))) + items))

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by rstrandh＠common-lisp.net 02 Mar '05

02 Mar '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv4425 Modified Files: syntax.lisp Log Message: An incomplete item now stores its state of origin. The chain of states of origin will define a "parse stack" that can be exploited by syntax modules and display code. Date: Wed Mar 2 05:07:26 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.30 climacs/syntax.lisp:1.31 --- climacs/syntax.lisp:1.30 Sat Feb 5 07:49:53 2005 +++ climacs/syntax.lisp Wed Mar 2 05:07:26 2005 @@ -143,7 +143,8 @@ (defclass rule-item () ()) (defclass incomplete-item (rule-item) - ((rule :initarg :rule :reader rule) + ((orig-state :initarg :orig-state :reader orig-state) + (rule :initarg :rule :reader rule) (dot-position :initarg :dot-position :reader dot-position) (parse-trees :initarg :parse-trees :reader parse-trees) (suffix :initarg :suffix :reader suffix))) @@ -171,6 +172,7 @@ nil) ((functionp remaining) (make-instance 'incomplete-item + :orig-state (orig-state prev-item) :rule (rule prev-item) :dot-position (1+ (dot-position prev-item)) :parse-trees (cons parse-tree (parse-trees prev-item)) @@ -249,6 +251,7 @@ (or (subtypep sym1 sym2) (subtypep sym2 sym1))) (handle-item (if (functionp (right-hand-side rule)) (make-instance 'incomplete-item + :orig-state to-state :rule rule :dot-position 0 :parse-trees '() @@ -273,6 +276,7 @@ (subtypep sym (target parser)))) (handle-item (if (functionp (right-hand-side rule)) (make-instance 'incomplete-item + :orig-state initial-state :rule rule :dot-position 0 :parse-trees '()

1 0

[climacs-cvs] CVS update: climacs/cl-syntax.lisp
by rstrandh＠common-lisp.net 02 Mar '05

02 Mar '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv3501 Modified Files: cl-syntax.lisp Log Message: Whitespace is no longer considered a syntax element, and is skipped over instead. This makes the incremental lexer even faster. Date: Wed Mar 2 04:59:07 2005 Author: rstrandh Index: climacs/cl-syntax.lisp diff -u climacs/cl-syntax.lisp:1.4 climacs/cl-syntax.lisp:1.5 --- climacs/cl-syntax.lisp:1.4 Sun Feb 27 07:23:28 2005 +++ climacs/cl-syntax.lisp Wed Mar 2 04:59:03 2005 @@ -48,9 +48,6 @@ () (:documentation "dummy entry before all the others.")) -(defclass whitespace-entry (terminal-entry) - ()) - (defclass token-entry (terminal-entry) () (:documentation "the syntactic class of tokens.")) @@ -233,12 +230,7 @@ do (fo)) (make-entry 'character-entry)))) (t (make-entry 'error-entry))))) - (t (cond ((whitespacep object) - (loop until (end-of-buffer-p scan) - while (whitespacep (object-after scan)) - do (fo)) - (make-entry 'whitespace-entry)) - ((constituentp object) + (t (cond ((constituentp object) (loop until (end-of-buffer-p scan) while (constituentp (object-after scan)) do (fo)) @@ -271,11 +263,13 @@ 0 (end-offset (element* elements (1- guess-pos)))))) ;; scan - (unless (end-of-buffer-p scan) - (loop with start-mark = nil - until (if (end-of-buffer-p high-mark) - (end-of-buffer-p scan) - (mark> scan high-mark)) - do (setf start-mark (clone-mark scan)) - (insert* elements guess-pos (next-entry scan)) - (incf guess-pos))))))) + (loop with start-mark = nil + do (loop until (end-of-buffer-p scan) + while (whitespacep (object-after scan)) + do (forward-object scan)) + until (if (end-of-buffer-p high-mark) + (end-of-buffer-p scan) + (mark> scan high-mark)) + do (setf start-mark (clone-mark scan)) + (insert* elements guess-pos (next-entry scan)) + (incf guess-pos))))))

1 0

[climacs-cvs] CVS update: climacs/Doc/climacs-internals.texi
by rstrandh＠common-lisp.net 01 Mar '05

01 Mar '05

Update of /project/climacs/cvsroot/climacs/Doc In directory common-lisp.net:/tmp/cvs-serv24900/Doc Modified Files: climacs-internals.texi Log Message: Added section on incremental parsing. Date: Tue Mar 1 05:56:29 2005 Author: rstrandh Index: climacs/Doc/climacs-internals.texi diff -u climacs/Doc/climacs-internals.texi:1.14 climacs/Doc/climacs-internals.texi:1.15 --- climacs/Doc/climacs-internals.texi:1.14 Sun Feb 27 20:13:47 2005 +++ climacs/Doc/climacs-internals.texi Tue Mar 1 05:56:27 2005 @@ -716,6 +716,91 @@ present, and it should be exploitable by several, potentially totally different, display units. +@section Incremental parsing framework + +@subsection Earley parser + +Climacs contains an incremental parser that uses the Earley +algorithm. This algorithm accepts the full set of context-free +grammars, allowing greater freedom for the developer to define natural +grammars without having to think about restrictions such as LL(k) or +LALR(k). + +Beware, though, that the Earley algorithm can be quite inefficient if +the grammar is sufficiently complicated, in particular if the grammar +is ambiguous. + +@subsection Specifying a grammar + +An incremental parser is created from a grammar. + +@deffn {Macro} {grammar} &body rules + +Create a grammar object from a set of rules +@end deffn + +@deffn {Rule} {} symbol -> (&rest arguments) &optional body + +Each rule is a list of this form. +@end deffn + +@noindent +Here @var{symbol} is the target symbol of the rule, and should be the name of +a CLOS class. + +@deffn {Rule argument} {} (var type test) + +The most general form of a rule argument. +@end deffn + +@noindent +Here @var{var} is the name of a lexical variable. The scope of the +variable contains the test, all the following arguments and the body +of the rule. The @var{type} is a Common Lisp type specification. The +rule applies only of the @var{type} of the object contain in var is of +that type. The @var{test} contains arbitrary Common Lisp code for +additional checks as to the applicability of the rule. + +@deffn {Rule argument} {} (var type) + +Abbreviated form of a rule argument. +@end deffn + +@noindent +Here, @var{type} must be a symbol typically the name of a CLOS class. +This form is an abbreviation for @code{(@var{var} @var{type} t)}. + +@deffn {Rule argument} {} (var test) + +Abbreviated form of a rule argument. +@end deffn + +@noindent +Here, @var{test} must not be a symbol. This form is an abbreviation +of @code{(@var{var} @var{var} @var{test})}, i.e., the name of the +variable is also the name of a type, typically a CLOS class. + +@deffn {Rule argument} {} var + +Abbreviated form of a rule argument. +@end deffn + +@noindent +This form is an abbreviation of @code{(@var{var} @var{var} t)}. + +The @var{body} of a rule, if present, contains an expression that should +have an instance (not necessarily direct) of the class named by the +symbol (the left-hand-side) of the rule. It is important that this +restriction be respected, since the Earley algorithm will not work +otherwise. + +If the @var{body} is absent, it is the same as if a body of the form +@code{(make-instance '@var{symbol})} had been given. + +The body can also be a sequence of forms, the first one of which +must be a symbol. These forms typically contain initargs, and will be +passed as additional arguments to @code{(make-instance '@var{symbol})}. + @section Common Lisp syntax Technically, comments and such are not expressions, but it is OK for

1 0

[climacs-cvs] CVS update: climacs/climacs.asd
by rstrandh＠common-lisp.net 01 Mar '05

01 Mar '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv24900 Modified Files: climacs.asd Log Message: Added section on incremental parsing. Date: Tue Mar 1 05:56:09 2005 Author: rstrandh Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.20 climacs/climacs.asd:1.21 --- climacs/climacs.asd:1.20 Sun Feb 27 19:52:01 2005 +++ climacs/climacs.asd Tue Mar 1 05:56:06 2005 @@ -42,13 +42,7 @@ :defaults *climacs-directory*)) collect `(:file ,(pathname-name p) :pathname ,p)))))) -(climacs-defsystem (:climacs :depends-on (:clim-clx)) - "Flexichain/skiplist-package" - "Flexichain/skiplist" - "Flexichain/flexichain-package" - "Flexichain/utilities" - "Flexichain/flexichain" - "Flexichain/flexicursor" +(climacs-defsystem (:climacs :depends-on (:clim-clx :flexichain)) "Persistent/binseq-package" "Persistent/binseq" "Persistent/obinseq"

1 0