add sex-error reporting

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.

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

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
 

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)

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"))))

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")

utils.module.scm

@@ -12,6 +12,8 @@
      form-line
      copy-form-source!
      stamp-form-source!
+     form-location
+     sex-error
      with-directory
      )
   "utils.scm")

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