(define 符号位置序列号 0)

(define-syntax push
  (syntax-rules ()
    ((_ x l) (begin (set! l (cons x l)) l))))
(define-syntax pop
  (syntax-rules ()
    ((_ l) (let ((a (car l))) (set! l (cdr l)) a))))
(define-syntax append-push
  (syntax-rules ()
    ((_ x l) (begin (set! l (append (reverse x) l)) l))))
(define (nth n l) (if (>= n (length l)) '() (list-ref l n)))
(define (nth-cdr n l) (if (>= n (length l)) '() (list-tail l n)))
(define-syntax define-macro
  (lambda (x)
    (syntax-case x ()
      ((define-macro (name . params) body1 body2 ...)
       #'(define-macro name (lambda params body1 body2 ...)))
      ((define-macro name expander)
       #'(define-syntax name
           (lambda (x)
             (syntax-case x ()
               [(name . args) ;(_ . args) more hygiene!!
                (datum->syntax #'name (apply expander (syntax->datum #'args)))])))))))

(define-macro (cyl-serial)
  `(begin (set! 符号位置序列号 (+ 符号位置序列号 1)) 符号位置序列号))

(define (position x ls)
  (let ((len (length ls)))
    (let pos ((x x)(ls ls))
      (cond
       ((null? ls) #f)
       ((eq? (car ls) x) (- len (length ls)))
       (else (pos x (cdr ls)))))))

(define-macro tr-string-1
  (lambda (par-l . body)
    (if (= (length par-l) 4)
	(let ((i (car par-l))(c (cadr par-l))(s (caddr par-l))(n (list-ref par-l 3)))
	  (if (and (symbol? i)(symbol? c)(or (symbol? s)(string? s))(or (symbol? n)(integer? n)))
	      `(call/cc (lambda (break-string)
			  (let* ((,i ,n)(,c (string-ref ,s ,i))(--l (string-length ,s)))
			    (let f ()
			      ,@body
			      (set! ,i (+ ,i 1))
			      (if (>= ,i --l) (break-string ,i))
			      (set! ,c (string-ref ,s ,i))
			      (f)))))
	      (display "错误提示：参数类型不合法。")))
	(display "错误提示：参数数量不合法。"))))
(define-macro tr-list-1
  (lambda (par-l . body)
    (if (= (length par-l) 4)
	(let ((i (car par-l))(e (cadr par-l))(l (caddr par-l))(n (list-ref par-l 3)))
	  (if (and (symbol? i)(symbol? e)(or (symbol? l)(pair? l))(or (symbol? n)(integer? n)))
	      `(call/cc (lambda (break-list)
			  (let* ((,i ,n)(,e (list-ref ,l ,i))(--len (length ,l)))
			    (let f ()
			      ,@body
			      (set! ,i (+ ,i 1))
			      (if (>= ,i --len) (break-list ,i))
			      (set! ,e (list-ref ,l ,i))
			      (f)))))
	      (display "错误提示：参数类型不合法。")))
	(display "错误提示：参数数量不合法。"))))
(define-macro tr-string
   (lambda (par-l . body)
    (if (= (length par-l) 4)
	(let ((i (car par-l))(c (cadr par-l))(l (caddr par-l))(n (list-ref par-l 3)))
	  (if (and (symbol? i)(symbol? c)(or (symbol? l)(string? l))(or (symbol? n)(integer? n)))
	      `(let ((--len (string-length ,l)))
		 (do ((,i ,n (+ ,i 1)))
		     ((>= ,i --len) ,i)
		   (let ((,c (string-ref ,l ,i)))
		     ,@body
		     )))
	      (display "错误提示：参数类型不合法。")))
	(display "错误提示：参数数量不合法。"))))
(define-macro tr-string-step
   (lambda (par-l . body)
    (if (= (length par-l) 5)
	(let ((i (car par-l))(c (cadr par-l))(l (caddr par-l))(n (list-ref par-l 3))(step (list-ref par-l 4)))
	  (if (and (symbol? i)(symbol? c)(or (symbol? l)(string? l))(or (symbol? n)(integer? n)))
	      `(let ((--len (string-length ,l)))
		 (do ((,i ,n (+ ,i ,step)))
		     ((if (> ,step 0) (>= ,i --len)(< ,i 0)) ,i)
		   (let ((,c (string-ref ,l ,i)))
		     ,@body
		     )))
	      (display "错误提示：参数类型不合法。")))
	(display "错误提示：参数数量不合法。"))))
(define-macro tr-list
   (lambda (par-l . body)
    (if (= (length par-l) 4)
	(let ((i (car par-l))(e (cadr par-l))(l (caddr par-l))(n (list-ref par-l 3)))
	  (if (and (symbol? i)(symbol? e)(or (symbol? l)(pair? l))(or (symbol? n)(integer? n)))
	      `(let ((--len (length ,l)))
		 (do ((,i ,n (+ ,i 1)))
		     ((>= ,i --len) ,i)
		   (let ((,e (list-ref ,l ,i)))
		     ,@body
		     )))
	      (display "错误提示：参数类型不合法。")))
	(display "错误提示：参数数量不合法。"))))
(define-macro tr-list-step
   (lambda (par-l . body)
    (if (= (length par-l) 5)
	(let ((i (car par-l))(e (cadr par-l))(l (caddr par-l))(n (list-ref par-l 3))(step (list-ref par-l 4)))
	  (if (and (symbol? i)(symbol? e)(or (symbol? l)(pair? l))(or (symbol? n)(integer? n)))
	      `(let ((--len (length ,l)))
		 (do ((,i ,n (+ ,i ,step)))
		     ((if (> ,step 0) (>= ,i --len)(< ,i 0)) ,i)
		   (let ((,e (list-ref ,l ,i)))
		     ,@body
		     )))
	      (display "错误提示：参数类型不合法。")))
	(display "错误提示：参数数量不合法。"))))
(define-syntax loop
  (lambda (x)
    (syntax-case x ()
      [(k e ...)
       (with-syntax ([break (datum->syntax #'k 'breakout)])
         #'(call/cc
             (lambda (break)
               (let f () e ... (f)))))])))
(define-syntax dotimes
  (lambda (x)
    (syntax-case x ()
      ((_ (i d) e1 ...)
       (with-syntax ((break (datum->syntax #'k 'breakout)))
		    #'(call/cc (lambda (break)
				 (do ((i 0 (+ i 1)))
				     ((>= i d) i)
				   e1 ...))))))))

(define-syntax dolist
  (lambda (x)
    (syntax-case x ()
      ((_ (i l) e1 ...)
       (with-syntax ((break (datum->syntax #'k 'breakout)))
		    #'(call/cc (lambda (break)
				 (let ((ll l))
				   (do ((i (nth 0 ll) (nth 1 ll))(ll ll (cdr ll)))
				       ((null? ll) ll)
				     e1 ...)))))))))
(define-syntax dolist-n
  (syntax-rules ()
    ((_ (i l n) e1 ...)
     (let ((ll (nth-cdr n l)))
       (do ((i (nth 0 ll) (nth 1 ll))(ll ll (cdr ll)))
	   ((null? ll) ll)
	 e1 ...)))))
(define (nth-str i s)
  (if (>= i (string-length s)) #f (string-ref s i)))

(define-syntax dostring
  (lambda (x)
    (syntax-case x ()
      ((_ (c s) e1 ...)
       (with-syntax ((break (datum->syntax #'k 'breakout))
		    )
		    #'(call/cc (lambda (break)
				 (let ((ss s)(len (string-length s)))
				   (do ((i 0 (+ i 1))(c (nth-str 0 ss)(nth-str (+ i 1) ss)))
				       ((> (+ i 1) len) i)
				     e1 ...)))))))))
(define-syntax dostring-n
  (lambda (x)
    (syntax-case x ()
      ((_ (c s n) e1 ...)
       (with-syntax ((break (datum->syntax #'k 'breakout))
		    )
		    #'(call/cc (lambda (break)
				 (let ((ss s)(len (string-length s)))
				   (do ((i n (+ i 1))(c (nth-str n ss)(nth-str (+ i 1) ss)))
				       ((> (+ i 1) len) i)
				     e1 ...)))))))))
(define-syntax tr-list0
  (lambda (x)
    (syntax-case x ()
      ((_ (i e l n) e1 ...)
       (with-syntax ((break (datum->syntax #'k 'break)))
		    #'(call/cc (lambda (break)
				 (let ((ll l)(nn n)(len (length l)))
				   (do ((e (nth nn ll)(nth (+ i 1) ll))(i n (+ i 1)))
				       ((>= i len) (- len n))
				     e1 ...)))))))))

(define-syntax tr-string0
  (lambda (x)
    (syntax-case x ()
      ((_ (i c s n) e1 ...)
       (with-syntax ((break (datum->syntax #'k 'break)))
		    #'(call/cc (lambda (break)
				 (let ((ss s)(nn n)(len (string-length s)))
				   (do ((c (nth-str nn ss)(nth-str (+ i 1) ss))(i n (+ i 1)))
				       ((>= i len) (- len n))
				     e1 ...)))))))))
(define-macro (travel-list data index . body)
  (let ((fn (gensym)))
    `(let ((,index ,data)(,fn (lambda(,index) ,@body)))
       (tra-list ,index ,fn))))
(define (tra-list l fn)
  (if (null? l) '()
      (if (atom? l) (fn l)
	  (cons (tra-list (car l) fn)(tra-list (cdr l) fn)))))
      
(define-syntax travel1
  (syntax-rules (string-index-item list-index-item string-index list-index number-index string-item list-item list-atom)
    ((_ d n s string-index-item i e e1 ...)
     (tr-string-step (i e d n s) e1 ...))
    ((_ d n s list-index-item i e e1 ...)
     (tr-list-step (i e d n s) e1 ...))
    ((_ d n string-index-item i e e1 ...)
     (tr-string (i e d n) e1 ...))
    ((_ d n list-index-item i e e1 ...)
     (tr-list (i e d n) e1 ...))
    ((_ d string-index-item i e e1 ...)
     (tr-string (i e d 0) e1 ...))
    ((_ d list-index-item i e e1 ...)
     (tr-list (i e d 0) e1 ...))
    ((_ d n string-index i e1 ...)
     (let ((len (string-length d))) (dotimes (i len)(if (= i 0) (set! i (+ i n))) e1 ...)))
    ((_ d n list-index i e1 ...)
     (let ((len (length d))) (dotimes (i len) (if (= i 0) (set! i (+ i n))) e1 ...)))
    ((_ d n number-index i e1 ...)
     (dotimes (i d) (if (= i 0) (set! i (+ i n))) e1 ...))
    ((_ d string-index i e1 ...)
     (let ((len (string-length d))) (dotimes (i len) e1 ...)))
    ((_ d list-index i e1 ...)
     (let ((len (length d))) (dotimes (i len) e1 ...)))
    ((_ d number-index i e1 ...)
     (dotimes (i d) e1 ...))
    ((_ d n string-item i e1 ...)
     (dostring-n  (i d n) e1 ...))
    ((_ d n list-item i e1 ...)
     (dolist-n (i d n) e1 ...))
    ((_ d string-item i e1 ...)
     (dostring (i d) e1 ...))
    ((_ d list-item i e1 ...)
     (dolist (i l) e1 ...))
    ((_ d list-atom i e1 ...)
     (travel-list d i e1 ...))
       
    ))
      
				 
(define-syntax define-structure
  (lambda (x)
    (define gen-id
      (lambda (template-id . args)
        (datum->syntax template-id
          (string->symbol
            (apply string-append
              (map (lambda (x)
                     (if (string? x)
                         x
                         (symbol->string (syntax->datum x))))
                   args))))))
    (syntax-case x ()
      [(_ name field ...)
       (with-syntax ([constructor (gen-id #'name "make-" #'name)]
                     [predicate (gen-id #'name #'name "?")]
                     [(access ...)
                      (map (lambda (x) (gen-id x #'name "-" x))
                           #'(field ...))]
                     [(assign ...)
                      (map (lambda (x)
                             (gen-id x "set-" #'name "-" x "!"))
                           #'(field ...))]
                     [structure-length (+ (length #'(field ...)) 1)]
                     [(index ...)
                      (let f ([i 1] [ids #'(field ...)])
                        (if (null? ids)
                            '()
                            (cons i (f (+ i 1) (cdr ids)))))])
         #'(begin
             (define constructor
               (lambda (field ...)
                 (vector 'name field ...)))
             (define predicate
               (lambda (x)
                 (and (vector? x)
                      (= (vector-length x) structure-length)
                      (eq? (vector-ref x 0) 'name))))
             (define access
               (lambda (x)
                 (vector-ref x index)))
             ...
             (define assign
               (lambda (x update)
                 (vector-set! x index update)))
             ...))])))