diff --git a/semen.scm b/semen.scm index 71ddb1e..1afac55 100644 --- a/semen.scm +++ b/semen.scm @@ -140,6 +140,10 @@ (cons (copy-form-source! form `(typedef ,target ,new-type)) acc)) ;;; Fn processing +;;; +;;; A string as the first body form is a docstring. In the generated +;;; C code it will be placed as a C commentary just before the function +;;; definition (actually that works for all blocky things: enum, struct, union as well). (define (comment-form? f) (and (pair? f) (eq? (car f) 'comment))) @@ -153,6 +157,55 @@ (cdr form) form)) +(define (take-leading-docstring forms) + ;; 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))))) + +(define (extract-fn-docstring fn-form) + (let ((lift + (lambda (proto body) + (let-values (((doc rest) (take-leading-docstring body))) + (if doc + (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) + ;; 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)))) + +(define (with-docstring doc form acc) + ;; acc is newest-first; FORM is consed last so the final reverse + ;; emits the comment immediately before the declaration + (cons form + (if doc + (cons (list 'comment doc) acc) + acc))) + (define (strip-fn-header-comments fn-form) ;; Remove comment forms from the function header ;; ([pub|extern] fn name arglist rettype) so the positional accessors @@ -171,21 +224,21 @@ (else (loop (cdr form) (+ kept 1) (cons (car form) acc)))))))) (define (process-fn sex-fn-raw acc) - (let* ((sex-fn (strip-fn-header-comments sex-fn-raw)) - (expanded (macro-expand sex-fn)) - (env (make-hash-table)) - (processed - (walk-form - expanded - fn-walker - (begin - (set! (hash-table-ref env :fn-name) (sex-fn-name expanded)) - (set! (hash-table-ref env :lambda-counter) 0) - (set! (hash-table-ref env :lambda-aux-code) (list)) - env)))) - - (cons processed - (append (hash-table-ref env :lambda-aux-code) acc)))) + (let-values (((doc sex-fn) + (extract-fn-docstring (strip-fn-header-comments sex-fn-raw)))) + (let* ((expanded (macro-expand sex-fn)) + (env (make-hash-table)) + (processed + (walk-form + expanded + fn-walker + (begin + (set! (hash-table-ref env :fn-name) (sex-fn-name expanded)) + (set! (hash-table-ref env :lambda-counter) 0) + (set! (hash-table-ref env :lambda-aux-code) (list)) + env)))) + (with-docstring doc processed + (append (hash-table-ref env :lambda-aux-code) acc))))) (define (fn-walker form env) (if (eq? 'lambda (car form)) @@ -216,8 +269,9 @@ ;;; Record the named structs, unions and enums in the type database (define (process-struct sex-struct acc) - (register-aggregate! sex-struct) - (cons sex-struct acc)) + (let-values (((doc form) (extract-aggregate-docstring sex-struct))) + (register-aggregate! form) + (with-docstring doc form acc))) (define (register-aggregate! form) (let* ((f (if (eq? (car form) 'pub) (cdr form) form))