climacs-cvs

climacs-cvs@common-lisp.net

847 discussions

[climacs-cvs] CVS update: climacs/prolog-syntax.lisp
by crhodes＠common-lisp.net 17 Apr '05

17 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv23440 Modified Files: prolog-syntax.lisp Log Message: Deal with #\Tabs a bit better. * although ISO doesn't mandate it, treat a Tab as whitespace, because let's face it, it's pretty useless not to; * deal with #\Tab also in lexemes (necessary whether or not Tab is whitespace in Prolog syntax, where lexemes can contain whitespace characters); Highlight "" char-code-lists in green Date: Sun Apr 17 17:44:40 2005 Author: crhodes Index: climacs/prolog-syntax.lisp diff -u climacs/prolog-syntax.lisp:1.16 climacs/prolog-syntax.lisp:1.17 --- climacs/prolog-syntax.lisp:1.16 Tue Apr 12 23:48:19 2005 +++ climacs/prolog-syntax.lisp Sun Apr 17 17:44:39 2005 @@ -177,7 +177,7 @@ ((eql object #\") (fo) (go CHAR-CODE-LIST)) ((eql object #\() (if (or (beginning-of-buffer-p scan) - (not (member (object-before scan) '(#\Space #\Newline)))) + (not (member (object-before scan) '(#\Space #\Tab #\Newline)))) (progn (fo) (return (make-instance 'open-ct-lexeme))) (progn (fo) (return (make-instance 'open-lexeme))))) ((eql object #\)) (fo) (return (make-instance 'close-lexeme))) @@ -277,7 +277,8 @@ do (fo)) (if (end-of-buffer-p scan) (return (make-instance 'error-lexeme)) - (return (make-instance 'char-code-list-lexeme))))))))) + (progn (fo) + (return (make-instance 'char-code-list-lexeme)))))))))) ;;; parser @@ -438,6 +439,10 @@ (display-parse-tree ({ entity) syntax pane) (display-parse-tree (term entity) syntax pane) (display-parse-tree (} entity) syntax pane)) +(defmethod display-parse-tree + ((entity char-code-list-compound-term) (syntax prolog-syntax) pane) + (with-drawing-options (pane :ink (make-rgb-color 0.0 0.6 0.0)) + (display-parse-tree (ccl entity) syntax pane))) (defclass atom (prolog-nonterminal) ((value :initarg :value :accessor value))) @@ -902,7 +907,7 @@ (incf valid-parse)))))) (defmethod inter-lexeme-object-p ((lexer prolog-lexer) object) - (member object '(#\Space #\Newline))) + (member object '(#\Space #\Newline #\Tab))) (defmethod update-syntax (buffer (syntax prolog-syntax)) (with-slots (lexer valid-parse) syntax @@ -983,8 +988,9 @@ (loop (when (>= start end) (return)) - (let ((nl (position #\Newline string - :start start :end end))) + (let ((nl (position-if + (lambda (x) (member x '(#\Tab #\Newline))) + string :start start :end end))) (unless nl (present (subseq string start end) 'string :stream pane) (return)) @@ -1055,7 +1061,11 @@ (let* ((cursor-line (number-of-lines-in-region top (point pane))) (height (text-style-height (medium-text-style pane) pane)) (cursor-y (+ (* cursor-line (+ height (stream-vertical-spacing pane))))) - (cursor-column (column-number (point pane))) + (cursor-column + ;; FIXME: surely this should be more abstracted? + (buffer-display-column + (buffer (point pane)) (offset (point pane)) + (round (tab-width pane) (space-width pane)))) (cursor-x (* cursor-column (text-style-width (medium-text-style pane) pane)))) (updating-output (pane :unique-id -1) (draw-rectangle* pane

1 0

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

