diff --git a/Readme.org b/Readme.org index 4385042..b57864a 100644 --- a/Readme.org +++ b/Readme.org @@ -1,18 +1,20 @@ * The Sex language Sex is a S-expressions language, which transpiles to C. -* Compilation and usage -Sex is written in Chicken Scheme, so first you'll need to get yourself -a Chicken. +Sex is also Chicken, since all source processing and compile-time +computations are written in Chicken. -It also has a couple of Chicken deps. +And Chicken is R5RS Scheme. + +* Compilation and usage +First, get yourself a Chicken. Second, one Chicken deps. ** Install Chicken Eggs 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 tree brev-separate~ +~chicken-install fmt~ ** Compilation ~make~ @@ -24,6 +26,43 @@ cat hello-world.sex | sexc > hello_world.c cc hello_world.c -o hello_world #+end_src +* Example +Here is an example, demonstrating what Sex source looks like, and what +it compiles too. An avid reader also shall notice how we call Chicken +procedures in Sex source. + +The Sex source: +#+begin_src +(include stdio.h) + +(define (foo) + "Hello from Chicken code!\n") + +(fn int main ((int argc) (char **argv)) + (puts "Hello from Sex!") + (var (array char 512) name) + (puts "What is your name?") + (scanf "%s" &name) + (printf "Hello, %s!\n" name) + (printf ,(foo)) + 0) +#+end_src + +The resulting C source: +#+begin_src +#include + +int main (int argc, char **argv) { + puts("Hello from Sex!"); + char name[512]; + puts("What is your name?"); + scanf("%s", &name); + printf("Hello, %s!\n", name); + printf("Hello from Chicken code!\n"); + return 0; +} +#+end_src + * Features ** Full C interoperability Just ~(include "Your/Favourite/Library.h")~ and use it as you would diff --git a/hello-world.sex b/hello-world.sex index 23cd6ad..7d0592a 100644 --- a/hello-world.sex +++ b/hello-world.sex @@ -1,10 +1,13 @@ (include stdio.h) -(include unistd.h) + +(define (foo) + "Hello from Chicken code!\n") (fn int main ((int argc) (char **argv)) (puts "Hello from Sex!") - (var (array char 513) name) + (var (array char 512) name) (puts "What is your name?") (scanf "%s" &name) (printf "Hello, %s!\n" name) + (printf ,(foo)) 0) diff --git a/sexc.scm b/sexc.scm index 16262cc..ad2ca86 100644 --- a/sexc.scm +++ b/sexc.scm @@ -1,33 +1,71 @@ -(import brev-separate fmt fmt-c tree (chicken string)) +(import fmt fmt-c (chicken string)) (define (unkebabify sym) (string->symbol (string-translate (symbol->string sym) #\- #\_))) +(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)))) + ;(fmt #t "Filter res for " tree " is " filter-res "\n") + (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 + ((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 (loop) - (let ((r (read))) - (unless (eof-object? r) - (cond ((eqv? (car r) 'define) (eval r)) - (#t - (fmt #t - (c-expr - (tree-map - (fn - (case x - ((fn) '%fun) - ((var) '%var) - ((begin) '%begin) - ((pointer) '%pointer) - ((array) '%array) - (([]) 'vector-ref) - ((include) '%include) - ((cast) '%cast) - (else - (if (symbol? x) - (unkebabify x) - x)))) - r))) - (fmt #t "\n"))) - (loop)))) + (call/cc + (lambda (return) + (let ((r (read))) + (when (eof-object? r) + (return '())) + (case (car r) + ((define) + (eval r) + (fmt #t "\n")) + (else + (let ((result (walk-tree r))) + (when result + (fmt #t (c-expr + result)))))) + (loop))))) (loop)