From 3f9835d998a7f59fef3b7147911c6d669a480382 Mon Sep 17 00:00:00 2001 From: Ludovic Court`es Date: Fri, 24 Aug 2007 17:30:45 +0000 Subject: Added `equal?' for ASTs. * src/guile/skribilo/ast.scm (equal?): New methods, for , and . git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-92 --- src/guile/skribilo/ast.scm | 32 +++++++++++++++++++++++--------- 1 file changed, 23 insertions(+), 9 deletions(-) diff --git a/src/guile/skribilo/ast.scm b/src/guile/skribilo/ast.scm index f515009..930ec60 100644 --- a/src/guile/skribilo/ast.scm +++ b/src/guile/skribilo/ast.scm @@ -173,7 +173,8 @@ (parent :accessor ast-parent :init-keyword :parent :init-value 'unspecified) ;; Its source location. - (loc :init-value #f :init-keyword :loc) + (loc :init-value #f :init-keyword :loc + :getter ast-loc :setter ast-loc-set!) ;; This slot is used as an optimization when resolving an AST: sub-parts of ;; the tree are marked as resolved as soon as they are and don't need to be @@ -182,10 +183,8 @@ (define (ast? obj) (is-a? obj )) -(define (ast-loc obj) (slot-ref obj 'loc)) -(define (ast-loc-set! obj v) (slot-set! obj 'loc v)) -(define (ast-parent n) - (slot-ref n 'parent)) +(define-method (equal? (a ) (b )) + (eq? (ast-parent a) (ast-parent b))) (define (ast->file-location ast) @@ -257,12 +256,19 @@ ;;; ====================================================================== (define-class () (required-options :init-keyword :required-options :init-value '()) - (options :init-keyword :options :init-value '()) + (options :init-keyword :options :init-value '() + :getter node-options) (body :init-keyword :body :init-value #f :getter node-body)) (define (node? obj) (is-a? obj )) -(define (node-options obj) (slot-ref obj 'options)) +(define-method (equal? (a ) (b )) + (and (next-method) + (equal? (slot-ref a 'required-options) + (slot-ref b 'required-options)) + (equal? (node-body a) + (node-body b)))) + (define node-loc ast-loc) (define-method (ast->string (ast )) @@ -296,8 +302,16 @@ (define (markup? obj) (is-a? obj )) -(define (markup-options obj) (slot-ref obj 'options)) -(define markup-body node-body) +(define-method (equal? (a ) (b )) + (and (next-method) + ;; We don't check for equality of `ident' because most markups return + ;; a fresh identifier every time they are called (using `gensym'), + ;; unless an identifier is explicitly specified. + (equal? (markup-class a) (markup-class b)) + (eq? (markup-markup a) (markup-markup b)))) + +(define markup-options node-options) +(define markup-body node-body) (define (markup-body-set! m body) (slot-set! m 'resolved? #f) (slot-set! m 'body body)) -- cgit v1.2.3