16 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv8984 Modified Files: syntax.lisp Log Message: More performance improvements. The most common case of adding an item to a parser state was during prediction when an item was derived from a rule. We now use a bitvector in each state that indicates what rules have been used in prediction. This avoids scanning the items in the state for existing item-equal states. Date: Sat Apr 16 07:20:29 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.46 climacs/syntax.lisp:1.47 --- climacs/syntax.lisp:1.46 Fri Apr 15 08:12:27 2005 +++ climacs/syntax.lisp Sat Apr 16 07:20:29 2005 @@ -204,11 +204,13 @@ (defclass rule () ((left-hand-side :initarg :left-hand-side :reader left-hand-side) (right-hand-side :initarg :right-hand-side :reader right-hand-side) - (symbols :initarg :symbols :reader symbols))) + (symbols :initarg :symbols :reader symbols) + (number))) (defclass grammar () ((rules :initform nil :accessor rules) - (hash :initform (make-hash-table) :accessor hash))) + (hash :initform (make-hash-table) :accessor hash) + (number-of-rules :initform 0))) (defmacro grammar-rule ((left-hand-side arrow arglist &body body)) (declare (ignore arrow)) @@ -259,6 +261,8 @@ (defmethod add-rule (rule (grammar grammar)) (push rule (rules grammar)) + (setf (slot-value rule 'number) (slot-value grammar 'number-of-rules)) + (incf (slot-value grammar 'number-of-rules)) (clrhash (hash grammar)) (let (rhs-symbols) (dolist (rule (rules grammar)) @@ -348,7 +352,17 @@ :reader incomplete-items) (parse-trees :initform (make-hash-table :test #'eq) :reader parse-trees) - (last-nonempty-state :initarg :last-nonempty-state :accessor last-nonempty-state))) + (last-nonempty-state :initarg :last-nonempty-state :accessor last-nonempty-state) + (predicted-rules))) + +(defmethod initialize-instance :after ((state parser-state) &rest args) + (declare (ignore args)) + (with-slots (predicted-rules) state + (setf predicted-rules + (make-array (slot-value (parser-grammar (parser state)) + 'number-of-rules) + :element-type 'bit + :initial-element 0)))) (defun map-over-incomplete-items (state fun) (maphash (lambda (key incomplete-items) @@ -385,13 +399,17 @@ (dolist (rule (gethash (aref (symbols (rule item)) (dot-position item)) (hash (parser-grammar (parser to-state))))) (if (functionp (right-hand-side rule)) - (handle-incomplete-item (make-instance 'incomplete-item - :orig-state to-state - :predicted-from item - :rule rule - :dot-position 0 - :suffix (right-hand-side rule)) - to-state to-state) + (let ((predicted-rules (slot-value to-state 'predicted-rules)) + (rule-number (slot-value rule 'number))) + (when (zerop (aref predicted-rules rule-number)) + (setf (aref predicted-rules rule-number) 1) + (handle-incomplete-item (make-instance 'incomplete-item + :orig-state to-state + :predicted-from item + :rule rule + :dot-position 0 + :suffix (right-hand-side rule)) + to-state to-state))) (potentially-handle-parse-tree (right-hand-side rule) to-state to-state))) (loop for parse-tree in (gethash to-state (parse-trees to-state)) do (derive-and-handle-item item parse-tree to-state to-state)))))

1 0

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

