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
+    (match fs
-     ((null? fs)
+      (() (values #f forms))
-      (values #f forms))
+      (((and cmt ('comment . _)) . rest)
-     ((comment-form? (car fs))
+       (loop rest (cons cmt prefix)))
-      (loop (cdr fs) (cons (car fs) prefix)))
+      (((? string? doc) . rest)
-     ((string? (car fs))
+       (values doc (append (reverse prefix) rest)))
-      (values (car fs) (append (reverse prefix) (cdr fs))))
+      (_ (values #f forms)))))
-     (else
-      (values #f forms)))))
 
 (define (extract-fn-docstring fn-form)
-  (let ((n (fn-header-length fn-form)))
+  (let ((lift
-    (if (< (length fn-form) n)
+         (lambda (proto body)
-        (values #f fn-form)
+           (let-values (((doc rest) (take-leading-docstring body)))
-        (let-values (((doc body) (take-leading-docstring (drop fn-form n))))
+             (if doc
-          (if doc
+                 (values doc (copy-form-source! fn-form (append proto rest)))
-              (values doc
+                 (values #f fn-form))))))
-                      (copy-form-source! fn-form
+    (match fn-form
-                                         (append (take fn-form n) body)))
+      (('pub 'fn name args ret . body)
-              (values #f fn-form))))))
+       (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))
+  (match form
-         (core (if pub? (cdr form) form)))
+    (('pub (and kind (or 'struct 'union 'enum))
-    (if (and (pair? (cdr core))
+           (? symbol? name) (? string? doc) . rest)
-             (symbol? (cadr core))
+     (values doc (copy-form-source! form `(pub ,kind ,name ,@rest))))
-             (pair? (cddr core))
+    (((and kind (or 'struct 'union 'enum))
-             (string? (caddr core)))
+      (? symbol? name) (? string? doc) . rest)
-        (let ((new-core (cons (car core)
+     (values doc (copy-form-source! form `(,kind ,name ,@rest))))
-                              (cons (cadr core) (cdddr core)))))
+    (_ (values #f form))))
-          (values (caddr core)
-                  (copy-form-source! form
-                                     (if pub?
-                                         (cons 'pub new-core)
-                                         new-core))))
-        (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)
+  (match form
-       (let ((core (fn-core form)))
+    ((fn . _) form)
-         (and (pair? core) (eq? (car core) '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)))
+  (match form
-    (let loop ((body (drop form 5)))
+    (('pub 'fn name args ret)
-      (cond
+     form)
-       ((null? body) header)
+    (('pub 'fn name args ret ('comment . _) . rest)
-       ((and (pair? (car body)) (eq? (caar body) 'comment))
+     (public-fn-interface `(pub fn ,name ,args ,ret ,@rest)))
-        (loop (cdr body)))
+    (('pub 'fn name args ret (? string? doc) . _)
-       ((string? (car body)) (append header (list (car body))))
+     `(pub fn ,name ,args ,ret ,doc))
-       (else header)))))
+    (('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)
+  (match form
-    ((pub)
+    ;; Reduced to a prototype, still `pub', so the importer declares it
-     (case (cadr form)
+    ;; with external linkage
-       ;; A function is reduced to a prototype and keeps its `pub', so
+    (('pub 'fn . _)
-       ;; the importing unit declares it with external linkage
+     (cons (copy-form-source! form (public-fn-interface form)) acc))
-       ((fn)
+    (('pub 'var name type . _)
-        (cons (copy-form-source! form (public-fn-interface form)) acc))
+     (cons (copy-form-source! form `(extern var ,name ,type)) acc))
-       ;; A variable becomes an `extern' declaration
+    (('pub (or 'define 'defmacro 'enum 'import 'include 'struct 'typedef 'union) . _)
-       ((var)
+     (cons (copy-form-source! form (cdr form)) acc))
-        (cons (copy-form-source! form (cons 'extern (take (cdr form) 3))) acc))
+    (('pub . _)
-       ((define defmacro enum import include struct typedef union)
+     (sex-error form "pub must be followed by a definition" form))
-        (cons (copy-form-source! form (cdr form)) acc))
+    (_ acc)))
-       (else (sex-error form "pub must be followed by a definition" form))))
-    (else acc)))
 
 (define (load-persistent-module-paths)
   (let ((sex-module-path-env-var

tests/semen.scm

@@ -115,4 +115,4 @@
           (union t-doc-val ((i int) (f float))))
         (semen-process
          '((union t-doc-val "Either." ((i int) (f float))))))
-)
+)