From b1744bb6af4b2c8a6a0dabfe02a72232c43989dc Mon Sep 17 00:00:00 2001 From: alex-eg Date: Wed, 24 Sep 2025 20:12:08 +0300 Subject: [PATCH] split semantic processing and fmt-c code generation Introducing Sex SEMantic ENgine: the semen. Also split reader to other file (it can be replaced in the future). Macro expansion inside Sex code doesn't work yet, and it must be done in semen, not during fmt-c generation as before. --- Makefile | 2 +- Readme.org | 2 +- example/fns.sex | 10 ++ example/list.sex | 24 ++--- example/test-list.sex | 16 +-- fmt-c-writer.scm | 128 +++++++++++++++++++++++ semen.scm | 141 ++++++++++++++++++++++++++ sex-macros.scm | 8 +- sex-modules.scm | 6 +- sex-reader.scm | 22 ++++ sexc.scm | 231 ++++-------------------------------------- tests/basic.scm | 4 + tests/run.scm | 5 +- tests/semen.scm | 34 +++++++ tests/types.scm | 1 - utils.macros.scm | 2 + 16 files changed, 392 insertions(+), 244 deletions(-) create mode 100644 example/fns.sex create mode 100644 fmt-c-writer.scm create mode 100644 semen.scm create mode 100644 sex-reader.scm create mode 100644 tests/semen.scm delete mode 100644 tests/types.scm 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)