TMP

semen.scm

@@ -149,11 +149,11 @@
   (and (pair? f) (eq? (car f) 'comment)))
 
 (define (fn-header-length fn-form)
-  (if (memq (first fn-form) '(pub extern)) 5 4))
+  (if (memq (car fn-form) '(pub extern)) 5 4))
 
 (define (fn-core form)
   ;; The (fn name args rettype . body) list, without pub/extern
-  (if (memq (first form) '(pub extern))
+  (if (memq (car form) '(pub extern))
       (cdr form)
       form))
 
@@ -161,42 +161,46 @@
   ;; 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)))
-    (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)))))
+    (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)))))
 
 (define (extract-fn-docstring fn-form)
-  (let ((lift
-         (lambda (proto body)
-           (let-values (((doc rest) (take-leading-docstring body)))
+  (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))))
           (if doc
-                 (values doc (copy-form-source! fn-form (append proto rest)))
+              (values doc
+                      (copy-form-source! fn-form
+                                         (append (take fn-form n) body)))
               (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
-  (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))))
+  (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))))
 
 (define (with-docstring doc form acc)
   ;; acc is newest-first; FORM is consed last so the final reverse
@@ -295,28 +299,27 @@
 (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)))
+  (and (non-empty-list? form)
+       (let ((core (fn-core form)))
+         (and (pair? core) (eq? (car core) 'fn) form))))
 
 (define (sex-fn-public? fn-form)
-  (eq? (first fn-form) 'pub))
+  (eq? (car fn-form) 'pub))
 
 (define (sex-fn-name fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
-  (second (fn-core fn-form)))
+  (cadr (fn-core fn-form)))
 
 (define (sex-fn-arglist fn-form)
   (assert (sex-fn? fn-form)
           (fmt #f "Form " fn-form " is not a function"))
-  (third (fn-core fn-form)))
+  (caddr (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"))
-  (fourth (fn-core fn-form)))
+  (cadddr (fn-core fn-form)))
 
 (define (sex-fn-prototype fn-form)
   "Returns all except body"

sex-modules.scm

@@ -8,7 +8,6 @@
   (chicken process-context)
   (chicken string)
   fmt
-  matchable
   reader
   srfi-1
   utils)
@@ -75,30 +74,31 @@
 (define (public-fn-interface form)
   ;; (pub fn name args ret . body) -> prototype, keeping a docstring so
   ;; the importer can emit it above the declaration
-  (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))))
+  (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)))))
 
 ;;; TODO: use semen facilities to analyze modules
 (define (process-public-interface-form form acc)
-  (match form
-    ;; Reduced to a prototype, still `pub', so the importer declares it
-    ;; with external linkage
-    (('pub 'fn . _)
+  (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)
         (cons (copy-form-source! form (public-fn-interface form)) acc))
-    (('pub 'var name type . _)
-     (cons (copy-form-source! form `(extern var ,name ,type)) acc))
-    (('pub (or 'define 'defmacro 'enum 'import 'include 'struct 'typedef 'union) . _)
+       ;; 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)
         (cons (copy-form-source! form (cdr form)) acc))
-    (('pub . _)
-     (sex-error form "pub must be followed by a definition" form))
-    (_ 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