Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-05 12:16:37 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Parsing .module files for docs, plus small fixes.

Browse source
This commit is contained in:
Alex Shinn 2011-05-21 22:47:29 -07:00
parent b120458fed
commit 4cacc6abde
1 changed files with 42 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

58
tools/chibi-doc
View file

@ -367,7 +367,12 @@ div#footer {padding-bottom: 50px}
(define (get-ffi-signatures form) (define (get-ffi-signatures form)
(match form (match form
(('define-c ret-type (or (name _) name) (args ...)) (('define-c ret-type (or (name _) name) (args ...))
(list (cons name (map (lambda (x) (if (pair? x) (last x) x)) args)))) (list (cons name
(map (lambda (x) (if (pair? x) (last x) x))
(remove (lambda (x)
(and (pair? x)
(memq (car x) '(value result))))
args)))))
(('define-c-const type (or (name _) name)) (('define-c-const type (or (name _) name))
(list (list 'const: type name))) (list (list 'const: type name)))
(((or 'define-c-struct 'define-c-class 'define-c-type) name . rest) (((or 'define-c-struct 'define-c-class 'define-c-type) name . rest)
@ -412,9 +417,14 @@ div#footer {padding-bottom: 50px}
(else #f)))) (else #f))))
(define (section-describes? x name) (define (section-describes? x name)
(and (pair? x) (pair? (cdr x)) (let ((name (symbol->string name)))
(string-ci=? (string-first-token (sxml-strip (cadr x)) " \t\r\n()#") (and (pair? x) (pair? (cdr x))
(symbol->string name)))) (let* ((str (sxml-strip (cadr x)))
(op (string-first-token str " \t\r\n()#")))
(or (string=? op name)
;; FIXME: hack for loop iterators
(and (string=? op "for")
(string-contains str (string-append "(" name " "))))))))
(define (insert-signature orig-ls name sig) (define (insert-signature orig-ls name sig)
(cond (cond
@ -444,14 +454,15 @@ div#footer {padding-bottom: 50px}
(else (else
(lp (cdr ls) (cons (car ls) rev-pre))))))))) (lp (cdr ls) (cons (car ls) rev-pre)))))))))
(define (extract-docs file defs . o) (define (extract-docs file defs exports . o)
(call-with-input-file file (call-with-input-file file
(lambda (in) (lambda (in)
(let ((lang (or (and (pair? o) (car o)) 'scheme)) (let* ((lang (or (and (pair? o) (car o)) 'scheme))
(defs (map (lambda (x) `(,(car x) ,(cadr x) ,(cdaddr x))) (defs (map (lambda (x) `(,(car x) ,(cadr x) ,(cdaddr x)))
(filter (lambda (x) (and (pair? (caddr x)) (filter
(equal? file (caaddr x)))) (lambda (x)
defs)))) (and (pair? (caddr x)) (equal? file (caaddr x))))
defs))))
(let lp ((lines '()) (cur '()) (res '())) (let lp ((lines '()) (cur '()) (res '()))
(define (collect) (define (collect)
(if (pair? lines) (if (pair? lines)
@ -477,8 +488,15 @@ div#footer {padding-bottom: 50px}
(if (eqv? #\space (peek-char in)) (read-char in)) (if (eqv? #\space (peek-char in)) (read-char in))
(lp (cons (read-line in) lines) cur res)) (lp (cons (read-line in) lines) cur res))
(else (else
(read-line in) (let lp ()
(lp '() (collect) res)))) (cond ((eqv? #\; (peek-char in))
(read-char in)
(lp))))
(let ((line (read-line in))
(cur (collect)))
(if (equal? line "/")
(lp '() '() (append cur res))
(lp '() cur res))))))
(else ;; found a top-level expression (else ;; found a top-level expression
(let* ((cur (collect)) (let* ((cur (collect))
(line1 (port-line in)) (line1 (port-line in))
@ -489,8 +507,12 @@ div#footer {padding-bottom: 50px}
(cond (cond
((and (eq? lang 'ffi) (get-ffi-signatures x)) ((and (eq? lang 'ffi) (get-ffi-signatures x))
=> (lambda (sigs) => (lambda (sigs)
(lp '() '() (append (insert-signature cur #f sigs) res)))) (let ((sigs (filter
((= 1 (length procs)) (lambda (x)
(memq (if (eq? 'const: (car x)) (caddr x) (car x)) exports))
sigs)))
(lp '() '() (append (insert-signature cur #f sigs) res)))))
((and (eq? lang 'scheme) (= 1 (length procs)))
(let* ((sig (or (get-signature (caar procs) (cdar procs) x) (let* ((sig (or (get-signature (caar procs) (cdar procs) x)
'())) '()))
(res (append (insert-signature cur (caar procs) sig) (res (append (insert-signature cur (caar procs) sig)
@ -630,9 +652,13 @@ div#footer {padding-bottom: 50px}
exports))))) exports)))))
(output (output
`((title ,(write-to-string mod-name)) `((title ,(write-to-string mod-name))
,@(reverse (append-map (lambda (x) (extract-docs x defs)) ,@(cond
((find-module-file (module-name->file mod-name))
=> (lambda (f) (reverse (extract-docs f defs exports 'module))))
(else '()))
,@(reverse (append-map (lambda (x) (extract-docs x defs exports))
(module-includes mod))) (module-includes mod)))
,@(reverse (append-map (lambda (x) (extract-docs x defs 'ffi)) ,@(reverse (append-map (lambda (x) (extract-docs x defs exports 'ffi))
(module-shared-includes mod))))))) (module-shared-includes mod)))))))
(define (main args) (define (main args)