;;
;; duck.scm
;;
;; Duck - a CHICKEN in-source documentation.
;;
;; ISC License
;;
;; Copyright 2023 Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; 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))

(module
 duck
 (
  module*
  duck-extract-defines
  duck-extract-doc
  )

 (import scheme
	 (chicken base)
	 (chicken syntax))

 (define-syntax duck-extract-defines
   (syntax-rules
       (define define/doc
	 make-parameter
	 define* define*/doc
	 define-syntax define-syntax/doc)
     ((_ (define-syntax id transformer))
      (define-syntax id transformer))
     ((_ (define-syntax/doc id doc transformer))
      (define-syntax id transformer))

     ((_ (define var val))
      (define var val))
     ((_ (define/doc var doc val))
      (define var val))

     ((_ (define/doc var doc arg (make-parameter val)))
      (define var (make-parameter val)))

     ((_ (define* var val))
      (define* var val))
     ((_ (define*/doc var doc val))
      (define* var val))

     ((_ (define (proc . args) expr ...))
      (define (proc . args) expr ...))
     ((_ (define/doc (proc . args) doc expr ...))
      (define (proc . args) expr ...))

     ((_ (define* (proc . args) expr ...))
      (define* (proc . args) expr ...))
     ((_ (define*/doc (proc . args) doc expr ...))
      (define* (proc . args) expr ...))

     ((_ expr)
      expr)))

 (define-syntax duck-extract-doc
   (syntax-rules (define/doc make-parameter define*/doc define-syntax/doc syntax-rules)
     ((_ (define-syntax/doc id doc
	   (syntax-rules (literal ...)
	     (pattern template) ...)))
      (list 'STX 'id `doc '(pattern ...)))
     ((_ (define-syntax/doc id doc transformer))
      (list 'STX 'id `doc))
     ((_ (define/doc (proc . args) doc expr ...))
      (list 'FUN 'proc `doc 'args))
     ((_ (define*/doc (proc . args) doc expr ...))
      (list 'FUN 'proc `doc 'args))
     ((_ (define/doc var doc arg (make-parameter val)))
      (list 'PAR 'var `doc 'arg 'val))
     ((_ (define*/doc var doc arg (make-parameter val)))
      (list 'PAR 'var `doc 'arg 'val))
     ((_ (define/doc var doc val))
      (list 'VAR 'var `doc 'val))
     ((_ (define*/doc var doc val))
      (list 'VAR 'var `doc 'val))
     ((_ expr)
      #f)))

 (define-syntax module*
   (syntax-rules (#:doc)
     ((_ modname #:doc (doc ...) exports expr ...)
      (module
       modname
       exports
       (import scheme
	       (chicken module)
	       (chicken base)
	       duck
	       )
       (export modname)
       (duck-extract-defines expr) ...
       (define modname
	 (list (list 'MOD 'modname `(doc ...))
	       (duck-extract-doc expr) ...))))
     ((_ modname expr ...)
      (module* modname #:doc () expr ...))))
 
 )