代码拉取完成,页面将自动刷新
(define-macro/err (rewrite-cyl/ciyu yexp)
`(if (pair? cyl-l)
(let* ((cur-cyl (pop cyl-l))
(cur-st (nth 3 cur-cyl))
)
;;(y-or-n "rewrite-cyl/ciyu:cur-cyi=~a\n" cur-cyl)
(cond
((eq? cur-st '词语)
;;(set! par-num (+ par-num 1))
(set! st '词语参数)
(set-car! (list-tail cur-cyl 3) '词语参数))
((cons-is cur-st)
)
((lisp-call-is cur-st)
)
(else
(exit-yexp (list 'err cyl-loc st '非法语法 (err-format 'rewrite-cyl/ciyu loc "当前cyl类型[~a]非法,只允许是[词语参数]和[常量]类型。" cur-st)))
))
cur-cyl)
'()))
(define-macro/err (rewrite-cyl-list/yexp yexp fn-typ f-name f-par)
`(let ((cur-fn ,f-name)
(cur-cyl cyl-l)
(cur-par-num ,f-par)
(cur-fn-typ ,fn-typ) ;;'函数 (func-type-get fn-str))
(cur-status #f)
(cur-coding #f)
(var-coding #f)
(res '())
)
;;(y-or-n "rewrite-cyl/yexp1:cur-cyl=~a,define-status=~a,cur-coding=~a,cur-fn=~a.\n" cur-cyl cyl-define-status cur-coding cur-fn)
(set! res (find-current-coding-list cur-fn))
(if res
(begin
(set! cur-status (nth 0 res))
(set! cur-coding (nth 1 res)))
(if (not (func-name-define-is st))
(begin
(set! cur-coding (append-new-coding cur-fn cur-fn-typ cur-par-num))
(set! cur-status cur-fn-typ)
(push (list cur-fn cur-coding '未定义函数 cur-fn-typ cyl-current-define-function-name) cyl-undefined-symbol-list))))
(tr-list (i e cur-cyl 0)
(let ((cur-st (nth 3 e))
)
(cond
((eq? cur-st '词语)
(set-car! (list-tail e 3) '函数名片段)
(set-car! (list-tail e 2) cur-coding))
((eq? cur-st '词语参数)
(let ((cur-par (nth 0 e)))
(set! res (find-current-coding-list cur-par))
;;(if (and (string=? cyl-current-define-function-name "下一字符")(string=? cur-par "当前位置")) (y-or-n "yexp->rewrite-yexp:local-list=~a\ncur-cyl=~a,e=~a,res=~a.\n" cyl-local-symbol-dict-list cur-cyl e res))
(if res
(begin
(set-car! (list-tail e 3) (nth 0 res))
(set-car! (list-tail e 2) (nth 1 res)))
(if (eq? cyl-define-status 'func-define)
(begin
(set! var-coding (append-new-coding cur-par '局部变量 0))
(set-car! (list-tail e 3) '局部变量)
(set-car! (list-tail e 2) var-coding))
(begin
(set! var-coding (append-new-coding cur-par '全局变量 0))
;;(y-or-n "rewrite-cyl/yexp-11:cur-coding=~a,e=~a,cur-par=~a.\n" cur-coding e)
(set-car! (list-tail e 3) '全局变量)
(set-car! (list-tail e 2) var-coding))
)))
))))
;;(y-or-n "rewrite-cyl/yexp2:cur-cyl=~a,define-status=~a,cur-coding=~a.\n" cur-cyl cyl-define-status cur-coding)
cur-cyl))
(define-macro/err (rewrite-cyl/cons->ciyu yexp)
`(if (and (pair? cyl-l)(> (- loc 1) 0)(not (char=? (string-ref s (- loc 1)) #\])))
(let* ((cur-cyl (pop cyl-l))(cur-st (nth 3 cur-cyl)))
(if (st-is cur-st '常量)
(begin
(set-car! (list-tail cur-cyl 3) '词语)
(push cur-cyl cyl-l))
(push cur-cyl cyl-l)))))
(define-macro/err (rewrite-cyl/ciyu->sym yexp cyl)
`(if (eq? (nth 3 ,cyl) '词语)
(cond
((eq? cyl-sexp-guide 'lisp-quote)
(set-car! (list-tail ,cyl 3) '全局变量)
,cyl)
((eq? cyl-sexp-guide 'lisp-unquote)
(let* ((cur-s (nth 0 ,cyl))
(cur-coding-l (find-current-coding-list cur-s))
)
(if cur-coding-l
(begin
(set-car! (list-tail ,cyl 3) (nth 0 cur-coding-l))
(set-car! (list-tail ,cyl 2) (nth 1 cur-coding-l))
,cyl
)
(list 'err cyl-loc 'yexp->rewrite-cyl/ciyu->sym (format "[,]后符号[~a]必须被定义,否则引用无效。" (nth 0 ,cyl))))))
((eq? cyl-sexp-guide 'lisp-backquote)
(list 'err cyl-loc 'yexp->rewrite-cyl/ciyu->sym (format "[`]后必须引用s表达式,不允许引用单一符号[~a]。" (nth 0 ,cyl)))))))
;;无限参数函数调用:只允许形如[1]、[2]、[3]和[1]+[2]+[3]和[1]
(define-macro/err (rewrite-cyl/rest yexp)
;;确保所有、符号连续
`(let ((cur-rest-flag #f)
(cur-res #f)
(cur-fn-l (reverse fn-l))
(myfn-l '())
(cur-par 0)
)
(tr-list (i e cur-fn-l 0)
(if (and (string? e)(string=? e "、"))
(cond
((eq? cur-rest-flag 'beg)
(set! cur-rest-flag 'seq)
(set! cur-res #t)
(push "、..." myfn-l)
)
((eq? cur-rest-flag 'var)
(set! cur-rest-flag 'seq)
)
((or (eq? cur-rest-flag 'halt)(eq? cur-rest-flag 'seq))
(set! cur-res #f))
(else (list 'err cyl-loc '测试无限函数调用时顿号连续性 '开发错误)))
(if (and (string? e)(string=? e "[*]"))
(cond
((not cur-rest-flag)
(set! cur-par (+ cur-par 1))
(set! cur-rest-flag 'beg)
(push e myfn-l))
((eq? cur-rest-flag 'beg)
(set! cur-par (+ cur-par 1))
(push e myfn-l))
((eq? cur-rest-flag 'seq)
(set! cur-rest-flag 'var)
)
((eq? cur-rest-flag 'var)
(set! cur-par (+ cur-par 1))
(set! cur-rest-flag 'halt)
(push e myfn-l))
((eq? cur-rest-flag 'halt)
(set! cur-par (+ cur-par 1))
(push e myfn-l)))
(begin
(push e myfn-l)
(if (eq? cur-rest-flag 'var)
(set! cur-rest-flag 'halt)
(if (eq? cur-rest-flag 'seq)
(set! cur-res #f))
)))))
;;(y-or-n "myfn-l=~a,cur-par=~a,cur-rest-flag=~a,cur-res=~a\n" myfn-l cur-par cur-rest-flag cur-res)
(if cur-res
(begin
(set! fn-str (merge-str cyl-loc myfn-l))
(set! par-num cur-par)
;;(set! cyl-l (reverse cyl-l))
(run/err rewrite-cyl-list/yexp '无限参数函数 fn-str par-num))
(list 'err cyl-loc '无限参数函数调用 '非法函数名片段使用))))
(define-macro/err (rewrite-cyl/rest-define yexp)
`(run/err rewrite-cyl-list/yexp '无限参数函数 (merge-str cyl-loc fn-l)(length par-l)))
(define-macro/err (rewrite-cyl/yexp yexp)
`(if (func-is-rest? fn-l)
(let* ((rest-func (lisp-rest-func fn-l))
(rest-coding-l (find-current-coding-list rest-func))
)
(if rest-coding-l
(run/err rewrite-rest-func/yexp '无限参数函数 rest-func (nth 2 rest-coding-l))
(begin
(set! rest-func (cylisp-rest-func fn-l))
(set! rest-coding-l (find-current-coding-list rest-func))
(if rest-coding-l
(run/err rewrite-rest-func/yexp '无限参数函数 rest-func (nth 2 rest-coding-l))
(run/err rewrite-cyl-list/yexp '函数 (merge-str loc fn-l) (length par-l))
))))
(run/err rewrite-cyl-list/yexp '函数 (merge-str loc fn-l) (length par-l))))
(define (func-is-rest? l)
(let* ((par-ok #t)
(func-part-ok #t)
(len (length l))
(par-0 (if (null? (nth 0 l)) "" (nth 0 l)))
(par-end (if (null? (nth (- len 1) l)) "" (nth (- len 1) l)))
(func-part (if (null? (nth 1 l)) "" (nth 1 l)))
)
(if (or (< len 5)(= (mod len 2) 0)(not (string=? par-0 y-deli))(not (string=? par-end y-deli))(string=? func-part ""))
#f
(begin
(tr-list (i e l 0)
(if (and (= (mod i 2) 0) par-ok (not (string=? e y-deli)))
(set! par-ok #f))
(if (and (= (mod i 2) 1) func-part-ok (not (string=? e func-part))(not (string=? e y-deli)))
(set! func-part-ok #f))
)
(and par-ok func-part-ok)))))
(define (lisp-rest-func l)
(string-append y-deli (nth 1 l) "..."))
(define (cylisp-rest-func l)
(string-append y-deli (nth 1 l) y-deli "..."))
(define-macro/err (rewrite-rest-func/yexp yexp fn-typ fn coding-rec)
`(let ((rest-typ ,fn-typ)
(rest-fn ,fn)
(rest-coding (nth 2 ,coding-rec))
(rest-cyl cyl-l)
(res #f)
(cur-coding #f)
)
(tr-list (i e rest-cyl 0)
(let ((cur-st (nth 3 e))
)
(cond
((eq? cur-st '词语)
(set-car! (list-tail e 3) '函数名片段)
(set-car! (list-tail e 2) rest-coding))
((eq? cur-st '词语参数)
(let ((cur-par (nth 0 e)))
(set! res (find-current-coding-list cur-par))
;;(y-or-n "yexp->rewrite-yexp:cur-cyl=~a,e=~a,res=~a.\n" cur-cyl e res)
(if res
(begin
(set-car! (list-tail e 3) (nth 0 res))
(set-car! (list-tail e 2) (nth 1 res)))
(if (eq? cyl-define-status 'func-define)
(begin
(set! cur-coding (append-new-coding cur-par '局部变量 0))
(set-car! (list-tail e 3) '局部变量)
(set-car! (list-tail e 2) cur-coding))
(begin
(set! cur-coding (append-new-coding cur-par '全局变量 0))
;;(y-or-n "rewrite-cyl/yexp-11:cur-coding=~a,e=~a,cur-par=~a.\n" cur-coding e)
(set-car! (list-tail e 3) '全局变量)
(set-car! (list-tail e 2) cur-coding))
)))
))))
;;(y-or-n "rest-cyl=~a\n" rest-cyl)
(set! st '无限参数函数调用)
(set! fn-str rest-fn)
rest-cyl
))
此处可能存在不合适展示的内容,页面不予展示。您可通过相关编辑功能自查并修改。
如您确认内容无涉及 不当用语 / 纯广告导流 / 暴力 / 低俗色情 / 侵权 / 盗版 / 虚假 / 无价值内容或违法国家有关法律法规的内容,可点击提交进行申诉,我们将尽快为您处理。