(def privately () nil) (assign comments nil) (def fetch-and-clear-comments () ((fn (c) (assign comments nil) c) (rev comments))) (def filter-comments (form acc) (if (no form) (rev acc) (pair? form) (filter-comments (cdr form) (if (if (pair? (car form)) (eq? (caar form) 'comment)) acc (cons (filter-comments (car form) nil) acc))) form)) ((fn (this-chapter-name chapters chapter-new chapter-build chapter-add-to-chapter) (assign chapters (hash)) (def chapter-end () (assign this-chapter-name nil)) (def chapter-start (chapter-name description) (assign this-chapter-name chapter-name) (chapter-describe description chapter-name)) (def chapter-new (hsh name) (hash-set hsh 'name name) hsh) (def chapter-build (name chapter) (cond chapter chapter (cond name (hash-set chapters name (chapter-new (hash) name))))) (def chapter-names () (hash-keys chapters)) (def chapter-current () this-chapter-name) (def chapter-delete (name) (hash-set chapters name nil)) (def chapter-find (name) (chapter-build name (hash-get chapters name))) (def chapter-add-to-chapter (chapter attribute thing) (cond chapter (hash-cons chapter attribute thing))) (def chapter-add-item (item chapter-name) (chapter-add-to-chapter (chapter-find chapter-name) 'contents item)) (def chapter-describe (description chapter-name) (cond description (chapter-add-to-chapter (chapter-find chapter-name) 'description description))))) (assign this-script nil) (assign this-plugin "Nydp Core") ((fn (dox examples chapters types dox-new dox-build) (def dox-build (hsh name what texts args src chapters) (hash-set hsh 'name name ) (hash-set hsh 'what what ) (hash-set hsh 'texts texts ) (hash-set hsh 'args args ) (hash-set hsh 'src src ) (hash-set hsh 'chapters (cons (chapter-current) chapters)) (hash-set hsh 'file this-script ) (hash-set hsh 'plugin this-plugin ) hsh) (def dox-new (item) (hash-cons dox (hash-get item 'name) item) (hash-cons types (hash-get item 'what) item) (dox-add-to-chapters item (hash-get item 'chapters))) (def dox-add-doc (name what texts args src chapters more) (cond (no (privately)) (dox-new (dox-build (if more more (hash)) name what texts args src chapters)))) (def dox-add-to-chapters (item chapters) (cond chapters (do (chapter-add-item item (car chapters)) (dox-add-to-chapters item (cdr chapters))) item)) (def dox-add-examples (name example-exprs) (hash-cons examples name example-exprs)) (def dox-lookup (name) (hash-get dox name)) (def dox? (sym) (hash-key? dox sym)) (def dox-names () (hash-keys dox)) (def dox-types () (hash-keys types)) (def dox-items-by-type (type) (hash-get types type)) (def dox-get-attr (name attr) (cond (dox? name) (hash-get (car (dox-lookup name)) attr))) (def dox-what-is? (name) (dox-get-attr name 'what )) (def dox-src (name) (dox-get-attr name 'src )) (def dox-examples (name) (hash-get examples name )) (def dox-args (name) (dox-get-attr name 'args )) (def dox-example-names () (hash-keys examples ))) (hash) (hash) (hash) (hash) nil) (def plugin-start (name) (assign this-plugin name) (chapter-end)) (def plugin-end (name) (assign this-plugin nil ) (chapter-end)) (def script-start (name) (assign this-script name) (chapter-end)) (def script-end (name) (assign this-script nil ) (chapter-end)) (def script-run (event name) (cond (eq? event 'plugin-start) (plugin-start name) (cond (eq? event 'plugin-end) (plugin-end name) (cond (eq? event 'script-start) (script-start name) (cond (eq? event 'script-end) (script-end name)))))) (def filter-form (hsh form) ; if the car of 'form is a key of 'hsh, add the cdr of 'form to the value of the key in 'hsh ; otherwise add the form to the list whose key is nil (cond (cond (pair? form) (hash-key? hsh (car form))) (hash-cons hsh (car form) (cdr form)) (hash-cons hsh nil form)) hsh) (def rev-value-key (key keys old new) (hash-set new key (rev (hash-get old key))) (rev-value-keys keys old new)) (def rev-value-keys (keys old new) (cond keys (rev-value-key (car keys) (cdr keys) old new) new)) (def rev-values (hsh) (rev-value-keys (hash-keys hsh) hsh (hash))) (def filter-forms (hsh forms) ; group forms by their first element, if the first element ; is already a key in hsh, collect all other elements under key nil (cond forms (filter-forms (filter-form hsh (car forms)) (cdr forms)) (rev-values hsh))) (def build-def-hash (hsh) (hash-set hsh 'comment nil) (hash-set hsh 'chapter nil) hsh) (def define-mac-expr (name args body-forms) ; used internally by 'mac `(do (hash-set macs ',name (fun ,args ,@(hash-get body-forms nil))) (dox-add-doc ',name 'mac ',(map car (hash-get body-forms 'comment)) ',args '(mac ,name ,args ,@(hash-get body-forms nil)) ',(map car (hash-get body-forms 'chapter))))) (hash-set macs 'mac (fn (name args . body) (define-mac-expr name args (filter-forms (build-def-hash (hash)) body)))) (dox-add-doc 'mac 'mac '("define a new global macro") '(name args . body) '`(hash-set macs ',name (fn ,args ,@body)) '(nydp-core)) (dox-add-doc 'do 'mac '("perform a series of operations") 'args '`((fn nil ,@args)) '(nydp-core)) (mac def-assign args `(assign ,@args)) (def define-def-expr (name args body-forms) ; used internally by 'def `(do (def-assign ,name (fun ,args ,@(filter-comments (hash-get body-forms nil)))) (dox-add-doc ',name 'def ',(+ (fetch-and-clear-comments) (map car (hash-get body-forms 'comment))) ',args '(def ,name ,args ,@(hash-get body-forms nil)) ',(map car (hash-get body-forms 'chapter))))) (mac def (name args . body) ; define a new function in the global namespace (chapter nydp-core) (define-def-expr name args (filter-forms (build-def-hash (hash)) body))) (mac comment (txt) (assign comments (cons txt comments)) nil)