add field access support (also unfuck tree walker a bit)
This commit is contained in:
74
sexc.scm
74
sexc.scm
@@ -45,57 +45,73 @@
|
|||||||
(eq? (car node) symbol))
|
(eq? (car node) symbol))
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
|
(define (make-field-access form)
|
||||||
|
(assert (= 2 (length form)) "Wrong field access format")
|
||||||
|
(unkebabify
|
||||||
|
(string->symbol
|
||||||
|
(fmt #f (cadr form) (car form)))))
|
||||||
|
|
||||||
(define (walk-generic form acc)
|
(define (walk-generic form acc)
|
||||||
(if (eq? (car form) 'unquote)
|
(cond
|
||||||
;; special case - replace top-level unquote with it's expansion
|
((null? form) (cons '() acc))
|
||||||
(append
|
((not (list? form)) (cons (atom-to-fmt-c form) acc))
|
||||||
(fold append (list)
|
|
||||||
(map (fn (walk-sex-tree x (list)))
|
;; special case - replace unquote with its expansion
|
||||||
(eval (cadr form))))
|
((eq? (car form) 'unquote)
|
||||||
acc)
|
(fold
|
||||||
(let loop ((unquote-form (tree-find (tree-finder 'unquote) form #f)))
|
cons
|
||||||
(if unquote-form
|
acc
|
||||||
(begin
|
(car ; bc walk-sex-tree always
|
||||||
(let* ((inv (invert-tree form))
|
; wraps its result
|
||||||
(pos (tree-local-position inv unquote-form)))
|
(walk-sex-tree (eval (cadr form)) (list)))))
|
||||||
(for-each (fn
|
|
||||||
(set! form (tree-insert inv (tree-parent inv unquote-form) pos x))
|
;; another special case - field access
|
||||||
(set! inv (invert-tree form)))
|
((and (symbol? (car form))
|
||||||
(reverse (eval (cadr unquote-form))))
|
(char=? #\. (string-ref (symbol->string (car form)) 0)))
|
||||||
(set! form (tree-prune inv unquote-form)))
|
(cons (make-field-access form) acc))
|
||||||
(loop (tree-find (tree-finder 'unquote)
|
;; toplevel, or a start of a regular list form
|
||||||
form
|
(else
|
||||||
#f)))
|
(let ((new-acc (list)))
|
||||||
(cons (tree-map atom-to-fmt-c form) acc)))))
|
(cons (reverse
|
||||||
|
(fold
|
||||||
|
walk-generic
|
||||||
|
new-acc
|
||||||
|
form))
|
||||||
|
acc)))))
|
||||||
|
|
||||||
(define (walk-function form static acc)
|
(define (walk-function form static acc)
|
||||||
(if static
|
(if static
|
||||||
(walk-generic (list 'static form) acc)
|
(append (walk-generic (list 'static form) (list)) acc)
|
||||||
(walk-generic (cdr form) acc)))
|
(append (walk-generic (cdr form) (list)) acc)))
|
||||||
|
|
||||||
(define (walk-struct form acc)
|
(define (walk-struct form acc)
|
||||||
(let ((name (unkebabify (cadr form))))
|
(let ((name (unkebabify (cadr form))))
|
||||||
(walk-generic form (cons `(typedef struct ,name ,name) acc))))
|
(append (walk-generic form (list))
|
||||||
|
(cons `(typedef struct ,name ,name) acc))))
|
||||||
|
|
||||||
(define (walk-sex-tree form acc)
|
(define (walk-sex-tree form acc)
|
||||||
(case (car form)
|
(case (car form)
|
||||||
((fn) (walk-function form #t acc))
|
((fn) (walk-function form #t acc))
|
||||||
((pub) (walk-function form #f acc))
|
((pub) (walk-function form #f acc))
|
||||||
((struct) (walk-struct form acc))
|
((struct union) (walk-struct form acc))
|
||||||
(else (walk-generic form acc))))
|
((unquote) (fold (fn (walk-sex-tree x y))
|
||||||
|
acc
|
||||||
|
(eval (cadr form))))
|
||||||
|
|
||||||
|
(else (append (walk-generic form (list)) acc))))
|
||||||
|
|
||||||
(define (process-form form acc)
|
(define (process-form form acc)
|
||||||
(case (car form)
|
(case (car form)
|
||||||
((define) (eval form) acc)
|
((define) (eval form) acc)
|
||||||
((template) (eval form) acc)
|
((template) (eval form) acc)
|
||||||
((load) (eval form) acc)
|
((load) (eval form) acc)
|
||||||
((instance) (walk-sex-tree (eval form) acc))
|
|
||||||
(else
|
(else
|
||||||
(walk-sex-tree form acc))))
|
(walk-sex-tree form acc))))
|
||||||
|
|
||||||
|
|
||||||
(define (process-raw-forms raw-forms acc)
|
(define (process-raw-forms raw-forms acc)
|
||||||
(if (null? raw-forms) (filter (fn (not (null? x)))
|
(if (null? raw-forms)
|
||||||
(reverse acc))
|
(reverse acc)
|
||||||
(process-raw-forms (cdr raw-forms)
|
(process-raw-forms (cdr raw-forms)
|
||||||
(process-form (car raw-forms) acc))))
|
(process-form (car raw-forms) acc))))
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user