;;(load "rd.scm")
(define (err-msg fmt-str .  var-list)
  (display (apply format fmt-str var-list))
  (newline))
(define (y-or-n fmt-str . var-list)
  (display (apply format fmt-str var-list))
  (let ((c (read-char)))
    (if (not (or (char=? c #\y)(char=? c #\space)))
	(apply y-or-n fmt-str var-list))))
;;我们约定凡是需要出错返回顶部处理的函数都使用列表返回，并遵守如下约定：列表的第一项是主返回值，第二项是当前字符串位置，第三项是返回类型。当发生错误时，第一项是'err,第二项是当前字符串位置，第三项是当前状态，第四项是错误描述，第五项是建议字符串。
(define (err-format fn n fmt-str . var-list)
  (apply format (string-append "错误信息[~a][~a]：" fmt-str) fn n var-list))
(define (err-suggest fn n fmt-str . var-list)
  (apply format (string-append "错误提示[~a][~a]：" fmt-str) fn n var-list))
(define (err-handle str s m n method)
  (let ((len (string-length s))(res #f))
    (cond
     ((and (eq? method '字符串结束)(= n len))
      (display str)
      (newline)
      (err-msg "已经搜索到字符串末尾，离故障点最近的分隔符位置是[~a]，请检查。" (if (string? (set! res (rd-match-list s m m cyl-deli-list #t))) (+ m (string-length res)) n))
      (list 'err '已到字符串末尾错误退出))
     ((eq? method '无处理)
      (display str))
     ((eq? method '非法常量)
      (let* ((r (rd-match-list s m m cyl-all-deli-list #t))
	     (r-next (rd-match-newline s n n))
	     (chk-pos (if (string? r) (+ m (string-length r)) (if (string? r-next) (+ n (string-length r-next)) len)))
	     (next-pos (if (string? r-next) (+ n (string-length r-next)) (list 'err '无法继续分析退出)))
	     )
	(display str)
	(newline)
	(err-msg "常量错误一般在第一个分隔符[~a]范围内，请检查。程序将在[~a]后继续进行分析..." chk-pos next-pos)
	next-pos))
      ((eq? method '非法语法)
       (let* ((r-next (rd-match-newline s n n))
	     (next-pos (if (string? r-next) (+ n (string-length r-next)) (list 'err '无法继续分析退出)))
	     )
	 (display str)
	 (newline)
	 (err-msg "语法错误一般在第一个分隔符[~a]范围内，请检查。程序将在[~a]后继续进行分析..." next-pos next-pos)
	 next-pos))
     (else
      (display str)
      (newline)
      (err-msg "[~a]未定义，非法错误处理方法。" method)
      (list 'err '非法错误处理方法退出)))))
(define (handle-error s l)
  (let* ((loc (nth 1 l))
	 (sw (nth 2 l))
	 (pos (- loc sw))
	 (method (nth 3 l))
	 (str (nth 4 l))
	 )
    (err-handle str s pos loc method)))