1 Star 13 Fork 0

jianchiyiye/cylisp

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
文件
该仓库未声明开源许可证文件(LICENSE),使用请关注具体项目描述及其代码上游依赖。
克隆/下载
at.scm 27.26 KB
一键复制 编辑 原始数据 按行查看 历史
jianchiyiye 提交于 2022-07-01 16:54 . 0701release
(define-macro/err (set-var-assign/at-aux handle-at)
`(if (or (eq? at-st '变量@表达式)(eq? at-st '变量&表达式))
(begin
(set! at-define-list (list st res-str at-st))
;;(y-or-n "fn=~a,local-dict=~a,current-dict=~a\nat-list=~a\n" fn cyl-local-symbol-dict-list cyl-current-symbol-dict-list at-define-list)
(cond
((and (eq? cyl-define-status 'func-define)(eq? at-st '变量@表达式))
(if (not (car (find-dict-coding-list fn 'local)))
(append-new-coding-atexp fn '局部变量 0 st res-str)
(push (format "set-var-assign/at-aux->handle-at:~s已经在~a字典中定义,使用@表达式重复定义无效。请检查以前的符号引用位置。" fn 'local) cyl-error-warning-list)
))
((and (eq? cyl-define-status 'func-define)(eq? at-st '变量&表达式)(or (eq? cyl-current-func-type '局部函数)(eq? cyl-current-func-type '无参局部函数)))
(if (not (car (find-dict-coding-list fn 'parent)))
(append-parent-new-coding-atexp fn '局部变量 0 st res-str)
(push (format "set-var-assign/at-aux->handle-at:~s已经在~a字典中定义,使用@表达式重复定义无效。请检查以前的符号引用位置。" fn 'parent) cyl-error-warning-list)
))
((eq? at-st '变量&表达式)
;;(y-or-n "fn=~a,current-search=~a,local-search=~a\n" fn (find-dict-coding-list fn 'current)(find-dict-coding-list fn 'local))
(if (not (or (car (find-dict-coding-list fn 'current))(car (find-dict-coding-list fn 'local)))) (append-new-coding-atexp fn '全局变量 0 st res-str)
(push (format "set-var-assign/at-aux->handle-at:~s已经在~a、~a字典中定义,使用&表达式重复定义无效。请检查以前的符号引用位置。" fn 'local 'current) cyl-error-warning-list)
))
((eq? cyl-define-status 'top-level)
(if (not (car (find-dict-coding-list fn 'current))) (append-new-coding-atexp fn '全局变量 0 st res-str)
(push (format "set-var-assign/at-aux->handle-at:~s已经在~a字典中定义,使用@表达式重复定义无效。请检查以前的符号引用位置。" fn 'current) cyl-error-warning-list)
))
)
)
(exit-handle-at (list 'err i 'handle-at->set-var-assign/at-aux (format "此位置只能处理变量@表达式和变量&表达式,但实际是[~a] 。" at-st)))))
(define-macro/err (set-func-assign/at-aux handle-at)
`(cond
((eq? at-st '函数调用@表达式)
(set! at-define-list (list st res-str at-st))
(append-new-coding-atexp fn '缺省函数 par st res-str))
((eq? at-st '函数定义@表达式)
(set! at-define-list (list at-st (reverse at-define-list) fn par)))
(else
(exit-handle-at (list 'err i 'handle-at->set-func-assign/at-aux (format "此位置只能处理函数调用@表达式、函数定义@表达式,但实际是[~a] 。" at-st))))))
(def/err (handle-at s n fn par)
(let ((res-str "")
(res-par 0)
(st #f)
(at-st #f)
(at-define-list '())
(func-st #f)
(str-len 0)
)
;;(y-or-n "handle-at:n=~a,fn=~a,par=~a\n" n fn par)
(set! cyl-at-define-list '())
(tr-string (i ch s n)
;;(y-or-n "loop:i=~a\n" i)
(cond
((rd-at-deli ch)
(cond
((and (not at-st)(null? at-define-list))
(if (eq? cyl-define-status 'func-define)
(if (not (car (find-dict-coding-list fn 'local)))
(begin
(append-new-coding-atexp fn '局部变量 0 '系统值常量 "#%系统缺省值")
(exit-handle-at (list (list '系统值常量 "#%系统缺省值" '变量@表达式) (- i 1) 'at表达式局部变量)))
(push (format "set-var-assign/at-aux->handle-at:~s已经在~a字典中定义,使用@表达式重复定义无效。请检查以前的符号引用位置。" fn 'local) cyl-error-warning-list))
(if (not (car (find-dict-coding-list fn 'local)))
(begin
(append-new-coding-atexp fn '全局变量 0 '系统值常量 "#%系统缺省值")
(exit-handle-at (list (list '系统值常量 "#%系统缺省值" '变量@表达式) (- i 1) 'at表达式全局变量)))
(push (format "set-var-assign/at-aux->handle-at:~s已经在~a字典中定义,使用@表达式重复定义无效。请检查以前的符号引用位置。" fn 'local) cyl-error-warning-list))
))
((and (eq? at-st '变量&表达式)(null? at-define-list))
(if (or (eq? cyl-current-func-type '局部函数)(eq? cyl-current-func-type '无参局部函数))
(if (not (car (find-dict-coding-list fn 'parent)))
(begin
(append-parent-new-coding-atexp fn '局部变量 0 '系统值常量 "#%系统缺省值")
(exit-handle-at (list (list '系统值常量 "#%系统缺省值" '变量@表达式) (- i 1) 'and表达式外部变量)))
(push (format "set-var-assign/at-aux->handle-at:~s已经在~a字典中定义,使用@表达式重复定义无效。请检查以前的符号引用位置。" fn 'local) cyl-error-warning-list))
(if (not (car (find-dict-coding-list fn 'local)))
(begin
(append-new-coding-atexp fn '全局变量 0 '系统值常量 "#%系统缺省值")
(exit-handle-at (list (list '系统值常量 "#%系统缺省值" '变量@表达式) (- i 1) 'and表达式全局变量)))
(push (format "set-var-assign/at-aux->handle-at:~s已经在~a字典中定义,使用@表达式重复定义无效。请检查以前的符号引用位置。" fn 'local) cyl-error-warning-list))
))
((eq? at-st '全局局部函数定义@表达式)
(set! at-define-list (list at-st at-define-list fn par))
(exit-handle-at (list at-define-list (- i 1) 'at表达式全局局部函数定义)))
((and (= par 0)(eq? at-st '函数调用@表达式))
(exit-handle-at (list at-define-list (- i 1) 'at表达式无参函数调用)))
((and (= par 0)(eq? at-st '函数定义@表达式))
(if (eq? cyl-define-status 'func-define)
(exit-handle-at (list 'err i 'handle-at (format "不允许函数定义中嵌套函数定义。当前定义函数[~a][~a]。" cyl-current-define-function-name at-st)))
(begin
(run/err set-func-assign/at-aux)
(exit-handle-at (list at-define-list (- i 1) 'at表达式无参函数名定义)))))
((and (= par 0)(eq? at-st '变量@表达式))
(if (eq? cyl-define-status 'func-define)
(exit-handle-at (list at-define-list (- i 1) 'at表达式局部变量))
(exit-handle-at (list at-define-list (- i 1) 'at表达式全局变量))))
((and (= par 0)(eq? at-st '变量&表达式))
(exit-handle-at (list at-define-list (- i 1) 'and表达式外部变量)))
((and (> par 0)(eq? at-st '函数调用@表达式))
(exit-handle-at (list at-define-list (- i 1) 'at表达式缺省函数调用)))
((and (> par 0)(eq? at-st '函数定义@表达式))
(if (eq? cyl-define-status 'func-define)
(exit-handle-at (list 'err i 'handle-at (format "不允许函数定义中嵌套函数定义。当前定义函数[~a]。" cyl-current-define-function-name)))
(begin
(run/err set-func-assign/at-aux)
(exit-handle-at (list at-define-list (- i 1) 'at表达式函数名定义)))))
(else (exit-handle-at (list 'err i 'handle-at (format "[~a]与当前y表达式[~a]冲突,非法语法。" at-st fn))))
))
((char=? ch #\#)
;;(y-or-n "#-con1:i=~a\n" i)
(let-set! (res-str i st)(run/err get-cons-atexp s i))
;;(y-or-n "#-con2:res-str=~a,i=~a,st=~a\n" res-str i st)
(if (st-is st '赋值常量)
(begin
(if (not at-st) (set! at-st '变量@表达式))
(run/err set-var-assign/at-aux)
)
(if (st-is st '函数定义常量)
(begin
(if (not at-st) (set! at-st '函数定义@表达式))
(push (list st res-str) at-define-list)
;;(y-or-n "#constant:i=~a\n" i)
)
(exit-handle-at (list 'err loc 'handle-at (format "非赋值常量、函数定义常量[~a],不可以作为变量@表达式取值、函数定义@表达式取值." st))))))
((char=? ch #\")
(let-set! (res-str i st)(run/err get-str s i))
(if (eq? st '字符串)
(begin
(if (not at-st) (set! at-st '变量@表达式))
(run/err set-var-assign/at-aux)
)
(exit-handle-at (list 'err loc 'handle-at (format "非赋值常量[~a],不可以作为变量@表达式取值." st)))))
((char=? ch #\()
(if (not at-st)
(set! at-st '函数调用@表达式)
(exit-handle-at (list 'err i 'handle-at (format "当前状态[~a]后不支持(符号代表的缺省函数调用值。" at-st))))
(let-set! (res-str i st)(run/err get-default-func-cons s (+ i 1)))
(if (st-is st '赋值常量)
(begin
(run/err set-func-assign/at-aux)
)
(exit-handle-at (list 'err loc 'handle-at (format "非赋值常量[~a],不可以作为函数调用@表达式取值." st)))))
((char=? ch #\、)
(if (not (eq? at-st '函数定义@表达式))
(exit-handle-at (list 'err i 'handle-at (format "函数定义@表达式以外的@表达式[~a]不支持[、]分隔符。" at-st))))
)
((char=? ch #\@)
(if (not at-st)
(begin
(set! at-st '全局局部函数定义@表达式)
(push (list '全局局部函数) at-define-list)
)
(exit-handle-at (list 'err i 'handle-at (format "全局局部函数定义@表达式只支持@@形式。"))))
)
((char=? ch #\&)
(if (not at-st)
(set! at-st '变量&表达式)
(exit-handle-at (list 'err i 'handle-at (format "&表达式指示符号(&)必须紧跟在@符号后,否则语法错误。[~a]" at-st)))))
(else
;;(y-or-n "i=~a,at-define-list=~a\n" i at-define-list)
(let-set! (res-str res-par i st)(run/err get-yexp-fn s i))
;;(y-or-n "handle-at:get-yexp-fn:res-str=~a,i=~a,st=~a,at-st=~a\n" res-str i st at-st)
(if (st-is st '赋值常量)
(begin
(if (not at-st)
(set! at-st '变量@表达式)
)
(run/err set-var-assign/at-aux)
)
(begin
(if (not at-st)
(set! at-st '函数定义@表达式))
(if (not func-st)
(begin
(set! func-st '局部函数)
(push (list func-st res-str res-par) at-define-list)
)
(exit-handle-at (list 'err i 'handle-at (format "函数定义@表达式中局部函数定义信息只能在第一项,前面已经有函数定义信息[~a][~a][~a]。" at-define-list st func-st)))))))
)
;;(y-or-n "loop-end:i=~a\n" i)
)
(let ((i (string-length s))
)
(cond
((and (= par 0)(eq? at-st '函数调用@表达式))
(list at-define-list i 'at表达式缺省函数调用))
((and (= par 0)(eq? at-st '函数定义@表达式))
(if (eq? cyl-define-status 'func-define)
(list 'err i 'handle-at (format "不允许函数定义中嵌套函数定义。当前定义函数[~a]。" cyl-current-define-function-name))
(begin
(run/err set-func-assign/at-aux)
(list at-define-list i 'at表达式缺省函数名定义))))
((and (= par 0)(eq? at-st '变量@表达式))
(if (eq? cyl-define-status 'func-define)
(list at-define-list i 'at表达式局部变量)
(list at-define-list i 'at表达式全局变量)))
((and (= par 0)(eq? at-st '变量&表达式))
(list at-define-list i 'at表达式外部变量))
((and (> par 0)(eq? at-st '函数调用@表达式))
(list at-define-list i 'at表达式缺省函数调用))
((and (> par 0)(eq? at-st '函数定义@表达式))
(if (eq? cyl-define-status 'func-define)
(list 'err i 'handle-at (format "不允许函数定义中嵌套函数定义。当前定义函数[~a]。" cyl-current-define-function-name))
(begin
(run/err set-func-assign/at-aux)
(list at-define-list i 'at表达式函数名定义))))
(else (list 'err i 'handle-at (format "[~a]与当前y表达式[~a]冲突,非法语法。" at-st fn))))
)))
(define (rd-atexp-deli c)
(char=? c #\、))
(define (get-cons-atexp s n)
(if (char=? (string-ref s n) #\#)
(let* ((i (+ n 1))
(c (string-ref s i))
(st '常量引导符)
(len (string-length s))
)
(cond
((char=? c #\\)
(set! st '字符常量引导符)
(let* ((res (run/err get-符号-atexp s (+ i 1) (+ i 1) '开始))(str (nth 0 res))(l (nth 1 res))(cur-st (nth 2 res)))
(if (and (string? str) (or (= (string-length str) 1) (member str char-name-str-list)))
(begin
(set! str (string-append "#\\" str))
(list str l '字符常量))
(if (< (+ i 1) len)
(let ((c1 (string-ref s (+ i 1))))
(list (string-append "#\\" (string c1)) (+ i 1) '字符常量))
(list 'err i '非法常量 '字符串结尾处不完整字符常量)
))))
((char=? c #\")
(set! st '字符串常量引导符)
(let* ((res (run/err get-str s i))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
;;(set! i (- (+ str-len i) 1))
(if str
(list (string-append "#" str) i '字符串常量)
(list 'err i '非法常量 '未找到匹配的引号))))
((char=? c #\&)
(set! st '系统语言常量引导符)
(let* ((res (run/err get-sym-atexp s (+ i 1)))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
(if (and str (eq? st '词语)(member str cyl-defined-system-language))
(list (string-append "#&" str) i '系统语言常量)
(list 'err i '非法常量 '未定义系统语言常量))))
((char=? c #\%)
(set! st '系统值常量引导符)
(let* ((res (run/err get-sym-atexp s (+ i 1)))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
(if (and str (eq? st '词语)(member str cyl-defined-system-value))
(list (string-append "#%" str) i '系统值常量)
(list 'err i '非法常量 '未定义系统值常量))))
((char=? c #\$)
(set! st '系统处理常量引导符)
(let* ((res (run/err get-sym-atexp s (+ i 1)))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
(if (and str (eq? st '词语)(member str cyl-defined-system-handling))
(list (string-append "#$" str) i '系统处理常量)
(list 'err i '非法常量 '未定义系统处理常量))))
((char=? c #\')
(set! st '扩展常量引导符)
(let* ((res (run/err get-sym-atexp s (+ i 1)))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
(if (and str (eq? st '词语))
(list (string-append "#‘" str) i '扩展常量)
(list 'err i '非法常量 '非法扩展常量))))
((char=? c #\^)
(set! st '系统变量常数引导符)
(let* ((res (run/err get-sym s (+ i 1)))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
(if (and str (eq? st '词语))
(list (string-append "#^" str) i '系统变量常数)
(list 'err i '非法常量 '非法系统变量常数))))
((char=? c #\b)
(set! st '二进制常数引导符)
(let ((str (get-bin s (+ i 1))))
(if (string? str)
(list (string-append "#b" str) (+ (string-length str) n 1) '二进制常数)
(list 'err i '非法常量 '错误二进制常数))))
((char=? c #\o)
(set! st '八进制常数引导符)
(let ((str (get-oct s (+ i 1))))
(if (string? str)
(list (string-append "#o" str) (+ (string-length str)n 1) '八进制常数)
(list 'err i '非法常量 '错误八进制常数))))
((char=? c #\x)
(set! st '十六进制常数引导符)
(let ((str (get-hex s (+ i 1))))
(if str
(list (string-append "#x" str) (+ (string-length str)n 1) '十六进制常数)
(list 'err i '非法常量 '错误十六进制常数))))
((char=? c #\d)
(set! st '十进制常数引导符)
(let ((str (get-dec s (+ i 1))))
(if (string? str)
(list (string-append "#d" str) (+ (string-length str)n 1) '十进制常数)
(list 'err i '非法常量 '错误十进制常数))))
((char=? c #\*)
(set! st '存储长度引导符)
(let ((str (get-dec s (+ i 1))))
(if (string? str)
(list (string-append "#*" str) (+ (string-length str) n 1) '存储长度)
(list 'err i '非法常量 '错误存储长度))))
((char=? c #\#)
(set! st '单行注释引导符)
(let ((str (run/err rd-match-in s (+ i 1) #\newline)))
(if str
(list (string-append "##" str) (+ (string-length str) n 1) '单行注释)
(list 'err i '非法常量 '错误单行注释))))
((char=? c #\!)
(set! st '开发注释引导符)
(let ((str (run/err rd-match-in s (+ i 1) #\newline)))
(if str
(list (string-append "#!" str) (+ (string-length str) n 1) '开发注释)
(list 'err i '非法常量 '错误开发注释))))
((char=? c #\<)
(set! st '多行注释引导符)
(let ((str (run/err rd-match2-in s (+ i 1) #\# #\>)))
(if str
(list (string-append "#<" str) (+ (string-length str) n 1) '多行注释)
(list 'err i '非法常量 '错误多行注释))))
(else (let* ((res (run/err get-sym-atexp s i))(str (nth 0 res))(l (nth 1 res))(cur-st (nth 2 res)))
(cond
((and str (eq? cur-st '整数))
(list (string-append "#" str) l '十进制常数))
((and str (eq? cur-st '词语))
(list (string-append "#" str) l '扩展常量))
((and str (or (eq? cur-st '小数)(eq? cur-st '分数)(eq? cur-st '指数数)))
(list 'err l '非法常量 '错误十进制常数))
(else (list 'err l '非法常量 '错误扩展常量)))))
))
(list 'err n '非法常量 (format "[~a]未定义,非法#常量。" (string-ref s n)))))
(define (get-sym-atexp s n)
(get-符号-atexp s n n '开始)
)
(def/err (get-符号-atexp s m n st)
(let* ((len (string-length s))
(c (if (< n len)(string-ref s n)))
)
(cond
((or (>= n len)(rd-all-deli c)(rd-atexp-deli c))
(if (or (eq? st '整数)(eq? st '小数)(eq? st '分数)(eq? st '指数数)(eq? st '词语))
(list (substring s m n) (- n 1) st)
(begin
;;(err-msg "错误信息[get-符号][~a]:[~a]不是可用数值或标识符状态。" n st)
(list 'err (- n m) st 'get-符号-atexp '非法常量 (format "非法符号状态[~a]。" st)))))
((and (eq? st '开始)(or (rd-digit c)(rd-正负号 c)))
(let* ((res (get-数值 s m n st))(str (nth 0 res))(i (nth 1 res))(st (nth 2 res)))
(if (eq? str 'err)
(get-符号-atexp s m (+ n i 1) '词语)
(get-符号-atexp s m (+ n i 1) st))))
(else (set! st '词语)
(get-符号-atexp s m (+ n 1) st)))))
(def/err (get-yexp-fn s n)
(let ((str "")
(fn "")
(fn-l '())
(par-l '())
(res-str "")
(res-st #f)
(ls 0)
(rs 0)
(len (string-length s))
)
;;(y-or-n "get-yexp-fn:n=~a,s[n->]=~a\n" n (substring s n (string-length s)))
(tr-string (k cc s n)
;;(y-or-n "get-yexp-fn:k=~a,ls=~a,rs=~a,fn-l=~a,par-l=~a.\n" k ls rs fn-l par-l)
(cond
((or (rd-at-deli cc)(rd-atexp-deli cc))
(if (rd-at-deli cc) (set! k (- k 1)))
(cond
((and (= ls 0)(= rs 0)(st-is res-st '赋值常量))
(exit-get-yexp-fn (list res-str 0 k res-st)))
((and (= ls 0)(= rs 0)(eq? res-st '词语))
(exit-get-yexp-fn (list res-str 0 k '无参函数)))
((and (> ls 0)(= ls rs))
(exit-get-yexp-fn (list (merge-str k fn-l) (length par-l) k 'y表达式函数)))
(else
(exit-get-yexp-fn (list 'err k 'get-yexp-fn (format "左括号[~a]与右括号[~a]不相等1。[cc=~a]" ls rs cc))))
))
((rd-y-beg cc)
(set! ls (+ ls 1))
(if (<= (- ls rs) 1)
(if (< (+ k 1) len)
(begin
(let-set! (res-str k res-st)(get-sym-atexp s (+ k 1)))
(if (< (+ k 1) len)
(if (char=? (string-ref s (+ k 1)) #\])
(begin
(set! k (+ k 1))
(set! rs (+ rs 1))
(push res-str par-l)
(push "[*]" fn-l))
(exit-get-yexp-fn (list 'err (+ k 1) 'get-yexp-fn (format "@表达式中需要中括号配对出现,[~a]作为分隔符不合法。" (string-ref s (+ k 1))))))
(exit-yexp-fn (list 'err k 'get-yexp-fn (format "当前位置[~a]已经达到字符串结尾。仍未匹配中括号。" k))))))
(exit-get-yexp-fn (list 'err k 'get-yexp-fn (format "表达式不是一阶y表达式。[ls=~a:rs=~a]" ls rs)))))
((rd-y-end cc)
(set! rs (+ rs 1))
(exit-get-yexp-fn (list 'err k 'get-yexp-fn (format "表达式中右括号[~a]多于左括号[~a]。" rs ls))))
(else
(let-set! (res-str k res-st)(run/err get-sym-atexp s k))
(push res-str fn-l)))
)
(let ((k (string-length s))
)
;;(y-or-n "get-yexp-fn:ls=~a,rs=~a,fn-l=~a,par-l=~a.\n" ls rs fn-l par-l)
(cond
((and (= ls 0)(= rs 0)(st-is res-st '赋值常量))
(exit-get-yexp-fn (list res-str 0 k res-st)))
((and (= ls 0)(= rs 0)(eq? res-st '词语))
(exit-get-yexp-fn (list res-str 0 k '无参函数)))
((and (> ls 0)(= ls rs))
(exit-get-yexp-fn (list (merge-str k fn-l) (length par-l) k 'y表达式函数)))
(else
(exit-get-yexp-fn (list 'err k 'get-yexp-fn (format "左括号[~a]与右括号[~a]不相等2。" ls rs))))
))
))
(def/err (get-default-func-cons s n)
(let ((res-str "")
(res-st #f)
(c (string-ref s n))
(i n)
)
(cond
((char=? c #\#)
(let-set! (res-str i res-st)(run/err get-cons s i))
(if (st-is res-st '赋值常量)
(if (char=? (string-ref s (+ i 1)) #\))
(list res-str (+ i 1) res-st)
(list 'err (+ i 1) 'get-default-func-cons (format "[~a]不是右小括号,非法缺省函数@表达式。" (substring s (+ i 1)(+ i 2)))))
(list 'err i 'get-default-func-cons (format "[~a]不是赋值常量,非法缺省函数@表达式。 " res-st))))
((char=? c #\")
(let-set! (res-str str-len res-st)(run/err get-str s i))
(set! i (- (+ str-len i) 1))
(if (eq? res-st '字符串)
(if (char=? (string-ref s (+ i 1)) #\))
(list res-str (+ i 1) res-st)
(list 'err (+ i 1) 'get-default-func-cons (format "[~a]不是右小括号,非法缺省函数@表达式。" (substring s (+ i 1)(+ i 2)))))
(list 'err i 'get-default-func-cons (format "[~a]不是字符串,非法缺省函数@表达式。 " res-st))))
(else
(let-set! (res-str i res-st)(run/err get-sym s i))
(if (st-is res-st '赋值常量)
(if (char=? (string-ref s (+ i 1)) #\))
(list res-str (+ i 1) res-st)
(list 'err (+ i 1) 'get-default-func-cons (format "[~a]不是右小括号,非法缺省函数@表达式。" (substring s (+ i 1)(+ i 2)))))
(list 'err i 'get-default-func-cons (format "[~a]不是赋值常量,非法缺省函数@表达式。 " res-st))))
)))
(define (append-parent-new-coding-atexp s typ n at-typ at-val)
(let ((cur-count (+ (cadr cyl-local-symbol-coding-count) 1)))
(if (not (search-dict-member s cyl-parent-symbol-dict-list))
(begin
(push (list s typ (list 'local cur-count) n n at-typ at-val) cyl-parent-symbol-dict-list)
(set! cyl-local-symbol-coding-count (list 'local cur-count))
cyl-local-symbol-coding-count
)
)))
(define (append-new-coding-atexp s typ n at-typ at-val)
(let ((cur-count (+ (cadr cyl-local-symbol-coding-count) 1)))
(cond
((and (or (eq? typ '参数变量)(eq? typ '局部变量)(eq? typ '局部别名))(not (search-dict-member s cyl-local-symbol-dict-list)))
(push (list s typ (list 'local cur-count) 0 0 at-typ at-val) cyl-local-symbol-dict-list)
(set! cyl-local-symbol-coding-count (list 'local cur-count))
cyl-local-symbol-coding-count
)
((and (or (eq? typ '无参局部函数)(eq? typ '局部函数))(not (search-dict-member s cyl-local-symbol-dict-list)))
(push (list s typ (list 'local cur-count) n n at-typ at-val) cyl-local-symbol-dict-list)
(set! cyl-local-symbol-coding-count (list 'local cur-count))
cyl-local-symbol-coding-count
)
((and (or (eq? typ '全局别名)(eq? typ '全局变量))(not (search-dict-member s cyl-current-symbol-dict-list)))
(push (list s typ (list 'local cur-count) 0 0 at-typ at-val) cyl-current-symbol-dict-list)
(set! cyl-local-symbol-coding-count (list 'local cur-count))
cyl-local-symbol-coding-count
)
((and (or (eq? typ '函数)(eq? typ '全局局部函数)(eq? typ '缺省函数))(not (search-dict-member s cyl-current-symbol-dict-list)))
(push (list s typ (list 'local cur-count) n n at-typ at-val) cyl-current-symbol-dict-list)
(set! cyl-local-symbol-coding-count (list 'local cur-count))
cyl-local-symbol-coding-count
)
((and (eq? typ '无参函数)(not (search-dict-member s cyl-current-symbol-dict-list)))
(push (list s typ (list 'local cur-count) 0 0 at-typ at-val) cyl-current-symbol-dict-list)
(set! cyl-local-symbol-coding-count (list 'local cur-count))
cyl-local-symbol-coding-count
)
((and (eq? typ '无限变量函数)(not (search-dict-member s cyl-current-symbol-dict-list)))
(push (list s '函数 (list 'local cur-count) n 'inf) cyl-current-symbol-dict-list)
(set! cyl-local-symbol-coding-count (list 'local cur-count))
cyl-local-symbol-coding-count
)
(else #f))))
(define (append-coding-atexp s coding typ n at-typ at-val)
(cond
((and (or (eq? typ '参数变量)(eq? typ '局部变量)(eq? typ '别名))(not (search-dict-member s cyl-local-symbol-dict-list)))
(push (list s typ coding 0 0 at-typ at-val) cyl-local-symbol-dict-list)
)
((and (or (eq? typ '无参局部函数)(eq? typ '局部函数))(not (search-dict-member s cyl-local-symbol-dict-list)))
(push (list s typ coding n n at-typ at-val) cyl-local-symbol-dict-list)
)
((and (eq? typ '全局变量)(not (search-dict-member s cyl-current-symbol-dict-list)))
(push (list s typ coding 0 0 at-typ at-val) cyl-current-symbol-dict-list)
)
((and (or (eq? typ '函数)(eq? typ '关键字函数)(eq? typ '全局局部函数)(eq? typ '缺省函数))(not (search-dict-member s cyl-current-symbol-dict-list)))
(push (list s typ coding n n at-typ at-val) cyl-current-symbol-dict-list)
)
((and (eq? typ '无参函数)(not (search-dict-member s cyl-current-symbol-dict-list)))
(push (list s typ coding 0 0 at-typ at-val) cyl-current-symbol-dict-list)
)
((and (eq? typ '无限参数函数)(not (search-dict-member s cyl-current-symbol-dict-list)))
(push (list s '函数 coding n 'inf) cyl-current-symbol-dict-list)
)
(else #f)))
(define (append-parent-coding-atexp s coding typ n at-typ at-val)
(cond
((and (or (eq? typ '参数变量)(eq? typ '局部变量)(eq? typ '别名))(not (search-dict-member s cyl-parent-symbol-dict-list)))
(push (list s typ coding 0 0 at-typ at-val) cyl-parent-symbol-dict-list)
)
((and (or (eq? typ '无参局部函数)(eq? typ '局部函数))(not (search-dict-member s cyl-parent-symbol-dict-list)))
(push (list s typ coding n n at-typ at-val) cyl-parent-symbol-dict-list)
)
(else #f)))
(define (search-at-define-list s l)
(let ((res #f))
(tr-list (i e l 0)
(let ((typ (nth 0 e))
(val (nth 1 e))
)
(if (and (eq? typ '系统处理常量)(string? val)(string=? val s))
(set! res #t))))
res))
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
Scheme
1
https://gitee.com/jianchiyiye/cylisp.git
git@gitee.com:jianchiyiye/cylisp.git
jianchiyiye
cylisp
cylisp
master

搜索帮助