rewrite tree walk with tree module

also add pub support
This commit is contained in:
2025-06-05 17:11:30 +03:00
parent dd9765bd62
commit 39e1e4a664
4 changed files with 70 additions and 73 deletions

View File

@@ -14,7 +14,7 @@ By the way, there's a way to make Chicken install eggs non-globally. Refer to
the documentation for more info:
https://wiki.call-cc.org/man/5/Extension%20tools#changing-the-repository-location
~chicken-install fmt getopt-long~
~chicken-install fmt getopt-long brev-separate~
** Compilation
~make~
@@ -38,7 +38,7 @@ The Sex source:
(define (foo)
"Hello from Chicken code!\n")
(fn int main ((int argc) (char **argv))
(pub fn int main ((int argc) (char **argv))
(puts "Hello from Sex!")
(var (array char 512) name)
(puts "What is your name?")

View File

@@ -3,7 +3,7 @@
(define (foo)
"Hello from Chicken code!\n")
(fn int main ((int argc) (char **argv))
(pub fn int main ((int argc) (char **argv))
(puts "Hello from Sex!")
(var (array char 512) name)
(puts "What is your name?")

View File

@@ -30,6 +30,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map.")
(list (concat "("
(regexp-opt '("include"
"fn"
"pub"
"struct"
"template"
"var")

112
sexc.scm
View File

@@ -1,42 +1,19 @@
(import (chicken pretty-print)
(import brev-separate
(chicken pretty-print)
(chicken process-context)
(chicken string)
fmt
fmt-c
getopt-long
srfi-1 ; list routines
)
tree)
(define (unkebabify sym)
(string->symbol
(string-translate (symbol->string sym) #\- #\_)))
; Maybe rewrite with tree inversions?
(define (map-filter-tree map-proc filter-proc tree)
"Walk the tree, checking each element with filter-proc.
If filter-proc returns #t:
- if the element is list, process it recursively,
- if the element is an atom, process it with map-proc.
If filter-proc returns #f, ignore the element.
If filter-proc returns something other, use it instead of processing the element."
(let ((cont (cut map-filter-tree map-proc filter-proc <>)))
(if (null? tree) '()
(let ((filter-res (filter-proc (car tree))))
(case filter-res
((#t) (cons
(if (atom? (car tree))
(map-proc (car tree))
(cont (car tree)))
(cont (cdr tree))))
((#f) (cont (cdr tree)))
(else (cons filter-res (cont (cdr tree)))))))))
(define (walk-tree tree)
(map-filter-tree
(lambda (elem)
(case elem
(define (atom-to-fmt-c atom)
(case atom
((fn) '%fun)
((var) '%var)
((begin) '%begin)
@@ -46,36 +23,55 @@ If filter-proc returns something other, use it instead of processing the element
((include) '%include)
((cast) '%cast)
(else
(if (symbol? elem)
(unkebabify elem)
elem))))
(lambda (subtree)
(if (list? subtree)
(case (car subtree)
((unquote)
(eval (cadr subtree)))
(else #t))
#t))
tree))
(if (symbol? atom)
(unkebabify atom)
atom))))
(define (read-forms collect)
(call/cc
(lambda (return)
(read-forms
(cons
(let ((r (read)))
(when (eof-object? r)
(return (filter (lambda (e) (not (null? e)))
(reverse collect))))
(case (car r)
(define (tree-finder symbol)
(lambda (node)
(or (and (tree? node)
(eq? (car node) symbol))
#f)))
(define (walk-generic form)
(let loop ((tree (tree-map atom-to-fmt-c form)))
(let ((unquote-form (tree-find (tree-finder 'unquote) tree #f)))
(if unquote-form
(let ((inv (invert-tree tree)))
(loop (tree-replace inv unquote-form (eval (cadr unquote-form)))))
tree))))
(define (walk-function form static)
(if static
(list 'static (walk-generic form))
(walk-generic (cdr form))))
(define (walk-sex-tree form)
(case (car form)
((fn) (walk-function form #t))
((pub) (walk-function form #f))
((template) '()) ; TODO
((struct) (walk-generic form))
(else (walk-generic form))))
(define (process-form form)
(case (car form)
((define)
(eval r)
'())
(eval form) '())
(else
(let ((result (walk-tree r)))
(if result result
'())))))
collect)))))
(walk-sex-tree form))))
(define (process-raw-forms raw-forms acc)
(if (null? raw-forms) (filter (fn (not (null? x)))
(reverse acc))
(process-raw-forms (cdr raw-forms)
(cons (process-form (car raw-forms))
acc))))
(define (read-forms acc)
(let ((r (read)))
(if (eof-object? r) (reverse acc)
(read-forms (cons r acc)))))
(define (emit-c forms)
(map (lambda (form)
@@ -127,12 +123,12 @@ If filter-proc returns something other, use it instead of processing the element
(help (help-arg? args))
(input (get-input-file args)))
(if help (print-help)
(let ((sex-forms
(let* ((raw-forms
(if (eq? input 'stdin)
(read-forms (list))
(with-input-from-file input
(lambda () (read-forms (list)))))))
(lambda () (read-forms (list))))))
(sex-forms (process-raw-forms raw-forms (list))))
(if (get-arg args 'macro-expand #f)
(map pp sex-forms)
(if (not (eq? output 'stdout))