~dieggsy/chalk

d634643c6b6caf7af3cf6fa5d9b28bd8de4ccba4 — dieggsy 3 years ago a40db07 0.3.0
Add basic record support
1 files changed, 38 insertions(+), 1 deletions(-)

M chalk-bin.scm
M chalk-bin.scm => chalk-bin.scm +38 -1
@@ 13,7 13,7 @@
        (only srfi-1
              find
              filter
              first second third fourth)
              first second third fourth fifth sixth)
        (only srfi-13
              string-prefix?
              string-trim


@@ 122,6 122,39 @@
      (when docstr
        (printf "~a\n\n" docstr)))))

(define (document-record exp)
  (let* ((type (first exp))
         (name (second exp))
         (rec-doc (fourth exp))
         (internal (find-tag '@internal rec-doc))
         (docstr (find-docstr rec-doc))
         (full (find-tag '@full rec-doc)))
    (unless internal
      (printf "<record>~s</record>\n" name)
      (when full
        (if (eqv? type 'define-record)
            (begin
              (printf "<procedure>~a</procedure>\n" (cons (sprintf "make-~a" name)
                                                          (cddddr exp)))
              (printf "<procedure>~a?</procedure>\n" name)
              (for-each
               (lambda (e)
                 (printf "<procedure>~a-~a</procedure>\n" name e))
               (cddddr exp)))
            (begin
              (printf "<procedure>~a</procedure>\n" (fifth exp))
              (printf "<procedure>~a</procedure>\n" (sixth exp))
              (for-each
               (lambda (e)
                 (printf "<procedure>~a</procedure>\n" (cadr e))
                 (when (not (or (null? (cddr e))
                                (pair? (caddr e))))
                   (printf "<procedure>~a</procedure>\n" (caddr e))))
               (cddr (cddddr exp)))
              )))
      (when docstr
        (printf "~a\n\n" docstr)))))

(define procedure-tags
  '(fn proc procedure function))



@@ 150,6 183,10 @@
                (eqv? 'define (car exp)))
           ;; (print "VRA")
           (document-variable exp))
          ((and documentable-expr?
                (or (eqv? 'define-record (car exp))
                    (eqv? 'define-record-type (car exp))))
           (document-record exp))
          ((eqv? 'include (car exp))
           ;; (print "HEY")
           (document-file (cadr exp)))