15 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv25598 Modified Files: syntax.lisp Log Message: Removed complete-item class which is no longer used. Date: Fri Apr 15 08:12:27 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.45 climacs/syntax.lisp:1.46 --- climacs/syntax.lisp:1.45 Fri Apr 15 07:48:02 2005 +++ climacs/syntax.lisp Fri Apr 15 08:12:27 2005 @@ -299,12 +299,6 @@ do (format stream " ~a" (aref (symbols (rule item)) i))) (format stream "]")) -(defclass complete-item (rule-item) - ((parse-tree :initarg :parse-tree :reader parse-tree))) - -(defmethod print-object ((item complete-item) stream) - (format stream "[~a]" (parse-tree item))) - (defun derive-and-handle-item (prev-item parse-tree orig-state to-state) (let ((remaining (funcall (suffix prev-item) parse-tree))) (cond ((null remaining)

1 0

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

15 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv24216 Modified Files: syntax.lisp Log Message: More performance improvements: Renamed handle-item so that it is now called handle-incomplete-item, because it is never called with a complete item. Made handle-incomplete-item an ordinary function to avoid generic function dispatch. Renamed derive-item so that it is now called derive-and-handle-item because it now both derives and handles the item. Date: Fri Apr 15 07:48:02 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.44 climacs/syntax.lisp:1.45 --- climacs/syntax.lisp:1.44 Fri Apr 15 07:22:58 2005 +++ climacs/syntax.lisp Fri Apr 15 07:48:02 2005 @@ -305,18 +305,19 @@ (defmethod print-object ((item complete-item) stream) (format stream "[~a]" (parse-tree item))) -(defun derive-item (prev-item parse-tree) +(defun derive-and-handle-item (prev-item parse-tree orig-state to-state) (let ((remaining (funcall (suffix prev-item) parse-tree))) (cond ((null remaining) nil) ((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)) - :suffix remaining)) + (handle-incomplete-item (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)) + :suffix remaining) + orig-state to-state)) (t (let* ((parse-trees (cons parse-tree (parse-trees prev-item))) (start (find-if-not #'null parse-trees @@ -326,9 +327,7 @@ (when start (setf start-mark (start-mark start) size (- (end-offset end) (start-offset start)))) - (make-instance 'complete-item - :parse-tree remaining - :parse-trees parse-trees))))))) + (potentially-handle-parse-tree remaining orig-state to-state))))))) (defun item-equal (item1 item2) (declare (optimize speed)) @@ -363,16 +362,12 @@ do (funcall fun key incomplete-item))) (incomplete-items state))) -(defgeneric handle-item (item orig-state to-state)) - (defun potentially-handle-parse-tree (parse-tree from-state to-state) (let ((parse-trees (parse-trees to-state))) (flet ((handle-parse-tree () (map-over-incomplete-items from-state (lambda (orig-state incomplete-item) - (let ((new-item (derive-item incomplete-item parse-tree))) - (when new-item - (handle-item new-item orig-state to-state))))))) + (derive-and-handle-item incomplete-item parse-tree orig-state to-state))))) (cond ((find parse-tree (gethash from-state parse-trees) :test #'parse-tree-better) (setf (gethash from-state parse-trees) @@ -386,7 +381,7 @@ (t (push parse-tree (gethash from-state parse-trees)) (handle-parse-tree)))))) -(defmethod handle-item ((item incomplete-item) orig-state to-state) +(defun handle-incomplete-item (item orig-state to-state) (declare (optimize speed)) (cond ((find item (the list (gethash orig-state (incomplete-items to-state))) :test #'item-equal) @@ -396,21 +391,17 @@ (dolist (rule (gethash (aref (symbols (rule item)) (dot-position item)) (hash (parser-grammar (parser to-state))))) (if (functionp (right-hand-side rule)) - (handle-item (make-instance 'incomplete-item - :orig-state to-state - :predicted-from item - :rule rule - :dot-position 0 - :suffix (right-hand-side rule)) - to-state to-state) + (handle-incomplete-item (make-instance 'incomplete-item + :orig-state to-state + :predicted-from item + :rule rule + :dot-position 0 + :suffix (right-hand-side rule)) + to-state to-state) (potentially-handle-parse-tree (right-hand-side rule) to-state to-state))) (loop for parse-tree in (gethash to-state (parse-trees to-state)) - do (let ((new-item (derive-item item parse-tree))) - (when new-item (handle-item new-item to-state to-state))))))) + do (derive-and-handle-item item parse-tree to-state to-state))))) -(defmethod handle-item ((item complete-item) orig-state to-state) - (potentially-handle-parse-tree (parse-tree item) orig-state to-state)) - (defmethod initialize-instance :after ((parser parser) &rest args) (declare (ignore args)) (with-slots (grammar initial-state) parser @@ -421,13 +412,13 @@ (or (subtypep (target parser) sym) (subtypep sym (target parser)))) (if (functionp (right-hand-side rule)) - (handle-item (make-instance 'incomplete-item - :orig-state initial-state - :predicted-from nil - :rule rule - :dot-position 0 - :suffix (right-hand-side rule)) - initial-state initial-state) + (handle-incomplete-item (make-instance 'incomplete-item + :orig-state initial-state + :predicted-from nil + :rule rule + :dot-position 0 + :suffix (right-hand-side rule)) + initial-state initial-state) (potentially-handle-parse-tree (right-hand-side rule) initial-state initial-state))))))

1 0

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

15 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22978 Modified Files: syntax.lisp Log Message: Avoid some more generic function dispatch by calling potentially-handle-parse-tree directly when we know that it is a complete item. Also avoid creating the complete item, thus cutting down on consing. Date: Fri Apr 15 07:22:59 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.43 climacs/syntax.lisp:1.44 --- climacs/syntax.lisp:1.43 Fri Apr 15 07:02:53 2005 +++ climacs/syntax.lisp Fri Apr 15 07:22:58 2005 @@ -305,9 +305,7 @@ (defmethod print-object ((item complete-item) stream) (format stream "[~a]" (parse-tree item))) -(defgeneric derive-item (prev-item parse-tree)) - -(defmethod derive-item ((prev-item incomplete-item) parse-tree) +(defun derive-item (prev-item parse-tree) (let ((remaining (funcall (suffix prev-item) parse-tree))) (cond ((null remaining) nil) @@ -397,16 +395,15 @@ (push item (gethash orig-state (incomplete-items to-state))) (dolist (rule (gethash (aref (symbols (rule item)) (dot-position item)) (hash (parser-grammar (parser to-state))))) - (handle-item (if (functionp (right-hand-side rule)) - (make-instance 'incomplete-item - :orig-state to-state - :predicted-from item - :rule rule - :dot-position 0 - :suffix (right-hand-side rule)) - (make-instance 'complete-item - :parse-tree (right-hand-side rule))) - to-state to-state)) + (if (functionp (right-hand-side rule)) + (handle-item (make-instance 'incomplete-item + :orig-state to-state + :predicted-from item + :rule rule + :dot-position 0 + :suffix (right-hand-side rule)) + to-state to-state) + (potentially-handle-parse-tree (right-hand-side rule) to-state to-state))) (loop for parse-tree in (gethash to-state (parse-trees to-state)) do (let ((new-item (derive-item item parse-tree))) (when new-item (handle-item new-item to-state to-state))))))) @@ -423,16 +420,16 @@ do (when (let ((sym (left-hand-side rule))) (or (subtypep (target parser) sym) (subtypep sym (target parser)))) - (handle-item (if (functionp (right-hand-side rule)) - (make-instance 'incomplete-item + (if (functionp (right-hand-side rule)) + (handle-item (make-instance 'incomplete-item :orig-state initial-state :predicted-from nil :rule rule :dot-position 0 :suffix (right-hand-side rule)) - (make-instance 'complete-item - :parse-tree (right-hand-side rule))) - initial-state initial-state))))) + initial-state initial-state) + (potentially-handle-parse-tree + (right-hand-side rule) initial-state initial-state)))))) (defun state-contains-target-p (state) (loop with target = (target (parser state))

1 0

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

15 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv22111 Modified Files: syntax.lisp Log Message: Performance improvement of the Earley parser. handle-item is no longer called on nil items which represented the vast majority of calls. Date: Fri Apr 15 07:02:53 2005 Author: rstrandh Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.42 climacs/syntax.lisp:1.43 --- climacs/syntax.lisp:1.42 Thu Apr 14 10:13:18 2005 +++ climacs/syntax.lisp Fri Apr 15 07:02:53 2005 @@ -372,8 +372,9 @@ (flet ((handle-parse-tree () (map-over-incomplete-items from-state (lambda (orig-state incomplete-item) - (handle-item (derive-item incomplete-item parse-tree) - orig-state to-state))))) + (let ((new-item (derive-item incomplete-item parse-tree))) + (when new-item + (handle-item new-item orig-state to-state))))))) (cond ((find parse-tree (gethash from-state parse-trees) :test #'parse-tree-better) (setf (gethash from-state parse-trees) @@ -387,9 +388,6 @@ (t (push parse-tree (gethash from-state parse-trees)) (handle-parse-tree)))))) -(defmethod handle-item ((item (eql nil)) orig-state to-state) - nil) - (defmethod handle-item ((item incomplete-item) orig-state to-state) (declare (optimize speed)) (cond ((find item (the list (gethash orig-state (incomplete-items to-state))) @@ -410,8 +408,8 @@ :parse-tree (right-hand-side rule))) to-state to-state)) (loop for parse-tree in (gethash to-state (parse-trees to-state)) - do (handle-item (derive-item item parse-tree) - to-state to-state))))) + do (let ((new-item (derive-item item parse-tree))) + (when new-item (handle-item new-item to-state to-state))))))) (defmethod handle-item ((item complete-item) orig-state to-state) (potentially-handle-parse-tree (parse-tree item) orig-state to-state))

1 0

[climacs-cvs] CVS update: climacs/syntax.lisp
by crhodes＠common-lisp.net 14 Apr '05

14 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv12616 Modified Files: syntax.lisp Log Message: slight improvement in speed to syntax.lisp (though not enough): Cache in the grammar which rules are applicable to which symbols. Make ITEM-EQUAL a regular function. A couple of folorn (optimize speed)s and type declarations, which don't actually help all that much. Date: Thu Apr 14 10:13:18 2005 Author: crhodes Index: climacs/syntax.lisp diff -u climacs/syntax.lisp:1.41 climacs/syntax.lisp:1.42 --- climacs/syntax.lisp:1.41 Fri Mar 18 08:49:17 2005 +++ climacs/syntax.lisp Thu Apr 14 10:13:18 2005 @@ -207,7 +207,8 @@ (symbols :initarg :symbols :reader symbols))) (defclass grammar () - ((rules :initarg :rules :accessor rules))) + ((rules :initform nil :accessor rules) + (hash :initform (make-hash-table) :accessor hash))) (defmacro grammar-rule ((left-hand-side arrow arglist &body body)) (declare (ignore arrow)) @@ -245,14 +246,29 @@ (defmacro grammar (&body body) - `(make-instance 'grammar - :rules (list ,@(loop for rule in body - collect `(grammar-rule ,rule))))) + (let ((rule (gensym "RULE")) + (rules (gensym "RULES")) + (result (gensym "RESULT"))) + `(let* ((,rules (list ,@(loop for rule in body + collect `(grammar-rule ,rule)))) + (,result (make-instance 'grammar))) + (dolist (,rule ,rules ,result) + (add-rule ,rule ,result))))) (defgeneric add-rule (rule grammar)) (defmethod add-rule (rule (grammar grammar)) - (push rule (rules grammar))) + (push rule (rules grammar)) + (clrhash (hash grammar)) + (let (rhs-symbols) + (dolist (rule (rules grammar)) + (setf rhs-symbols (union rhs-symbols (coerce (symbols rule) 'list)))) + (dolist (rule (rules grammar)) + (let ((lhs-symbol (left-hand-side rule))) + (dolist (rhs-symbol rhs-symbols) + (when (or (subtypep lhs-symbol rhs-symbol) + (subtypep rhs-symbol lhs-symbol)) + (pushnew rule (gethash rhs-symbol (hash grammar))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -316,19 +332,18 @@ :parse-tree remaining :parse-trees parse-trees))))))) -(defgeneric item-equal (item1 item2)) - -(defgeneric parse-tree-equal (tree1 tree2)) - -(defmethod item-equal ((item1 rule-item) (item2 rule-item)) - nil) - -(defmethod item-equal ((item1 incomplete-item) (item2 incomplete-item)) +(defun item-equal (item1 item2) + (declare (optimize speed)) (and (eq (rule item1) (rule item2)) - (eq (length (parse-trees item1)) (length (parse-trees item2))) - (every #'parse-tree-equal (parse-trees item1) (parse-trees item2)))) + (do ((trees1 (parse-trees item1) (cdr trees1)) + (trees2 (parse-trees item2) (cdr trees2))) + ((and (null trees1) (null trees2)) t) + (when (or (null trees1) (null trees2)) + (return nil)) + (when (not (parse-tree-equal (car trees1) (car trees2))) + (return nil))))) -(defmethod parse-tree-equal (tree1 tree2) +(defun parse-tree-equal (tree1 tree2) (eq (class-of tree1) (class-of tree2))) (defgeneric parse-tree-better (tree1 tree2)) @@ -376,25 +391,24 @@ nil) (defmethod handle-item ((item incomplete-item) orig-state to-state) - (cond ((find item (gethash orig-state (incomplete-items to-state)) + (declare (optimize speed)) + (cond ((find item (the list (gethash orig-state (incomplete-items to-state))) :test #'item-equal) nil) (t (push item (gethash orig-state (incomplete-items 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))) - (handle-item (if (functionp (right-hand-side rule)) - (make-instance 'incomplete-item - :orig-state to-state - :predicted-from item - :rule rule - :dot-position 0 - :suffix (right-hand-side rule)) - (make-instance 'complete-item - :parse-tree (right-hand-side rule))) - to-state to-state))) + (dolist (rule (gethash (aref (symbols (rule item)) (dot-position item)) + (hash (parser-grammar (parser to-state))))) + (handle-item (if (functionp (right-hand-side rule)) + (make-instance 'incomplete-item + :orig-state to-state + :predicted-from item + :rule rule + :dot-position 0 + :suffix (right-hand-side rule)) + (make-instance 'complete-item + :parse-tree (right-hand-side rule))) + to-state to-state)) (loop for parse-tree in (gethash to-state (parse-trees to-state)) do (handle-item (derive-item item parse-tree) to-state to-state)))))

1 0

[climacs-cvs] CVS update: climacs/prolog-syntax.lisp
by crhodes＠common-lisp.net 12 Apr '05

12 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv5047 Modified Files: prolog-syntax.lisp Log Message: make variable-terms show up in yellow. Band-aid for functor/canonical-name business with lists, curly lists and char-code-lists. Date: Tue Apr 12 23:48:19 2005 Author: crhodes Index: climacs/prolog-syntax.lisp diff -u climacs/prolog-syntax.lisp:1.15 climacs/prolog-syntax.lisp:1.16 --- climacs/prolog-syntax.lisp:1.15 Wed Apr 6 19:00:20 2005 +++ climacs/prolog-syntax.lisp Tue Apr 12 23:48:19 2005 @@ -400,7 +400,8 @@ (display-parse-tree (value entity) syntax pane)) (defmethod display-parse-tree ((entity variable-term) (syntax prolog-syntax) pane) - (display-parse-tree (name entity) syntax pane)) + (with-drawing-options (pane :ink (make-rgb-color 0.7 0.7 0.0)) + (display-parse-tree (name entity) syntax pane))) (defmethod display-parse-tree ((entity functional-compound-term) (syntax prolog-syntax) pane) (with-drawing-options (pane :ink (make-rgb-color 0.9 0 0.9)) @@ -440,6 +441,10 @@ (defclass atom (prolog-nonterminal) ((value :initarg :value :accessor value))) +(defgeneric canonical-name (thing) + ;; FIXME: is this actually necessary? There is confusion over the + ;; FUNCTOR of lists, curly lists and char-code lists. + (:method ((thing string)) thing)) (defmethod canonical-name ((thing atom)) (canonical-name (value thing))) (defmethod canonical-name ((thing name))

1 0

[climacs-cvs] CVS update: climacs/buffer-en.html climacs/buffer.html climacs/html-syntax.lisp
by rstrandh＠common-lisp.net 11 Apr '05

11 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv24885 Modified Files: buffer-en.html buffer.html html-syntax.lisp Log Message: Modified html lexer to return end-tag-start when it sees `</', and start-tag-start when it sees `<' followed by something other than slash. Slash is no longer a specific lexeme, just a delimiter like the others. Date: Mon Apr 11 08:27:13 2005 Author: rstrandh Index: climacs/buffer-en.html diff -u climacs/buffer-en.html:1.3 climacs/buffer-en.html:1.4 --- climacs/buffer-en.html:1.3 Thu Dec 16 07:29:01 2004 +++ climacs/buffer-en.html Mon Apr 11 08:27:12 2005 @@ -1,8 +1,9 @@ -<HTML><TITLE> Second semester master </TITLE> +<HTML lang=en> +<head><TITLE> Second semester master </TITLE></head> <BODY> -<a "href="buffer.html">Version française</a> +<p><a href="buffer.html">Version française</a></p> <h1> Programming project 2004 - 2005 </h1> -<br><hr><br> +<hr> <ul> <li> <h3> Title: </h3> @@ -33,9 +34,9 @@ ISO-latin-1, while still allowing all Unicode characters to be present, the physical representation consists of a 2-3-tree (which might be supplied) of lines of text, each line being represented by a -flexichain of characters (the implementation of which will be supplied).<p> +flexichain of characters (the implementation of which will be supplied).</p> + -<br> <li><h3> Required hardware and software:</h3> <p>A PC with GNU/Linux. A recent version (at least 0.8.17) of the SBCL system (a free implementation of Common Lisp), GNU Emacs, SLIME @@ -43,7 +44,7 @@ <br> <li> <h3> Bibliographic- and web references: :</h3> -<P> + <ul> <li><a href="climacs-en.html">Description of the Climacs project</a> <li><a href="buffer.text">Description of the "buffer" protocol</a></li> @@ -57,7 +58,7 @@ <li><a href="http://www.finseth.com/craft/">The Craft of Text Editing by Craig A. Finseth</a></li> </ul> -</p> + </ul> </BODY></HTML> Index: climacs/buffer.html diff -u climacs/buffer.html:1.4 climacs/buffer.html:1.5 --- climacs/buffer.html:1.4 Mon Apr 11 08:12:22 2005 +++ climacs/buffer.html Mon Apr 11 08:27:12 2005 @@ -1,4 +1,4 @@ -<HTML><HEAD><TITLE> Master 2ème semestre</TITLE></HEAD> +<HTML lang=fr><HEAD><TITLE> Master 2ème semestre</TITLE></HEAD> <BODY> <p><a href="buffer-en.html">English version</a></p> <h1> Projets de Programmation 2004 - 2005 </h1> @@ -44,7 +44,7 @@ <br> <li> <h3> Références bibliographiques et http: :</h3> -<P> + <ul> <li><a href="climacs.html">Description du projet Climacs</a> <li><a href="buffer.text">Description du protocole "buffer"</a></li> @@ -58,7 +58,7 @@ <li><a href="http://www.finseth.com/craft/">The Craft of Text Editing by Craig A. Finseth</a></li> </ul> -</p> + </ul> </BODY></HTML> Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.28 climacs/html-syntax.lisp:1.29 --- climacs/html-syntax.lisp:1.28 Mon Apr 11 08:12:22 2005 +++ climacs/html-syntax.lisp Mon Apr 11 08:27:13 2005 @@ -48,9 +48,9 @@ ((state :initarg :state))) (defclass start-lexeme (html-lexeme) ()) -(defclass tag-start (html-lexeme) ()) +(defclass start-tag-start (html-lexeme) ()) +(defclass end-tag-start (html-lexeme) ()) (defclass tag-end (html-lexeme) ()) -(defclass slash (html-lexeme) ()) (defclass word (html-lexeme) ()) (defclass delimiter (html-lexeme) ()) @@ -60,9 +60,12 @@ (flet ((fo () (forward-object scan))) (let ((object (object-after scan))) (case object - (#\< (fo) (make-instance 'tag-start)) + (#\< (fo) (cond ((or (end-of-buffer-p scan) + (not (eql (object-after scan) #\/))) + (make-instance 'start-tag-start)) + (t (fo) + (make-instance 'end-tag-start)))) (#\> (fo) (make-instance 'tag-end)) - (#\/ (fo) (make-instance 'slash)) (t (cond ((alphanumericp object) (loop until (end-of-buffer-p scan) while (alphanumericp (object-after scan)) @@ -94,8 +97,8 @@ (defclass ,name (html-tag) ()) (add-html-rule - (,name -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) + (,name -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word ,string))) (tag-end (= (end-offset word) (start-offset tag-end)))))))) @@ -104,9 +107,8 @@ (defclass ,name (html-tag) ()) (add-html-rule - (,name -> (tag-start - (slash (= (end-offset tag-start) (start-offset slash))) - (word (and (= (end-offset slash) (start-offset word)) + (,name -> (end-tag-start + (word (and (= (end-offset end-tag-start) (start-offset word)) (word-is word ,string))) (tag-end (= (end-offset word) (start-offset tag-end)))))))) @@ -383,12 +385,12 @@ (attributes :initarg :attributes) (end :initarg :end))) -(add-html-rule (<a> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) +(add-html-rule (<a> -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word "a"))) <a>-attributes tag-end) - :start tag-start :name word :attributes <a>-attributes :end tag-end)) + :start start-tag-start :name word :attributes <a>-attributes :end tag-end)) (defmethod display-parse-tree ((entity <a>) (syntax html-syntax) pane) (with-slots (start name attributes end) entity @@ -435,12 +437,12 @@ (attributes :initarg :attributes) (end :initarg :end))) -(add-html-rule (<p> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) +(add-html-rule (<p> -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word "p"))) common-attributes tag-end) - :start tag-start :name word :attributes common-attributes :end tag-end)) + :start start-tag-start :name word :attributes common-attributes :end tag-end)) (defmethod display-parse-tree ((entity <p>) (syntax html-syntax) pane) (with-slots (start name attributes end) entity @@ -473,12 +475,12 @@ (attributes :initarg :attributes) (end :initarg :end))) -(add-html-rule (<li> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) +(add-html-rule (<li> -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word "li"))) common-attributes tag-end) - :start tag-start + :start start-tag-start :name word :attributes common-attributes :end tag-end)) @@ -517,12 +519,12 @@ (attributes :initarg :attributes) (end :initarg :end))) -(add-html-rule (<ul> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) +(add-html-rule (<ul> -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word "ul"))) common-attributes tag-end) - :start tag-start + :start start-tag-start :name word :attributes common-attributes :end tag-end)) @@ -628,12 +630,12 @@ (attributes :initarg :attributes) (end :initarg :end))) -(add-html-rule (<html> -> (tag-start - (word (and (= (end-offset tag-start) (start-offset word)) +(add-html-rule (<html> -> (start-tag-start + (word (and (= (end-offset start-tag-start) (start-offset word)) (word-is word "html"))) <html>-attributes tag-end) - :start tag-start :name word :attributes <html>-attributes :end tag-end)) + :start start-tag-start :name word :attributes <html>-attributes :end tag-end)) (defmethod display-parse-tree ((entity <html>) (syntax html-syntax) pane) (with-slots (start name attributes end) entity

1 0

[climacs-cvs] CVS update: climacs/buffer.html climacs/climacs-en.html climacs/html-syntax.lisp
by rstrandh＠common-lisp.net 11 Apr '05

11 Apr '05

Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv24038 Modified Files: buffer.html climacs-en.html html-syntax.lisp Log Message: Defined BR and HR elements and modified some html files accordingly. Date: Mon Apr 11 08:12:22 2005 Author: rstrandh Index: climacs/buffer.html diff -u climacs/buffer.html:1.3 climacs/buffer.html:1.4 --- climacs/buffer.html:1.3 Thu Dec 16 07:29:01 2004 +++ climacs/buffer.html Mon Apr 11 08:12:22 2005 @@ -1,8 +1,8 @@ -<HTML><TITLE> Master 2ème semestre </TITLE> +<HTML><HEAD><TITLE> Master 2ème semestre</TITLE></HEAD> <BODY> -<a href="buffer-en.html">English version</a> +<p><a href="buffer-en.html">English version</a></p> <h1> Projets de Programmation 2004 - 2005 </h1> -<br><hr><br> +<hr> <ul> <li> <h3> Titre du Sujet: </h3> Index: climacs/climacs-en.html diff -u climacs/climacs-en.html:1.4 climacs/climacs-en.html:1.5 --- climacs/climacs-en.html:1.4 Fri Apr 8 16:36:59 2005 +++ climacs/climacs-en.html Mon Apr 11 08:12:22 2005 @@ -1,4 +1,5 @@ -<HTML><HEAD><TITLE>Climacs, a modern version of the Emacs editor</TITLE></HEAD> +<HTML lang=en> +<HEAD><TITLE>Climacs, a modern version of the Emacs editor</TITLE></HEAD> <BODY> <p><a href="climacs.html">Version française.</a></p> @@ -11,33 +12,33 @@ problems today. :</p> <ul> -<li><p>Emacs Lisp is a language that was specially designed in order to +<li>Emacs Lisp is a language that was specially designed in order to implement Emacs. Since the design of GNU Emacs and of Emacs Lisp, Common Lisp has been standardized, and gives both better performance than that of Emacs Lisp (because Emacs Lisp is implemented as an interpreter written in C) and more sophisticated functionalities (macros, CLOS, etc). The natural choice for - implementing Emacs today is thus Common Lisp.</p></li> + implementing Emacs today is thus Common Lisp.</li> -<li><p>GNU Emacs was designed before the existence of the Unicode +<li>GNU Emacs was designed before the existence of the Unicode standard. Unfortunately, the internal representation of a buffer does not allow the representation of all Unicode characters in a compact way. An internal representation allowing both all of Unicode and a compact representation for the ISO-latin-1 subset is - desirable.</p></li> + desirable.</li> -<li><p>Twenty years ago, graphic user interfaces practically did not +<li>Twenty years ago, graphic user interfaces practically did not exist. GNU Emacs was designed for a text-only terminal. Today better modes of interaction exist. In particular, with CLIM (Common LIsp Interface Manager) it is both possible and desirable - to have an interface based on the concept of "presentation types".</p></li> + to have an interface based on the concept of "presentation types".</li> -<li><p>Because of the limited power of computers at the time, GNU Emacs +<li>Because of the limited power of computers at the time, GNU Emacs uses a certain number of approximations in order to analyze the contents of a buffer, in particular when that contents is the text of a program. These approximations are no longer necessary, and with current technology, it is possible to maintain a complete - syntactic analysis of the buffer text. </p></li> + syntactic analysis of the buffer text. </li> </ul> Index: climacs/html-syntax.lisp diff -u climacs/html-syntax.lisp:1.27 climacs/html-syntax.lisp:1.28 --- climacs/html-syntax.lisp:1.27 Mon Apr 11 07:28:51 2005 +++ climacs/html-syntax.lisp Mon Apr 11 08:12:22 2005 @@ -414,6 +414,19 @@ (display-parse-tree items syntax pane)) (display-parse-tree </a> syntax pane))) +;;;;;;;;;;;;;;; br element + +(defclass br-element (inline-element) + ((<br> :initarg :<br>))) + +(define-start-tag <br> "br") + +(add-html-rule (br-element -> (<br>) :<br> <br>)) + +(defmethod display-parse-tree ((entity br-element) (syntax html-syntax) pane) + (with-slots (<br>) entity + (display-parse-tree <br> syntax pane))) + ;;;;;;;;;;;;;;; p element (defclass <p> (html-tag) @@ -538,6 +551,19 @@ (display-parse-tree <ul> syntax pane) (display-parse-tree items syntax pane) (display-parse-tree </ul> syntax pane))) + +;;;;;;;;;;;;;;; hr element + +(defclass hr-element (block-level-element) + ((<hr> :initarg :<hr>))) + +(define-start-tag <hr> "hr") + +(add-html-rule (hr-element -> (<hr>) :<hr> <hr>)) + +(defmethod display-parse-tree ((entity hr-element) (syntax html-syntax) pane) + (with-slots (<hr>) entity + (display-parse-tree <hr> syntax pane))) ;;;;;;;;;;;;;;; body element

1 0

← Newer
1
...
55
56
57
58
59
60
61
...
85
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

climacs-cvs