diff --git a/Readme.org b/Readme.org index ada2d65..b3db3fb 100644 --- a/Readme.org +++ b/Readme.org @@ -145,6 +145,12 @@ return Sex code. ...) #+end_src +** Compile-time type information +Sex has a number of type reflection features, aiming to help with +macro writing. During the compilation, all type info is collected, and +is accessible during macro expansion. This allows us to write things +like providing auto serialization, adding meta information, and so on. + ** Use an established environment for development As Sex is S-expressions, you always have Emacs with paredit as your best option. diff --git a/fmt-c-writer.scm b/fmt-c-writer.scm index 6733687..02b13ec 100644 --- a/fmt-c-writer.scm +++ b/fmt-c-writer.scm @@ -175,7 +175,7 @@ forms, and what remains." (define (walk-generic-toplevel form) (cond ((atom? form) (atom-to-fmt-c form)) ((list? form) (map walk-generic-toplevel form)) - (else (error "Malformed form " form)))) + (else (sex-error form "malformed form" form)))) (define (walk-expr form) (match form @@ -281,7 +281,7 @@ forms, and what remains." (('fn arglist ret-type) `(%fun ,(walk-type ret-type) ,(walk-arglist arglist))) (('fn . _) - (assert #f "Malformed function type form")) + (sex-error form "malformed function type" form)) ;; Special case: nested structs/unions ((or ('struct . _) @@ -363,7 +363,7 @@ forms, and what remains." `(,type ,(atom-to-fmt-c name) ,(process-struct-fields fields) . ,(tree-map atom-to-fmt-c attrs))) - (else (error "Malformed aggregate definition " form)))) + (else (sex-error form "malformed aggregate definition" form)))) (define (walk-enum form) (match form @@ -379,7 +379,7 @@ forms, and what remains." (list 'extern (walk-function form))) (('var . _) (list 'extern (walk-var form))) - (else (error "Extern what?")))) + (else (sex-error form "extern must be followed by fn or var" form)))) (define (walk-public form) (match form @@ -400,7 +400,7 @@ forms, and what remains." ;; ignore here, used in generating public interface (process-toplevel-form form)) (else - (error "Pub what?" (cadr form))))) + (sex-error form "pub must be followed by a definition" form)))) (define (process-toplevel-form form) (match form diff --git a/semen.scm b/semen.scm index 6bdfcc4..64f16e9 100644 --- a/semen.scm +++ b/semen.scm @@ -85,7 +85,7 @@ ('pub 'typedef new-type target)) (process-typedef sex-form new-type target acc)) - (else (assert #f (fmt #f "Unknown top level form " sex-form))))) + (else (sex-error sex-form "unknown top level form" sex-form)))) (define (process-imports module-public-forms acc) ;; Recursively process imports: register public macros, cons all @@ -204,7 +204,7 @@ ;; we'll need them for TODO: closures support (process-fn (copy-form-source! form `(fn ,ret-type ,name ,arglist ,@body)) (list))) - (else (assert #f (fmt #f "Malformed lambda " form))))) + (else (sex-error form "malformed lambda" form)))) ;;; Structs diff --git a/sex-modules.scm b/sex-modules.scm index 5025629..c2a9d61 100644 --- a/sex-modules.scm +++ b/sex-modules.scm @@ -74,7 +74,7 @@ (cons (copy-form-source! form (take (cdr form) 4)) acc)) ((define defmacro import include struct typedef union var) (cons (copy-form-source! form (cdr form)) acc)) - (else (error "Pub what? " (cadr form))))) + (else (sex-error form "pub must be followed by a definition" form)))) (else acc))) (define (load-persistent-module-paths) diff --git a/tests/codegen.scm b/tests/codegen.scm index e278d3a..6d4a0f9 100644 --- a/tests/codegen.scm +++ b/tests/codegen.scm @@ -6,7 +6,8 @@ ;;; the existing suite, because both need an operand shape that no ;;; earlier test program happened to use. -(import (chicken port) +(import (chicken condition) + (chicken port) (chicken string) srfi-13 fmt-c-writer @@ -28,6 +29,22 @@ (define (emits? source fragment) (and (string-contains (sex->c source) fragment) #t)) +(define (error-message source) + "Compile SOURCE and return the error text as the user sees it -- +message plus arguments, the way CHICKEN prints it -- or #f if SOURCE +compiles." + (handle-exceptions e + (with-output-to-string + (lambda () + (display ((condition-property-accessor 'exn 'message) e)) + (for-each (lambda (a) (display " ") (write a)) + ((condition-property-accessor 'exn 'arguments) e)))) + (begin (sex->c source) #f))) + +(define (reports? source fragment) + (let ((m (error-message source))) + (and m (string-contains m fragment) #t))) + (define (in-fn body) (string-append "(fn f ((a int) (b int)) void " body ")")) @@ -153,4 +170,26 @@ (test-assert "c-or is still accepted" (emits? (in-fn "(var x int (c-or a b))") "a || b")) (test-assert "c-bit-or is still accepted" - (emits? (in-fn "(var x int (c-bit-or a b))") "a | b")))) + (emits? (in-fn "(var x int (c-bit-or a b))") "a | b"))) + ;; Diagnostics name also the place. Every form carries a (file + ;; . line), so an error can cite it + (test-group "errors cite the source location" + (test-assert "unknown toplevel form" + (reports? "(include stdio.h)\n(wat 1 2)" "codegen.sex:2: unknown top level form")) + (test-assert "the offending form is shown too" + (reports? "(include stdio.h)\n(wat 1 2)" "(wat 1 2)")) + (test-assert "pub with nothing to define" + (reports? "(pub 1)" "codegen.sex:1:"))) + + ;; A nested pointer chain used to silently lose a level: + ;; (var p (* (* char))) emitted `char *p' + (test-group "malformed types are rejected" + (test-assert "nested pointer chain" + (reports? (in-fn "(var p (* (* char)))") "pointer chains are written flat")) + (test-assert "and names the line" + (reports? "(pub fn f () void\n (var p (* (* char))))" "codegen.sex:2:")) + ;; A sublist that only groups has no `*' in it and must still work. + (test-assert "grouping sublist still accepted" + (emits? (in-fn "(var s (* (const struct suc)) 0)") "const struct suc * s")) + (test-assert "flat chain still accepted" + (emits? (in-fn "(var q (* * const char) 0)") "const char * * q")))) diff --git a/tools/sextest/utils.module.scm b/tools/sextest/utils.module.scm index 0eeeae1..13c0bed 100644 --- a/tools/sextest/utils.module.scm +++ b/tools/sextest/utils.module.scm @@ -12,6 +12,8 @@ form-line copy-form-source! stamp-form-source! + form-location + sex-error with-directory ) "../../utils.scm") diff --git a/utils.module.scm b/utils.module.scm index f577477..7e1e3f1 100644 --- a/utils.module.scm +++ b/utils.module.scm @@ -12,6 +12,8 @@ form-line copy-form-source! stamp-form-source! + form-location + sex-error with-directory ) "utils.scm") diff --git a/utils.scm b/utils.scm index 430bdb3..7a99fb1 100644 --- a/utils.scm +++ b/utils.scm @@ -105,6 +105,21 @@ wrap a form-building expression." (hash-table-set! +form-sources+ to src))) to) +;;; Diagnostics +;;; +;;; Every form carries a location now, so an error can say where the +;;; wrong code was written +(define (form-location form) + "\"file:line: \" for FORM, or \"\" when it has none" + (let ((src (form-source form))) + (if src + (string-append (car src) ":" (number->string (cdr src)) ": ") + ""))) + +(define (sex-error form message . args) + "Signal an error about FORM, prefixed with where it was written." + (apply error (string-append (form-location form) message) args)) + (define (stamp-form-source! form src) "Give FORM and every subform that has none the location SRC. Used for macro expansions, which inherit the location of the call site the way a