1
0
forked from alex-eg/sex

add field access support (also unfuck tree walker a bit)

This commit is contained in:
2025-06-12 23:40:35 +03:00
parent f767a80700
commit 3cce26dc5c

View File

@@ -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))))