/[climacs]/climacs/ttcn3-syntax.lisp
ViewVC logotype

Diff of /climacs/ttcn3-syntax.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by dmurray, Mon Aug 15 23:31:22 2005 UTC revision 1.4 by tmoore, Fri Mar 3 19:38:57 2006 UTC
# Line 21  Line 21 
21  ;;; Boston, MA  02111-1307  USA.  ;;; Boston, MA  02111-1307  USA.
22    
23  (defpackage :climacs-ttcn3-syntax  (defpackage :climacs-ttcn3-syntax
24    (:use :clim-lisp :clim :climacs-buffer :climacs-base    (:use :clim-lisp :clim :clim-extensions :climacs-buffer :climacs-base
25          :climacs-syntax :flexichain :climacs-pane)          :climacs-syntax :flexichain :climacs-pane)
26    (:export))    (:export))
27  (in-package :climacs-ttcn3-syntax)  (in-package :climacs-ttcn3-syntax)
# Line 183  Line 183 
183    (string-equal (coerce (buffer-sequence (buffer word) (start-offset word) (end-offset word)) 'string)    (string-equal (coerce (buffer-sequence (buffer word) (start-offset word) (end-offset word)) 'string)
184                  string))                  string))
185    
186    (eval-when (:compile-toplevel :load-toplevel :execute)
187      (defun sort-definitions (forms)
188        (loop for form in forms
189              for name = (and (consp form) (car form))
190              if (eq name 'defclass)
191              collect form into defclasses
192              else if (eq name 'define-simple-list)
193              collect form into simple-lists
194              else if (eq name 'define-simple-nonempty-list)
195              collect form into nonempty-lists
196              else collect form into others
197              end
198              finally (return `(,@defclasses
199                                ,@simple-lists
200                                ,@nonempty-lists
201                                ,@others)))))
202    
203  (defmacro define-parsing-rules ((grammar entry terminal syntax) &body rules)  (defmacro define-parsing-rules ((grammar entry terminal syntax) &body rules)
204    (let (already-processed-rules)    (let (already-processed-rules)
205      (flet      (flet
# Line 235  Line 252 
252                        entity                        entity
253                      ,@(loop for component in rule-body collect                      ,@(loop for component in rule-body collect
254                             `(display-parse-tree ,component syntax pane))))))                             `(display-parse-tree ,component syntax pane))))))
255               (t (error "Unrecognized rule body ~S for rule ~S~%" rule-body name))))               (t (error "Unrecognized rule body ~S for rule ~S~%" rule-body
256           (shake-up-defclasses (forms)                         name)))))
            (append  
             (remove-if #'(lambda (e)  
                            (and (consp e)  
                                 (not (eq (car e) 'defclass)))) forms)  
             (remove-if #'(lambda (e)  
                            (and (consp e)  
                                 (eq (car e) 'defclass))) forms))))  
257        `(progn        `(progn
258           ,@(shake-up-defclasses           ,@(sort-definitions
259              (loop for rule in rules              (loop for rule in rules
260                 appending (destructuring-bind (=-thingy rule-name &body rule-body)                 appending (destructuring-bind (=-thingy rule-name &body rule-body)
261                               rule                               rule

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5