diff --git a/src/Makefile b/src/Makefile index 5d4a6f1..409d9d4 100644 --- a/src/Makefile +++ b/src/Makefile @@ -58,6 +58,8 @@ HACKERBASE-OBJS=hackerbase.o testing.o listing.o cal-month.o \ template-list-expander.o box-drawing.o util-list.o \ export-web-static.o util-dir.o racket-kwargs.o dokuwiki.o +GENDOC-OBJS=gendoc.o duck-extract.o + .PHONY: imports imports: $(HACKERBASE-DEPS) @@ -84,6 +86,9 @@ install-dev: static install -m 0755 -d /usr/local/man/man1 install -m 0755 ../doc/hackerbase.1 /usr/local/man/man1/hackerbase-dev.1 +../gendoc: $(GENDOC-OBJS) + $(CSC) -strip -static -o $@ $(GENDOC-OBJS) + ################################################################ # Module static and shared object and import source compilation @@ -94,10 +99,14 @@ install-dev: static $(CSC) -regenerate-import-libraries -P -J $< ################################################################ -# Main program +# Main programs hackerbase.o: $(HACKERBASE-DEPS) +GENDOC-SOURCES=gendoc.scm duck-extract.import.scm + +gendoc.o: $(GENDOC-SOURCES) + ################################################################ # Modules @@ -495,3 +504,8 @@ dokuwiki.import.scm: $(DOKUWIKI-SOURCES) DUCK-SOURCES=duck.scm duck.import.scm: $(DUCK-SOURCES) + +DUCK-EXTRACT-SOURCES=duck-extract.scm + +duck-extract.o: duck-extract.import.scm +duck-extract.import.scm: $(DUCK-EXTRACT-SOURCES) diff --git a/src/duck-extract.scm b/src/duck-extract.scm new file mode 100644 index 0000000..88a4f3d --- /dev/null +++ b/src/duck-extract.scm @@ -0,0 +1,92 @@ +;; +;; duck-extract.scm +;; +;; Duck - a CHICKEN in-source documentation: extraction tool. +;; +;; ISC License +;; +;; Copyright 2023 Dominik Pantůček +;; +;; Permission to use, copy, modify, and/or distribute this software +;; for any purpose with or without fee is hereby granted, provided +;; that the above copyright notice and this permission notice appear +;; in all copies. +;; +;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL +;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED +;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE +;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR +;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS +;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, +;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN +;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. +;; + +(declare (unit duck-extract)) + +(module + duck-extract + ( + print-module-duck + ) + + (import scheme + (chicken base) + (chicken string) + (chicken format)) + + (define (print-duck-text dt) + (print + (string-intersperse + (map (lambda (x) + (format "~A" x)) + dt) + " "))) + + (define (print-duck-module sec) + (print "## " (cadr sec) " [module]") + (newline) + (print-duck-text (caddr sec))) + + (define (print-duck-variable sec) + (newline) + (print "### " (cadr sec) " [variable]") + (newline) + (print " (define " (cadr sec) " " (cadddr sec) ")") + (newline) + (print-duck-text (caddr sec))) + + (define (print-duck-parameter sec) + (newline) + (print "### " (cadr sec) " [parameter]") + (newline) + (print " (define " (cadr sec) " (make-parameter " (list-ref sec 4) "))") + (print " (" (cadr sec) ")") + (print " (" (cadr sec) " " (cadddr sec) ")") + (newline) + (print-duck-text (caddr sec))) + + (define (print-duck-procedure sec) + (newline) + (print "### " (cadr sec) " [procedure]") + (newline) + (print " " (cons (cadr sec) (cadddr sec))) + (newline) + (print-duck-text (caddr sec))) + + (define (print-duck-unknown sec) + (print sec)) + + (define (print-module-duck mod) + (let loop ((mod mod)) + (when (not (null? mod)) + (when (car mod) + (case (caar mod) + ((MOD) (print-duck-module (car mod))) + ((VAR) (print-duck-variable (car mod))) + ((PAR) (print-duck-parameter (car mod))) + ((FUN) (print-duck-procedure (car mod))) + (else (print-duck-unknown (car mod))))) + (loop (cdr mod))))) + + ) diff --git a/src/gendoc.scm b/src/gendoc.scm new file mode 100644 index 0000000..e830ef8 --- /dev/null +++ b/src/gendoc.scm @@ -0,0 +1,4 @@ + +(import duck-extract) + +(print "GENDOC")