tests: add docstring cases

semen.scm

@@ -149,11 +149,11 @@
   (and (pair? f) (eq? (car f) 'comment)))
 
 (define (fn-header-length fn-form)
-  (if (memq (car fn-form) '(pub extern)) 5 4))
+  (if (memq (first fn-form) '(pub extern)) 5 4))
 
 (define (fn-core form)
   ;; The (fn name args rettype . body) list, without pub/extern
-  (if (memq (car form) '(pub extern))
+  (if (memq (first form) '(pub extern))
       (cdr form)
       form))
 
@@ -161,46 +161,42 @@
   ;; If FORMS starts with a string, possibly after comment forms, return
   ;; that string and FORMS without it. Otherwise #f and FORMS unchanged
   (let loop ((fs forms) (prefix (list)))
-    (cond
-     ((null? fs)
-      (values #f forms))
-     ((comment-form? (car fs))
-      (loop (cdr fs) (cons (car fs) prefix)))
-     ((string? (car fs))
-      (values (car fs) (append (reverse prefix) (cdr fs))))
-     (else
-      (values #f forms)))))
+    (match fs
+      (() (values #f forms))
+      (((and cmt ('comment . _)) . rest)
+       (loop rest (cons cmt prefix)))
+      (((? string? doc) . rest)
+       (values doc (append (reverse prefix) rest)))
+      (_ (values #f forms)))))
 
 (define (extract-fn-docstring fn-form)
-  (let ((n (fn-header-length fn-form)))
-    (if (< (length fn-form) n)
-        (values #f fn-form)
-        (let-values (((doc body) (take-leading-docstring (drop fn-form n))))
+  (let ((lift
+         (lambda (proto body)
+           (let-values (((doc rest) (take-leading-docstring body)))
              (if doc
-              (values doc
-                      (copy-form-source! fn-form
-                                         (append (take fn-form n) body)))
+                 (values doc (copy-form-source! fn-form (append proto rest)))
                  (values #f fn-form))))))
+    (match fn-form
+      (('pub 'fn name args ret . body)
+       (lift `(pub fn ,name ,args ,ret) body))
+      (('extern 'fn name args ret . body)
+       (lift `(extern fn ,name ,args ,ret) body))
+      (('fn name args ret . body)
+       (lift `(fn ,name ,args ,ret) body))
+      (_ (values #f fn-form)))))
 
 (define (extract-aggregate-docstring form)
-  ;; ([pub] struct|union|enum name "doc" (fields ...) . attrs)
   ;; A string immediately after the name is the docstring; comments
   ;; between name and fields are not skipped, they already confuse the
   ;; writer
-  (let* ((pub? (eq? (car form) 'pub))
-         (core (if pub? (cdr form) form)))
-    (if (and (pair? (cdr core))
-             (symbol? (cadr core))
-             (pair? (cddr core))
-             (string? (caddr core)))
-        (let ((new-core (cons (car core)
-                              (cons (cadr core) (cdddr core)))))
-          (values (caddr core)
-                  (copy-form-source! form
-                                     (if pub?
-                                         (cons 'pub new-core)
-                                         new-core))))
-        (values #f form))))
+  (match form
+    (('pub (and kind (or 'struct 'union 'enum))
+           (? symbol? name) (? string? doc) . rest)
+     (values doc (copy-form-source! form `(pub ,kind ,name ,@rest))))
+    (((and kind (or 'struct 'union 'enum))
+      (? symbol? name) (? string? doc) . rest)
+     (values doc (copy-form-source! form `(,kind ,name ,@rest))))
+    (_ (values #f form))))
 
 (define (with-docstring doc form acc)
   ;; acc is newest-first; FORM is consed last so the final reverse
@@ -299,27 +295,28 @@
 (define (sex-fn? form)
   "The `form` must be toplevel.
 Returns #f if the form is not a function, returns the form otherwise"
-  (and (non-empty-list? form)
-       (let ((core (fn-core form)))
-         (and (pair? core) (eq? (car core) 'fn) form))))
+  (match form
+    ((fn . _) form)
+    ((pub fn . _) form)
+    (else #f)))
 
 (define (sex-fn-public? fn-form)
-  (eq? (car fn-form) 'pub))
+  (eq? (first fn-form) 'pub))
 
 (define (sex-fn-name fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
-  (cadr (fn-core fn-form)))
+  (second (fn-core fn-form)))
 
 (define (sex-fn-arglist fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
-  (caddr (fn-core fn-form)))
+  (third (fn-core fn-form)))
 
 (define (sex-fn-return-type fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
-  (cadddr (fn-core fn-form)))
+  (fourth (fn-core fn-form)))
 
 (define (sex-fn-prototype fn-form)
   "Returns all except body"

sex-modules.scm

@@ -8,6 +8,7 @@
   (chicken process-context)
   (chicken string)
   fmt
+  matchable
   reader
   srfi-1
   utils)
@@ -74,31 +75,30 @@
 (define (public-fn-interface form)
   ;; (pub fn name args ret . body) -> prototype, keeping a docstring so
   ;; the importer can emit it above the declaration
-  (let ((header (take form 5)))
-    (let loop ((body (drop form 5)))
-      (cond
-       ((null? body) header)
-       ((and (pair? (car body)) (eq? (caar body) 'comment))
-        (loop (cdr body)))
-       ((string? (car body)) (append header (list (car body))))
-       (else header)))))
+  (match form
+    (('pub 'fn name args ret)
+     form)
+    (('pub 'fn name args ret ('comment . _) . rest)
+     (public-fn-interface `(pub fn ,name ,args ,ret ,@rest)))
+    (('pub 'fn name args ret (? string? doc) . _)
+     `(pub fn ,name ,args ,ret ,doc))
+    (('pub 'fn name args ret . _)
+     `(pub fn ,name ,args ,ret))))
 
 ;;; TODO: use semen facilities to analyze modules
 (define (process-public-interface-form form acc)
-  (case (car form)
-    ((pub)
-     (case (cadr form)
-       ;; A function is reduced to a prototype and keeps its `pub', so
-       ;; the importing unit declares it with external linkage
-       ((fn)
+  (match form
+    ;; Reduced to a prototype, still `pub', so the importer declares it
+    ;; with external linkage
+    (('pub 'fn . _)
      (cons (copy-form-source! form (public-fn-interface form)) acc))
-       ;; A variable becomes an `extern' declaration
-       ((var)
-        (cons (copy-form-source! form (cons 'extern (take (cdr form) 3))) acc))
-       ((define defmacro enum import include struct typedef union)
+    (('pub 'var name type . _)
+     (cons (copy-form-source! form `(extern var ,name ,type)) acc))
+    (('pub (or 'define 'defmacro 'enum 'import 'include 'struct 'typedef 'union) . _)
      (cons (copy-form-source! form (cdr form)) acc))
-       (else (sex-error form "pub must be followed by a definition" form))))
-    (else acc)))
+    (('pub . _)
+     (sex-error form "pub must be followed by a definition" form))
+    (_ acc)))
 
 (define (load-persistent-module-paths)
   (let ((sex-module-path-env-var