cocoon-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From ovi...@apache.org
Subject cvs commit: xml-cocoon2/src/scratchpad/schecoon/scheme sitemap.scm
Date Sat, 19 Jan 2002 02:13:20 GMT
ovidiu      02/01/18 18:13:19

  Modified:    src/scratchpad/schecoon/scheme sitemap.scm
  Log:
  Do some optimizations when generating the Scheme code for the
  sitemap. Eliminate as many `let' forms as possible, to speed up the
  compilation process.
  
  Revision  Changes    Path
  1.6       +66 -41    xml-cocoon2/src/scratchpad/schecoon/scheme/sitemap.scm
  
  Index: sitemap.scm
  ===================================================================
  RCS file: /home/cvs/xml-cocoon2/src/scratchpad/schecoon/scheme/sitemap.scm,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- sitemap.scm	19 Jan 2002 01:20:12 -0000	1.5
  +++ sitemap.scm	19 Jan 2002 02:13:19 -0000	1.6
  @@ -61,7 +61,9 @@
   ;; parser to the SXML representation as attributes of the element.
   ;;
   ;; The Scheme code translates the above SXML representation in the
  -;; following code.
  +;; following code. [The code below actually does some optimizations to
  +;; eliminate as many `let' forms as possible. This speeds up a bit the
  +;; compilation process, but the code is semantically the same.]
   ;;
   ;;(define the-sitemap
   ;;  (let ((rx1 (regexp "documentation/(.*).html"))
  @@ -317,27 +319,28 @@
         (let ((procname (string->symbol (format "p~a" pcount)))
               (rxname (string->symbol (format "rx~a" pcount))))
           `(define (,procname url sitemap env)
  -           (let ((result (regexp-match ,rxname url)))
  -             (if result
  -                 (apply
  -                  (lambda ,(let loop ((index 1))
  -                             (if (> index pattern-regexps-no)
  -                                 'rest
  -                                 (cons
  -                                  (string->symbol
  -                                   (format "arg~a" (number->string index)))
  -                                  (loop (+ index 1)))))
  -                    (sitemap:process
  -                     sitemap env '()
  -                     ,(or
  -                       (match-generate pipeline)
  -                       (match-reader pipeline)
  -                       (let* ((nodelist ((node-pos 1) pipeline))
  -                              (node (if (null? nodelist) '() (car nodelist))))
  -                         (xml-error node "Invalid pipeline definition")))))
  -                  (cdr result))
  -                 #f)))
  -        ))
  +           ((lambda (result)
  +	      (if result
  +		  (apply
  +		   (lambda ,(let loop ((index 1))
  +			      (if (> index pattern-regexps-no)
  +				  'rest
  +				  (cons
  +				   (string->symbol
  +				    (format "arg~a" (number->string index)))
  +				   (loop (+ index 1)))))
  +		     (sitemap:process
  +		      sitemap env '()
  +		      ,(or
  +			(match-generate pipeline)
  +			(match-reader pipeline)
  +			(let* ((nodelist ((node-pos 1) pipeline))
  +			       (node (if (null? nodelist) '() (car nodelist))))
  +			  (xml-error node "Invalid pipeline definition")))))
  +		   (cdr result))
  +		  #f))
  +	    (regexp-match ,rxname url)))
  +	))
   
       ;; This is the main processing function for a 'match' node in the
       ;; SXML representation of the sitemap. This function returns an
  @@ -384,25 +387,31 @@
                   sitemap
                   `((match . ,(lambda (node) (process-match node))))))
                 (sitemap-code
  -               `(let ,(let loop ((ms matchers))
  -                        (if (null? ms)
  -                            '()
  -                            (cons (caar ms)
  -                                  (loop (cdr ms)))))
  -                  ,@(let loop ((ms matchers))
  -                      (if (null? ms)
  -                          '()
  -                          (cons (cdar ms)
  -                                (loop (cdr ms)))))
  -                  (lambda (url sitemap env)
  -                    (or ,@(let loop ((index 1))
  -                            (if (> index pcount)
  -                                '()
  -                                (cons
  -                                 (list (string->symbol (format "p~a" index))
  -                                       'url 'sitemap 'env)
  -                                 (loop (+ index 1))))))))))
  -;        (newline) (write sitemap-code) (newline)
  +               `((lambda (,@(let loop ((ms matchers))
  +			      (if (null? ms)
  +				  '()
  +				  (cons (caaar ms)
  +					(loop (cdr ms))))))
  +		   ,@(let loop ((ms matchers))
  +		       (if (null? ms)
  +			   '()
  +			   (cons (cdar ms)
  +				 (loop (cdr ms)))))
  +		   (lambda (url sitemap env)
  +		     (or ,@(let loop ((index 1))
  +			     (if (> index pcount)
  +				 '()
  +				 (cons
  +				  (list (string->symbol (format "p~a" index))
  +					'url 'sitemap 'env)
  +				  (loop (+ index 1))))))))
  +		 ,@(let loop ((ms matchers))
  +		     (if (null? ms)
  +			 '()
  +			 (cons (cadaar ms)
  +			       (loop (cdr ms))))))
  +	       ))
  +;         (newline) (pretty-print sitemap-code) (newline)
            (eval sitemap-code (interaction-environment))
            )))
        ))
  @@ -439,3 +448,19 @@
   ;; function is invoked from the SchemeSitemap#process method.
   (define (main url sitemap environment)
     (the-sitemap url sitemap environment))
  +
  +(define test-sitemap
  + '(pipelines (@ (*line* 1))
  +   (pipeline (@ (*line* 2))
  +    (match (@ (pattern "documentation/(.*).html") (*line* 3))
  +           (generate (@ (src "docs/{1}.xml") (type "file") (*line* 4))
  +                     (param (@ (name "test") (value "123") (*line* 5))))
  +	   (transform (@ (src "stylesheets/document2html.xsl") (@ (*line* 6)))
  +		      (param (@ (name "test2") (value "456") (@ (*line* 7)))))
  +	   (serialize (@ (*line* 8)))
  +	   )
  +
  +    (match (@ (pattern "sites/images/(.*).gif") (*line* 10))
  +	   (read (@ (src "{1}") (mime-type "image/gif") (@ (*line* 11)))))
  +    )))
  +
  
  
  

----------------------------------------------------------------------
In case of troubles, e-mail:     webmaster@xml.apache.org
To unsubscribe, e-mail:          cocoon-cvs-unsubscribe@xml.apache.org
For additional commands, e-mail: cocoon-cvs-help@xml.apache.org


Mime
View raw message