diff --git a/Makefile b/Makefile index 9ae4fab..eb30c48 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ CHICKEN_C = csc -MODULES = sexc sex-macros sex-modules utils fmt-c +MODULES = sexc fmt-c fmt-c-writer semen sex-macros sex-modules sex-reader utils OBJ = $(MODULES:%=%.o) sexc: main.o $(OBJ) diff --git a/Readme.org b/Readme.org index d08d78e..9cb2da9 100644 --- a/Readme.org +++ b/Readme.org @@ -12,7 +12,7 @@ to export ~CHICKEN_INSTALL_REPOSITORY~ and ~CHICKEN_REPOSITORY_PATH~ environment variables. 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 brev-separate test tree srfi-1 srfi-13~ +~chicken-install fmt getopt-long brev-separate test tree srfi-1 srfi-13 srfi-69 matchable~ ** Compilation ~make~ diff --git a/example/fns.sex b/example/fns.sex new file mode 100644 index 0000000..73aa0b2 --- /dev/null +++ b/example/fns.sex @@ -0,0 +1,10 @@ +;;; Prototypes +(fn void puk ()) + +(pub fn void plak ()) + +;;; Functions +(fn int foo () (return 1)) + +(pub fn void bar ((int a) (int b)) + (printf "%d\n" (+ a b))) diff --git a/example/list.sex b/example/list.sex index 5cddb77..bac0941 100644 --- a/example/list.sex +++ b/example/list.sex @@ -2,10 +2,10 @@ (let ((list-type (cat 'list- type))) `(struct ,list-type ((,type value) - ((* ,list-type) next))))) + ((* (struct ,list-type)) next))))) (pub defmacro (make-list-T type is-public?) - (let ((list-type (cat 'list- type)) + (let ((list-type (list 'struct (cat 'list- type))) (fn-name (cat 'make-list- type))) `(,@(if is-public? '(pub) '()) fn (* ,list-type) ,fn-name () (var (* ,list-type) list (cast (* ,list-type) (malloc (sizeof ,list-type)))) @@ -13,7 +13,7 @@ (return list)))) (pub defmacro (add-value-list-T type is-public?) - (let ((list-type (cat 'list- type)) + (let ((list-type (list 'struct (cat 'list- type))) (fn-name (cat 'add-value-list- type))) `(,@(if is-public? '(pub) '()) fn void ,fn-name ((,list-type *list) (,type value)) (while (!= (-> list next) NULL) @@ -23,7 +23,7 @@ (pub defmacro (length-list-T type is-public?) (let ((fn-name (cat 'length-list- type)) - (list-type (cat 'list- type))) + (list-type (list 'struct (cat 'list- type)))) `(,@(if is-public? '(pub) '()) fn size-t ,fn-name ((,list-type *list)) (var size-t n 0) (while (!= (-> list next) NULL) @@ -33,15 +33,15 @@ (pub defmacro (is-empty-list-T type is-public?) `(,@(if is-public? '(pub) '()) fn bool ,(cat 'is-empty-list- type) - ((,(cat 'list- type) *list)) + ((,(list 'struct (cat 'list- type)) *list)) (return (== (-> list next) NULL)))) (pub defmacro (list-for-each list-type list-var elt-type elt-var what-do) (let ((list-var-2 (cat list-var '-2))) - `((begin - (var (pointer ,list-type) ,list-var-2 ,list-var) - (var ,elt-type ,elt-var (-> ,list-var-2 value)) - (while (!= (-> ,list-var-2 next) NULL) - ,what-do - (= ,list-var-2 (-> ,list-var-2 next)) - (= ,elt-var (-> ,list-var-2 value))))))) + `(begin + (var (pointer ,list-type) ,list-var-2 ,list-var) + (var ,elt-type ,elt-var (-> ,list-var-2 value)) + (while (!= (-> ,list-var-2 next) NULL) + ,what-do + (= ,list-var-2 (-> ,list-var-2 next)) + (= ,elt-var (-> ,list-var-2 value)))))) diff --git a/example/test-list.sex b/example/test-list.sex index c4af345..3685c17 100644 --- a/example/test-list.sex +++ b/example/test-list.sex @@ -2,20 +2,15 @@ (include stddef.h) (include stdio.h) -(chicken-import srfi-1 brev-separate) ; list routines, e.g. fold - (import list) -(chicken-define (imports-test a b c) - (fold + 0 (list 1 2 3 a b c))) - (struct foo ((float a-field) (int b) ((const char *) c) ((fn bool ((bool val))) not))) -(var foo f) +(var (struct foo) f) (list-T int) (make-list-T int #f) @@ -24,7 +19,6 @@ (is-empty-list-T int #f) (extern fn void puk ((int a) (float b))) -(fn int bar () (return ,(imports-test 10 20 30))) (pub fn bool baz () (return true)) (extern var int i) @@ -32,18 +26,18 @@ (pub var int k) (pub fn int main () - (var (* list-int) l (make-list-int)) + (var (struct list-int) *l (make-list-int)) (printf "Size of the list: %lu\n" (length-list-int l)) (add-value-list-int l 3) (add-value-list-int l 4) (printf "Size of the list: %lu\n" (length-list-int l)) - (list-for-each list-int l int v + (list-for-each (struct list-int) l int v (printf "%d " v)) (printf "\n") (printf "Size of the list: %lu\n" (length-list-int l)) (printf "%p\n" (cast void* l->next)) (return 0)) -(pub fn void print-list (((const list-int) *l)) - (list-for-each (const list-int) l int v (printf "%d " v)) +(pub fn void print-list (((const struct list-int) *l)) + (list-for-each (const struct list-int) l int v (printf "%d " v)) (printf "\n")) diff --git a/fmt-c-writer.scm b/fmt-c-writer.scm new file mode 100644 index 0000000..3682e5b --- /dev/null +++ b/fmt-c-writer.scm @@ -0,0 +1,128 @@ +;;; Sex fmt-c output writer + +(declare (unit fmt-c-writer) + (uses fmt-c + semen)) + +(import (chicken string) + brev-separate + fmt + regex + srfi-1 ; lists + srfi-13 ; strings + ) + +(define (unkebabify sym) + (case sym + ((-) sym) + ((--) sym) + ((->) sym) + ((-=) sym) + (else + (string->symbol + (string-substitute "-(?!>)" "_" + (symbol->string sym) #t))))) + +(define (atom-to-fmt-c atom) + (case atom + ((fn) '%fun) + ((prototype) '%prototype) + ((var) '%var) + ((begin) '%block-begin) + ((define) '%define) + ((pointer) '%pointer) + ((array) '%array) + ((attribute) '%attribute) + ((@) 'vector-ref) + ((include) '%include) + ((cast) '%cast) + ;; uh things we do for c89 compatibility + ((bool) 'int) + ((true) 1) + ((false) 0) + (else + (if (symbol? atom) + (unkebabify atom) + atom)))) + +(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) + (cond + ((null? form) (cons '() acc)) + + ;; vector, e.g. {}-initializer + ((vector? form) + (cons + (list->vector + (car (walk-generic (vector->list form) (list)))) + acc)) + + ;; atom (hopefully) + ((not (list? form)) (cons (atom-to-fmt-c form) acc)) + + ;; another special case - field access + ((and (symbol? (car form)) + (char=? #\. (string-ref (symbol->string (car form)) 0))) + (cons (make-field-access form) acc)) + + ;; toplevel, or a start of a regular list form + (else + (let ((new-acc (list))) + (cons (fold-right + walk-generic + new-acc + form) + acc))))) + +(define (normalize-fn-form form) + ;; (fn ret-type name arglist body) -> normal function + ;; (fn ret-type name arglist) -> prototype + (if (>= (length form) 5) + form + (cons 'prototype (cdr form)))) + +(define (walk-function form static) + (if static + (walk-generic (list 'static (normalize-fn-form form)) + (list)) + (walk-generic (normalize-fn-form (cdr form)) + (list)))) + +(define (walk-extern form) + (case (cadr form) + ((fn) + (list (cons 'extern (walk-function form #f)))) + ((var) + (list (cons 'extern (walk-generic (cdr form) (list))))) + (else (error "Extern what?")))) + +(define (walk-public form) + (case (cadr form) + ((fn) + (walk-function form #f)) + ((var) + (walk-generic (list 'static (cdr form)) (list))) + ((define defmacro import include struct typedef union var) + ;; ignore here, used in generating public interface + (process-toplevel-form (cdr form))) + (else + (error "Pub what?" (cadr form))))) + +(define (process-toplevel-form form) + ;; todo: rewrite to match + (case (car form) + ((fn) (walk-function form #t)) + ((extern) (walk-extern form)) + ((pub) (walk-public form)) + (else (walk-generic form (list))))) + +(define (emit-c sex-forms) + (for-each (lambda (form) + (fmt #t (c-expr (car (process-toplevel-form form))) nl)) + sex-forms)) diff --git a/semen.scm b/semen.scm new file mode 100644 index 0000000..92e3919 --- /dev/null +++ b/semen.scm @@ -0,0 +1,141 @@ +;;; Sex semantic engine + +(declare (unit semen) + (uses sex-macros + sex-modules)) + +(import fmt + matchable ; pattern matching + srfi-1 ; list routines + ) + +;;; for lambda extraction, docstring processing, macro expansion, +;;; injection of module headers, i.e. all things that rearrange code +;;; structurally, add or remove forms +;;; +;;; The algorithm: feed toplevel forms to appropriate handlers, then +;;; append their return to the resulting list. Each handler can return +;;; multiple forms, e.g. lambdas collected from a function may result +;;; in auxiliary structures and functions. +(define (semen-process raw-sex-forms) + (semen-process-rec raw-sex-forms (list))) + +(define (semen-process-rec forms acc) + (cond + ((null? forms) (reverse acc)) + ((sex-macro? (car forms)) + (semen-process-rec + (semen-apply-macro (car forms) (cdr forms)) + acc)) + (else + (semen-process-rec (cdr forms) + (match-sex-form (car forms) acc))))) + +(define (semen-apply-macro macro-form rest-forms) +;; We want to replace macro with its expansion. The problem is, +;; top-level macro can return either a single form, or a list of +;; forms, when it for example generates some aux +;; structures/functions/typedefs. +;; +;; Single form we just cons to the top of rest-forms, but multiple +;; forms have to be appended to the rest-forms. + (let ((res (apply-macro macro-form))) + (if (list? (car res)) + (append res rest-forms) + (cons res rest-forms)))) + +(define (match-sex-form sex-form acc) + (match sex-form + ((or ('fn . _) + ('pub 'fn . _) + ('extern 'fn . _)) (process-fn sex-form acc)) + ((or ('struct . _) + ('pub 'struct . _)) (process-struct sex-form acc)) + ((or ('union . _) + ('pub 'union . _)) (process-struct sex-form acc)) + ((or ('var . _) + ('pub 'var . _) + ('extern 'var . _)) (process-global-var sex-form acc)) + (('include _) (cons sex-form acc)) + + (('import . modules) + (semen-process-imports (get-public-forms modules) acc)) + + ((or ('defmacro . rest) + ('pub 'defmacro . rest)) (defmacro rest) acc) + + (else (assert #f (fmt #f "Unknown top level form " sex-form))))) + +(define (semen-process-imports module-public-forms acc) + ;; Recursively process imports: register public macros, cons all + ;; other public things to our acc + (if (null? module-public-forms) acc + (match (car module-public-forms) + (('defmacro . rest) + (defmacro rest) + (semen-process-imports (cdr module-public-forms) acc)) + (else + (semen-process-imports (cdr module-public-forms) + (cons (car module-public-forms) + acc)))))) + +(define (process-fn sex-fn acc) + (cons sex-fn acc)) + +(define (process-struct sex-struct acc) + (cons sex-struct acc)) + +(define (process-global-var sex-var acc) + (cons sex-var acc)) + +;;; Utils +(define (non-empty-list? form) + (and (list? form) + (not (null? form)))) + +(define (sex-fn? form) + "The `form` must be toplevel. +Returns #f if the form is not a function, returns the form otherwise" + (match form + ((fn . _) form) + ((pub fn . _) form) + (else #f))) + +(define (sex-fn-public? fn-form) + (eq? (car fn-form) 'pub)) + +(define (sex-fn-return-type fn-form) + (assert (sex-fn? fn-form) + (fmt #f "Form " fn-form " is not a function")) + (if (sex-fn-public? fn-form) + (third fn-form) + (second fn-form))) + +(define (sex-fn-name fn-form) + (assert (sex-fn? fn-form) + (fmt #f "Form " fn-form " is not a function")) + (if (sex-fn-public? fn-form) + (fourth fn-form) + (third fn-form))) + +(define (sex-fn-arglist fn-form) + (assert (sex-fn? fn-form) + (fmt #f "Form " fn-form " is not a function")) + (if (sex-fn-public? fn-form) + (fifth fn-form) + (fourth fn-form))) + +(define (sex-fn-prototype fn-form) + "Returns all except body" + (assert (sex-fn? fn-form) + (fmt #f "Form " fn-form " is not a function")) + (if (sex-fn-public? fn-form) + (take fn-form 5) + (take fn-form 4))) + +(define (sex-fn-body fn-form) + (assert (sex-fn? fn-form) + (fmt #f "Form " fn-form " is not a function")) + (if (sex-fn-public? fn-form) + (drop fn-form 5) + (drop fn-form 4))) diff --git a/sex-macros.scm b/sex-macros.scm index 9e32108..1faafea 100644 --- a/sex-macros.scm +++ b/sex-macros.scm @@ -19,11 +19,17 @@ (define (get-macro name) (eval (get name 'sex-macro))) -(define (macro? form) +(define (sex-macro? form) (and (list? form) (symbol? (car form)) (get (car form) 'sex-macro))) +(define (apply-macro form) + (assert (sex-macro? form) + (fmt #f (car form) " is not a macro")) + (apply (get-macro (car form)) + (cdr form))) + (define (defmacro form) (let ((arglist (car form)) (body (cdr form))) diff --git a/sex-modules.scm b/sex-modules.scm index 8da5f70..6aba12a 100644 --- a/sex-modules.scm +++ b/sex-modules.scm @@ -1,7 +1,8 @@ ; Why `sex-modules`? Probably `modules` unit is reserved by chicken, ; things start to break. (declare (unit sex-modules) - (uses utils)) + (uses sex-reader + utils)) (import brev-separate (chicken file) @@ -14,7 +15,7 @@ (define +persistent-module-paths+ (list)) -(define (import-modules module-list) +(define (get-public-forms module-list) ;; Module list is a list of symbols ;; How Sex handles modules: ;; For each module in a list, construct path, find module by path in @@ -63,6 +64,7 @@ (list) raw-forms))) +;;; TODO: use semen facilities to analyze modules (define (process-public-interface-form form acc) (case (car form) ((pub) diff --git a/sex-reader.scm b/sex-reader.scm new file mode 100644 index 0000000..2f3f07b --- /dev/null +++ b/sex-reader.scm @@ -0,0 +1,22 @@ +(declare (unit sex-reader)) + +(include "utils.macros.scm") + +(import (chicken pathname) + brev-separate + fmt) + +(define (read-forms acc) + (let ((r (read))) + (if (eof-object? r) (reverse acc) + (read-forms (cons r acc))))) + +(define (read-from-file file) + (with-directory file + (with-input-from-file (pathname-strip-directory file) + (fn (read-forms (list)))))) + +(define (read-raw-forms input-source) + (if (eq? input-source 'stdin) + (read-forms (list)) + (read-from-file input-source))) diff --git a/sexc.scm b/sexc.scm index 01a8f2c..cded18f 100644 --- a/sexc.scm +++ b/sexc.scm @@ -1,207 +1,23 @@ (declare (unit sexc) - (uses fmt-c - sex-macros - sex-modules)) + (uses fmt-c-writer + sex-reader + semen)) (include "utils.macros.scm") (import brev-separate (chicken file) - (chicken pathname) (chicken plist) (chicken pretty-print) (chicken process) (chicken process-context) (chicken port) - (chicken string) fmt getopt-long - regex srfi-1 ; list routines - srfi-13 ; string routines + srfi-13 tree) -(define (unkebabify sym) - (case sym - ((-) sym) - ((--) sym) - ((->) sym) - ((-=) sym) - (else - (string->symbol - (string-substitute "-(?!>)" "_" - (symbol->string sym) #t))))) - -(define (atom-to-fmt-c atom) - (case atom - ((fn) '%fun) - ((prototype) '%prototype) - ((var) '%var) - ((begin) '%block-begin) - ((define) '%define) - ((pointer) '%pointer) - ((array) '%array) - ((attribute) '%attribute) - ((@) 'vector-ref) - ((include) '%include) - ((cast) '%cast) - ;; uh things we do for c89 compatibility - ((bool) 'int) - ((true) 1) - ((false) 0) - (else - (if (symbol? atom) - (unkebabify atom) - atom)))) - -(define (make-field-access form) - (assert (= 2 (length form)) "Wrong field access format") - (unkebabify - (string->symbol - (fmt #f (cadr form) (car form))))) - -(require-library chicken-syntax) - -(define (walk-generic form acc) - (cond - ((null? form) (cons '() acc)) - - ;; vector, e.g. {}-initializer - ((vector? form) - (cons - (list->vector - (car (walk-sex-tree (vector->list form) (list)))) - acc)) - - ;; atom (hopefully) - ((not (list? form)) (cons (atom-to-fmt-c form) acc)) - - ;; special case - replace unquote with its expansion - ((eq? (car form) 'unquote) - (fold - cons - acc - (car ; bc walk-sex-tree always - ; wraps its result - (walk-sex-tree (eval (cadr form)) (list))))) - - ;; another special case - field access - ((and (symbol? (car form)) - (char=? #\. (string-ref (symbol->string (car form)) 0))) - (cons (make-field-access form) acc)) - - ;; another special case - macro - ((macro? form) - (append (fold-right - walk-generic - (list) - (apply (get-macro (car form)) (cdr form))) - acc)) - - ;; toplevel, or a start of a regular list form - (else - (let ((new-acc (list))) - (cons (fold-right - walk-generic - new-acc - form) - acc))))) - -(define (normalize-fn-form form) - ;; (fn ret-type name arglist body) -> normal function - ;; (fn ret-type name arglist) -> prototype - (if (>= (length form) 5) - form - (cons 'prototype (cdr form)))) - -(define (walk-function form static acc) - (if static - (append (walk-generic (list 'static (normalize-fn-form form)) - (list)) - acc) - (append (walk-generic (normalize-fn-form (cdr form)) - (list)) - acc))) - -(define (walk-struct form acc) - (let ((name (unkebabify (cadr form)))) - (append (walk-generic form (list)) - (cons `(typedef struct ,name ,name) acc)))) - -(define (walk-extern form acc) - (case (cadr form) - ((fn) - (append - (list (cons 'extern (walk-function form #f (list)))) - acc)) - ((var) - (append - (list (cons 'extern (walk-generic (cdr form) (list)))) - acc)) - (else (error "Extern what?")))) - -(define (walk-public form acc) - (case (cadr form) - ((fn) - (walk-function form #f acc)) - ((var) - (append (walk-generic (list 'static (cdr form)) (list)) acc)) - ((define defmacro import include struct typedef union var) - ;; ignore here, used in generating public interface - (process-form (cdr form) acc)) - (else - (error "Pub what?" (cadr form))))) - -(define (walk-sex-tree form acc) - (if (list? form) - (if (macro? form) - (fold-right (fn (walk-sex-tree x y)) - acc - (list (apply (get-macro (car form)) (cdr form)))) - (case (car form) - ((fn) (walk-function form #t acc)) - ((extern) (walk-extern form acc)) - ((pub) (walk-public form acc)) - ((struct union) (walk-struct form acc)) - ((unquote) (fold (fn (walk-sex-tree x y)) - acc - (eval (cadr form)))) - (else (append (walk-generic form (list)) acc)))) - ;; only for unquote support - (list (list (atom-to-fmt-c form))))) - -(define (process-form form acc) - (case (car form) - ((chicken-define) (eval (cons 'define (cdr form))) acc) - ((defmacro) (defmacro (cdr form)) acc) - ((chicken-load) - (load (cadr form)) acc) - ((chicken-import) - (eval (cons 'import (cdr form))) acc) - ((import) - (append (process-raw-forms - - (import-modules (cdr form)) (list)) - acc)) - (else - (walk-sex-tree form acc)))) - -(define (process-raw-forms raw-forms acc) - (if (null? raw-forms) - (reverse acc) - (process-raw-forms (cdr raw-forms) - (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) - (for-each (lambda (form) - (fmt #t (c-expr form) nl)) - forms)) - ;;; Main function facilities (define opts-grammar @@ -214,10 +30,10 @@ (required #f) (value #f) (single-char #\c)) - (preprocess "Emit C code" + (emit-c "Emit C code" (required #f) (value #f) - (single-char #\E)) + (single-char #\C)) (public-interface "Get module's public interface" (required #f) (value #f)) @@ -261,20 +77,14 @@ 'stdin (car rest-args)))) -(define (read-from-file file) - (with-directory file - (with-input-from-file (pathname-strip-directory file) - (fn (read-forms (list)))))) - (define (write-to-file-or-stdout output what) (if (eq? output 'default) (what) (with-output-to-file output (fn (what))))) -(define (preprocess-or-macroexpand sex-forms output args) - (write-to-file-or-stdout - output +(define (emit-c-or-sex sex-forms output args) + (write-to-file-or-stdout output (lambda () (if (get-arg args 'macro-expand #f) (map pp sex-forms) @@ -301,13 +111,11 @@ (close-output-port in-port) (process-wait pid))))) -(define (process-input input raw-forms) - (let ((current-dir (current-directory))) - (unless (eq? input 'stdin) - (set-working-directory input)) - (prog1 - (process-raw-forms raw-forms (list)) - (change-directory current-dir)))) +(define (semantic-process-forms raw-forms input-source) + (if (eq? input-source 'stdin) + (semen-process raw-forms) + (with-directory input-source + (semen-process raw-forms)))) (define (main) (let* ((raw-args (command-line-arguments)) @@ -334,14 +142,11 @@ (return #f)) (load-persistent-module-paths) - (let* ((raw-forms - (if (eq? input 'stdin) - (read-forms (list)) - (read-from-file input))) - (sex-forms (process-input input raw-forms))) + (let* ((raw-forms (read-raw-forms input)) + (sex-forms (semantic-process-forms raw-forms input))) (if (or (get-arg args 'macro-expand #f) - (get-arg args 'preprocess #f)) - ;; Preprocess or macroexpand - (preprocess-or-macroexpand sex-forms output args) + (get-arg args 'emit-c #f)) + ;; Emit processed and macro-expanded sex code, or emit C code + (emit-c-or-sex sex-forms output args) ;; Compile file! (compile-to-file sex-forms output args))))))) diff --git a/tests/basic.scm b/tests/basic.scm index 7d00b3f..847a7bd 100644 --- a/tests/basic.scm +++ b/tests/basic.scm @@ -1,3 +1,5 @@ +(test-begin "basic") + ;;; unkebabify (test '- (unkebabify '-)) (test '-- (unkebabify '--)) @@ -29,3 +31,5 @@ ;;; make-field-access (test 'a.b (make-field-access '(.b a))) (test 'a.b.c (make-field-access '(.c a.b))) + +(test-end) diff --git a/tests/run.scm b/tests/run.scm index 56019ec..00d6c8a 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -1,4 +1,5 @@ -(declare (uses sexc)) +(declare (uses fmt-c-writer + semen)) (import (chicken process) @@ -7,7 +8,7 @@ test) (include "basic.scm") -(include "types.scm") +(include "semen.scm") ;;; Should be the last in the test suite (test-exit) diff --git a/tests/semen.scm b/tests/semen.scm new file mode 100644 index 0000000..63e88a7 --- /dev/null +++ b/tests/semen.scm @@ -0,0 +1,34 @@ +(define print-str-fn + '(fn void print-str ((string s)) + (printf "%s" s))) + +(define sum-fn + '(pub fn float sum ((int a) (int b)) + (return (cast float (+ a b))))) + +(test-begin "semen") +(test-assert (sex-fn? print-str-fn)) +(test #f (sex-fn-public? print-str-fn)) +(test 'void (sex-fn-return-type print-str-fn)) +(test 'print-str (sex-fn-name print-str-fn)) +(test '((string s)) (sex-fn-arglist print-str-fn)) +(test '(fn void print-str ((string s))) (sex-fn-prototype print-str-fn)) +(test '((printf "%s" s)) (sex-fn-body print-str-fn)) + +(test-assert (sex-fn? sum-fn)) +(test #t (sex-fn-public? sum-fn)) +(test 'float (sex-fn-return-type sum-fn)) +(test 'sum (sex-fn-name sum-fn)) +(test '((int a) (int b)) (sex-fn-arglist sum-fn)) +(test '(pub fn float sum ((int a) (int b))) (sex-fn-prototype sum-fn)) +(test '((return (cast float (+ a b)))) (sex-fn-body sum-fn)) + +(define sex-code + '((defmacro (sum-var name a b c) + `(var ,name ,(+ a b c))) + + (sum-var v 1 2 3))) + +(test '((var v 6)) (semen-process sex-code)) + +(test-end) diff --git a/tests/types.scm b/tests/types.scm deleted file mode 100644 index cb14c40..0000000 --- a/tests/types.scm +++ /dev/null @@ -1 +0,0 @@ -(test "char *" (to-c-type '(%pointer char))) diff --git a/utils.macros.scm b/utils.macros.scm index 190209c..9e8f88f 100644 --- a/utils.macros.scm +++ b/utils.macros.scm @@ -1,3 +1,5 @@ +(import (chicken process-context)) + (define-syntax prog1 (syntax-rules () ((prog1 form . forms)