1 Star 13 Fork 0

jianchiyiye/cylisp

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
文件
该仓库未声明开源许可证文件(LICENSE),使用请关注具体项目描述及其代码上游依赖。
克隆/下载
end.scm 6.54 KB
一键复制 编辑 原始数据 按行查看 历史
jianchiyiye 提交于 2022-06-28 17:14 . bug_fix
(define (no-local-undefined-func?)
(call/cc (lambda (exit-no-local-undefined-func?)
(if (null? cyl-undefined-symbol-list)
#t
(begin
(tr-list (i sym-l cyl-undefined-symbol-list 0)
(let ((fn (car sym-l))
(typ (nth 3 sym-l))
)
(if (not (eq? typ 'lisp函数))
(exit-no-local-undefined-func? #f)
)))
#t)))))
(define (local-func-is typ)
(cond
((eq? typ '无参局部函数) #t)
((eq? typ '局部函数) #t)
((eq? typ '函数) #t)
((eq? typ '无参函数) #t)
((eq? typ '无限参数函数) #t)
((eq? typ '缺省函数) #t)
((eq? typ '关键字函数) #t)
((eq? typ '全局局部函数) #t)
(else #f)))
(define (part-func-is typ)
(cond
((eq? typ '无参局部函数) #t)
((eq? typ '局部函数) #t)
((eq? typ '全局局部函数) #t)
(else #f)))
(def/err (local-func-list-get cur-item)
(let ((new-l '())
)
(if (null? cur-item)
#f
(begin
;;(y-or-n "cur-item=~a\n" cur-item)
(tr-list (i s-item cur-item 0)
(let ((l-fn (car s-item))
(l-typ (nth 1 s-item))
)
(if (local-func-is l-typ)
(push l-fn new-l)
)))
(if (null? new-l)
#f
new-l)
))))
(define (gen-new-seq-list new-symbol-list new-list)
(call/cc (lambda (exit-gen-new-seq-list)
(let ((recur-flag 0))
(loop
(let ((cnt 0)(null-cnt 0)(lll (length new-symbol-list)))
(tr-list (i e new-symbol-list 0)
(let ((l-f (car e))
(l-l (nth 1 e))
(l-m (nth 2 e))
(l-t (nth 3 e))
(l-l-len (length (nth 1 e)))
(n-l '())
)
(if (null? l-l)
(begin
(set! null-cnt (+ null-cnt 1)))
(if (= recur-flag 1)
(if (not (part-func-is l-t))
(begin
(set! cnt (+ cnt l-l-len))
(set-car! (list-tail e 1) '())
(push l-f new-list)))
(begin
(set! n-l (run/err if-include-in l-l new-list))
(set! cnt (+ cnt (- l-l-len (length n-l))))
(set-car! (list-tail e 1) n-l)
(if (null? n-l) (push l-f new-list)))
)
)))
;;(y-or-n "new-symbol-list=~a\nnull-cnt=~a,cnt=~a,recur-flag=~a\n" new-symbol-list null-cnt cnt recur-flag)
(if (= null-cnt lll)
(exit-gen-new-seq-list new-list)
(if (= cnt 0)
(if (= recur-flag 0)
(set! recur-flag 1)
(exit-gen-new-seq-list (list 'err 0 'gen-new-seq-list->end-tree (format "错误提示:局部函数定义不完整或者形成函数循环递归。请查找列表~a中的函数补充定义代码。" new-symbol-list))))
))
;;对于函数调用宏,宏又调用与函数构成循环递归调用的其他函数不支持。我认为这种情况也会造成宏递归。
))))))
(define (if-include-in l1 l2)
(let ((n-l '()))
(tr-list (i e l1 0)
(if (not (if-belongto e l2))
(push e n-l)
))
n-l))
(define (if-belongto e l)
(call/cc (lambda (exit-if-belongto)
(tr-list (i ee l 0)
(if (and (string? ee)(string=? e ee))
(exit-if-belongto #t)
))
#f)))
(define (end-seq l)
(let ((cur-dict l)
(cur-list '())
(cur-at-list '())
(cur-tree '())
(new-symbol-list '())
(new-list '())
)
(if (no-local-undefined-func?)
(begin
(tr-list (loc e cur-dict 0)
;;(y-or-n "e=~a\n" e)
(let ((cur-fn (car e))
(cur-item (cadr e))
(cur-recur (nth 2 e))
(cur-typ (nth 3 e))
(new-item #f)
)
(set! new-item (local-func-list-get cur-item))
;;(y-or-n "new-item=~a\n" new-item)
(if new-item
(push (list cur-fn new-item cur-recur cur-typ) new-symbol-list)
(push cur-fn new-list)
)
))
;;(y-or-n "local-func-list=~a,solved-local-func=~a\n" new-symbol-list new-list)
(reverse (gen-new-seq-list (reverse new-symbol-list) new-list))
)
(list 'err 0 'end-tree (format "错误提示:未定义符号表中存在未解析的本地函数[~a],应当增加其解析代码。" cyl-undefined-symbol-list)))))
(def/err (end-rew-cyl l cyl)
(let ((new-cyl '())
(cur-cyl cyl)
(func-cyl '())
(reg-cyl '())
(com-cyl '())
(ret-fn #f)
(ret-cyl '())
)
(let-set! (func-cyl reg-cyl com-cyl) (gen-diffrent-type-cyl-list cur-cyl))
;;(y-or-n "end-rew-cyl:func-cyl=~a\n" func-cyl)
(tr-list (i e l 0)
(let-set! (ret-fn ret-cyl) (find-func-cyl-list func-cyl e))
(if (and (string? e)(string? ret-fn)(string=? e ret-fn))
(push ret-cyl new-cyl))
)
(set! new-cyl (append (reverse reg-cyl)(reverse new-cyl)(reverse com-cyl)))
new-cyl
))
(def/err (gen-diffrent-type-cyl-list l)
(let ((func-cyl '())
(reg-cyl '())
(com-cyl '())
(reg-flag #f)
)
(tr-list (i e l 0)
(let ((typ (nth 3 e))
(n (nth 0 e))
)
(cond
((eq? typ '函数定义)
(if (= (length n) 3)
(let ((f-name (nth 0 (nth 0 n)))
(f-typ (nth 3 (nth 0 n)))
(fn (nth 5 (nth 0 n)))
)
(if (func-def-is f-typ)
(push (list f-name e) func-cyl)
(if (yexp-func-def-is f-typ)
(push (list fn e) func-cyl)
(exit-gen-diffrent-type-cyl-list (list 'err 0 'gen-diffrent-type-cyl-list (format "错误提示:函数定义cyl列表函数名类型[~a]不符合规范。" f-typ))))
))
(exit-gen-diffrent-type-cyl-list (list 'err 0 'gen-diffrent-type-cyl-list (format "错误提示:函数定义cyl列表长度[~a]只允许为3。" (length n)))))
)
((eq? typ '系统宏调用)
(let* ((macro-l (car e))
(macro-n-cyl (car macro-l))
(macro-name (car macro-n-cyl))
(macro-typ (nth 3 macro-n-cyl))
)
(if (and (eq? macro-typ '系统宏)(string? macro-name)(string=? macro-name "注册"))
(begin
(push e reg-cyl)
(set! reg-flag #t))
(push e com-type))))
((com-is typ)
(push e com-cyl))
((eq? typ '结束分隔符)
(if reg-flag
(begin
(push e reg-cyl)
(set! reg-flag #f))
(push e com-cyl)))
((deli-is typ)
(push e com-cyl))
((comment-is typ)
)
(else
(exit-gen-diffrent-type-cyl-list (list 'err 0 'gen-diffrent-type-cyl-list (format "错误提示:cyl文件第一层类型[~a]不合规范,开发错误。" typ))))
)))
(list func-cyl reg-cyl com-cyl)))
(define (find-func-cyl-list l n)
(cond
((null? l) #f)
((atom? l) #f)
((not (string? n)) #f)
((and (pair? l)(string? n))
(cond
((and (string? (car (car l)))(string=? n (car (car l)))) (car l))
(else (find-func-cyl-list (cdr l) n))))
))
(define (comment-is typ)
(cond
((eq? typ '单行注释) #t)
((eq? typ '多行注释) #t)
((eq? typ '开发注释) #t)
(else #f)))
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
Scheme
1
https://gitee.com/jianchiyiye/cylisp.git
git@gitee.com:jianchiyiye/cylisp.git
jianchiyiye
cylisp
cylisp
master

搜索帮助