diff --git a/Readme.org b/Readme.org index 7097ebf..3682b28 100644 --- a/Readme.org +++ b/Readme.org @@ -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?") diff --git a/hello-world.sex b/hello-world.sex index 7d0592a..bd1e22f 100644 --- a/hello-world.sex +++ b/hello-world.sex @@ -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?") diff --git a/sex-mode.el b/sex-mode.el index 6b860cc..0d542e2 100644 --- a/sex-mode.el +++ b/sex-mode.el @@ -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") diff --git a/sexc.scm b/sexc.scm index b027d85..ce1d126 100644 --- a/sexc.scm +++ b/sexc.scm @@ -1,81 +1,77 @@ -(import (chicken pretty-print) +(import brev-separate + (chicken pretty-print) (chicken process-context) (chicken string) fmt fmt-c getopt-long - srfi-1 ; list routines - ) + 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. +(define (atom-to-fmt-c atom) + (case atom + ((fn) '%fun) + ((var) '%var) + ((begin) '%begin) + ((pointer) '%pointer) + ((array) '%array) + (([]) 'vector-ref) + ((include) '%include) + ((cast) '%cast) + (else + (if (symbol? atom) + (unkebabify atom) + atom)))) -If filter-proc returns #f, ignore the element. +(define (tree-finder symbol) + (lambda (node) + (or (and (tree? node) + (eq? (car node) symbol)) + #f))) -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-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-tree tree) - (map-filter-tree - (lambda (elem) - (case elem - ((fn) '%fun) - ((var) '%var) - ((begin) '%begin) - ((pointer) '%pointer) - ((array) '%array) - (([]) 'vector-ref) - ((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)) +(define (walk-function form static) + (if static + (list 'static (walk-generic form)) + (walk-generic (cdr form)))) -(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) - (eval r) - '()) - (else - (let ((result (walk-tree r))) - (if result result - '()))))) - collect))))) +(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 form) '()) + (else + (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 - (if (eq? input 'stdin) - (read-forms (list)) - (with-input-from-file input - (lambda () (read-forms (list))))))) - + (let* ((raw-forms + (if (eq? input 'stdin) + (read-forms (list)) + (with-input-from-file input + (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))