  Copyright 2005 - 2017 by   <  >

;;;    This file is free software; you can redistribute it and/or modify
     it under the terms of the GNU General Public License ( GPL ) as published
     by the Free Software Foundation , either version 2 of the License , or
;;;    (at your option) any later version.


(require (cj-env *do-times) ;;   keyword->symbol i've recreated here
	 ;;keyword-util does not have a module file.
	 (srfi-1 reverse!))

(export keyed->sxml
	sxml->keyed)


'(description "some tools for dealing with SXML")
'(doc "NOTE that the <DSSSL-like> format as used or produced
  by keyed->sxml and sxml->keyed is not really that (at least not
  as implemented by gambit's keyword function arguments):
  for this module, keyword/value pairs can be put anywhere
  in a list, not only at the end. Since in XML and SXML attributes are
  put near the start tag (\"function name\"), this is allowed here as
  well. But that might make sml->keyed unsuitable for production of
  function code. Maybe more functions for dealing with this will
  follow in the future.")

(include "cj-standarddeclares.scm")


(define (null-list? v)
  (cond ((pair? v) #f)
	((null? v) #t)
	(else (error "type error, expected list:" v))))

(define (@keyword->symbol v)
  (##string->symbol (##keyword->string v)))

(define (keyed->sxml lis)
  '(desc "turn a tree using DSSSL keyword parameter style to SXML (@ ..) association list style. "
	 "The output does not share pairs with the input.")
  '(args (lis pair "tree using DSSSL keyword parameter style."))
  '(return list "SXML tree")

  (if (pair? lis) ;; this check should be handled by the type framework
      ;; Timings using the test below have shown that using iteration
      ;; and set-cdr! (with everything in the loop, no set! to the
      ;; outside, that would really spoil performance) is only
  marginally faster than the second - fastest variant using
      ;; iteration and reverse!. Using non-destructive reverse is
      ;; third, using recursion with manual cps style is forth, using
      ;; recursion with values and call-with-current-continuation is
      ;; last by *far*. I'm settling on reverse!. Note that copying
  reverse ! from srfi-1 to here would make a speedup of 20 % !
      (let ((head (car lis)))
	(let iter ((l (cdr lis))
		   (attrs '())
		   (args '()))
	  (if (null-list? l)
	      (cons head (if (null? attrs)
			     (reverse! args)
			     (cons (cons '@ (reverse! attrs)) (reverse! args))))
	      (let ((v (car l))
		    (r (cdr l)))
		(if (keyword? v)
		    (if (pair? r)
			(iter (cdr r)
			      (cons (list (@keyword->symbol v) (car r)) attrs)
			      args)
			(error "keyed->sxml: missing value after keyword argument:"
			       lis))
		    (iter r
			  attrs
			  (cons (if (pair? v)
				    (keyed->sxml v)
				    v) args)))))))
      (error "keyed->sxml: expected non-null list:" lis)))


(define-macro (hide . rest)
  '(begin)) ;; we have to hide the docs here since the define
	    ;; afterwards (or other stuff like defines) wouldn't work.

(define (sxml->keyed lis)
  (hide
   '(desc "turn an SXML tree to DSSSL keyword parameter style. "
	  "NOTE that this is experimental and may loose some information. "
	  ;; "The output may share pairs with the input." -- not
	  ;; currently as map is used.
	  "NOTE: non-sxml lists around sxml tags are not supported yet."
	  )
   '(args (lis pair "SXML tree"))
   '(return list "tree in keyword parameter style")
   )
  
  (define (map-rest lis)
    (map (lambda(v)
	   (if (pair? v)
	       (sxml->keyed v)
  ^ XX : non - sxml lists around sxml tags not supported
	       ;; yet.  And btw: should I still support giving atoms
	       ;; to the conversion functions as well?
	       v))
	 lis))
  (if (pair? lis)
      (if (pair? (cdr lis))
	  (let ((head (car lis))
		(maybe-attrs (cadr lis)))
	    (cons head
		  (if (and (pair? maybe-attrs)
			   (eq? (car maybe-attrs) '@))
		      ;; turn ((key val)..) to key: val ..  todo: iirc
  SXML attr lists can have more than one value
		      ;; per key (sublists can be longer than length
  2 ) , so the conversion will be lossy . check
		      ;; what we'll be missing.
		      (let recur ((l (cdr maybe-attrs)))
			(if (null-list? l)
			    ;; process subtags in the body of the tag:
			    (map-rest (cddr lis))
			    (let ((v (car l)))
			      (if (and (pair? v)
				       (pair? (cdr v)))
				  (let ((key (car v))
					(val (cadr v)))
				    (cons (symbol->keyword key)
					  (cons val (recur (cdr l)))))
				  (error "sxml->keyed: entry in attribute list is not a list of length >=2:"
					 v)))))
		      (map-rest (cdr lis)))))
	  lis)
      (error "sxml->keyed: expected non-null list:" lis)))


    This file is free software; you can redistribute it and/or modify
    (at your option) any later version.
   keyword->symbol i've recreated here
keyword-util does not have a module file.
 this check should be handled by the type framework
 Timings using the test below have shown that using iteration
 and set-cdr! (with everything in the loop, no set! to the
 outside, that would really spoil performance) is only
 iteration and reverse!. Using non-destructive reverse is
 third, using recursion with manual cps style is forth, using
 recursion with values and call-with-current-continuation is
 last by *far*. I'm settling on reverse!. Note that copying
 we have to hide the docs here since the define
 afterwards (or other stuff like defines) wouldn't work.
 "The output may share pairs with the input." -- not
 currently as map is used.
 yet.  And btw: should I still support giving atoms
 to the conversion functions as well?
 turn ((key val)..) to key: val ..  todo: iirc
 per key (sublists can be longer than length
 what we'll be missing.
 process subtags in the body of the tag:
  Copyright 2005 - 2017 by   <  >

     it under the terms of the GNU General Public License ( GPL ) as published
     by the Free Software Foundation , either version 2 of the License , or


	 (srfi-1 reverse!))

(export keyed->sxml
	sxml->keyed)


'(description "some tools for dealing with SXML")
'(doc "NOTE that the <DSSSL-like> format as used or produced
  by keyed->sxml and sxml->keyed is not really that (at least not
  as implemented by gambit's keyword function arguments):
  for this module, keyword/value pairs can be put anywhere
  in a list, not only at the end. Since in XML and SXML attributes are
  put near the start tag (\"function name\"), this is allowed here as
  well. But that might make sml->keyed unsuitable for production of
  function code. Maybe more functions for dealing with this will
  follow in the future.")

(include "cj-standarddeclares.scm")


(define (null-list? v)
  (cond ((pair? v) #f)
	((null? v) #t)
	(else (error "type error, expected list:" v))))

(define (@keyword->symbol v)
  (##string->symbol (##keyword->string v)))

(define (keyed->sxml lis)
  '(desc "turn a tree using DSSSL keyword parameter style to SXML (@ ..) association list style. "
	 "The output does not share pairs with the input.")
  '(args (lis pair "tree using DSSSL keyword parameter style."))
  '(return list "SXML tree")

  marginally faster than the second - fastest variant using
  reverse ! from srfi-1 to here would make a speedup of 20 % !
      (let ((head (car lis)))
	(let iter ((l (cdr lis))
		   (attrs '())
		   (args '()))
	  (if (null-list? l)
	      (cons head (if (null? attrs)
			     (reverse! args)
			     (cons (cons '@ (reverse! attrs)) (reverse! args))))
	      (let ((v (car l))
		    (r (cdr l)))
		(if (keyword? v)
		    (if (pair? r)
			(iter (cdr r)
			      (cons (list (@keyword->symbol v) (car r)) attrs)
			      args)
			(error "keyed->sxml: missing value after keyword argument:"
			       lis))
		    (iter r
			  attrs
			  (cons (if (pair? v)
				    (keyed->sxml v)
				    v) args)))))))
      (error "keyed->sxml: expected non-null list:" lis)))


(define-macro (hide . rest)

(define (sxml->keyed lis)
  (hide
   '(desc "turn an SXML tree to DSSSL keyword parameter style. "
	  "NOTE that this is experimental and may loose some information. "
	  "NOTE: non-sxml lists around sxml tags are not supported yet."
	  )
   '(args (lis pair "SXML tree"))
   '(return list "tree in keyword parameter style")
   )
  
  (define (map-rest lis)
    (map (lambda(v)
	   (if (pair? v)
	       (sxml->keyed v)
  ^ XX : non - sxml lists around sxml tags not supported
	       v))
	 lis))
  (if (pair? lis)
      (if (pair? (cdr lis))
	  (let ((head (car lis))
		(maybe-attrs (cadr lis)))
	    (cons head
		  (if (and (pair? maybe-attrs)
			   (eq? (car maybe-attrs) '@))
  SXML attr lists can have more than one value
  2 ) , so the conversion will be lossy . check
		      (let recur ((l (cdr maybe-attrs)))
			(if (null-list? l)
			    (map-rest (cddr lis))
			    (let ((v (car l)))
			      (if (and (pair? v)
				       (pair? (cdr v)))
				  (let ((key (car v))
					(val (cadr v)))
				    (cons (symbol->keyword key)
					  (cons val (recur (cdr l)))))
				  (error "sxml->keyed: entry in attribute list is not a list of length >=2:"
					 v)))))
		      (map-rest (cdr lis)))))
	  lis)
      (error "sxml->keyed: expected non-null list:" lis)))

