code accumulator

[swizard]

В копилку scheme-кода: написал макрос для одного товарища с лора, который генерит код из строки (http://www.linux.org.ru/view-message.jsp?msgid=2175324):

#;49> (execve->lisp "{+ 3 4 {- 10 2} 7}")
22

#;50> (execve->lisp "{define f {lambda {x} {* x 2}}}")
#;51> (f 4)
8

Обожаю схему, просто приятно писать программы :)



(require 'regex)

(define-macro (execve->lisp expr)
(car (parse-list expr)))

(define parse-list
(lambda (terms-list)
(parse-list-ready (skip-leading-whitespaces terms-list))))

(define skip-leading-whitespaces
(lambda (string) (string-substitute "^\\s+" "" string)))

(define parse-list-ready
(lambda (terms-list)
(if (zero? (string-length terms-list))
'()
(let ((first-term-proc (extract-first-term terms-list)))
(first-term-proc
(lambda (first-term rest-terms)
(cons first-term (parse-list rest-terms))))))))

(define extract-first-term
(lambda (terms-list)
(if (char=? #\{ (string-ref terms-list 0))
(extract-function terms-list)
(extract-term terms-list))))

(define extract-function
(lambda (terms-list)
(let ((function-end-index (search-closing-paren terms-list 1)))
(lambda (proc)
(proc (parse-list (string-copy terms-list
1
(- function-end-index 1)))
(string-copy terms-list
function-end-index
(string-length terms-list)))))))

(define search-closing-paren
(lambda (string index)
(search-closing-paren-count string index 1)))

(define search-closing-paren-count
(lambda (string index count)
(if (zero? count)
index
(let ((current (string-ref string index)))
(search-closing-paren-count
string
(+ index 1)
(cond
((char=? #\{ current) (+ count 1))
((char=? #\} current) (- count 1))
(else count)))))))

(define extract-term
(lambda (terms-list)
(let ((term-match (string-match "^(\\S+).*" terms-list)))
(lambda (proc)
(proc (string->scheme (cadr term-match))
(string-substitute "^(\\S+)"
""
terms-list))))))

(define string->scheme
(lambda (string)
(if (string-match "^\\d+$" string)
(string->number string)
(string->symbol string))))