(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))
(hash-set macs ‘do
(fn forms (if (no (cdr forms)) (car forms) `((fn nil ,@forms)))))
((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 types-chapters 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 ) 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 'what) (hash-get item 'chapters) (hash))) (def dox-add-doc (name what texts args src etc) (handle-error (fn (errors traces) (error "failed to add dox for " name " - " what)) (fn () (cond (no etc) (error (inspect name) " : please provide arguments (name what texts args src etc) where etc is a hash with at least keys (chapters plugin file)")) (cond (no (privately)) (dox-new (dox-build etc name what texts args src)))))) (def dox-add-to-chapters (item type chapters already) (cond (pair? (car chapters)) (error "dox-add-to-chapters : expected symbol, got " (inspect (car chapters)) " for " (inspect item))) (cond chapters (cond (no (hash-get already (car chapters))) (do (hash-set already (car chapters) t) (chapter-add-item item (car chapters)) (hash-cons types-chapters (inspect (cons type (car chapters))) item) (dox-add-to-chapters item type (cdr chapters) already)) item) 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 get-types-chapters () types-chapters) (def dox-items-by-type-and-chapter (dox-type chapter) (hash-get types-chapters (inspect (cons dox-type chapter)))) (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) (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 ) (fetch-and-clear-comments) (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))))))
;; 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 (def filter-form (hsh form)
(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)))
;; group forms by their first element, if the first element ;; is already a key in hsh, collect all other elements under key nil (def filter-forms (hsh forms)
(cond forms (filter-forms (filter-form hsh (car forms)) (cdr forms)) (rev-values hsh)))
(def filter-remove (key forms keyforms otherforms)
(cond forms (cond (cond (pair? forms) (cond (pair? (car forms)) (eq? key (caar forms)))) (filter-remove key (cdr forms) (cons (car forms) keyforms) otherforms) (filter-remove key (cdr forms) keyforms (cons (car forms) otherforms))) (list (rev keyforms) (rev otherforms))))
(assign DEF-FORMS ‘(comment chapter))
(def hash-init (h keys v)
(if keys (do (hash-set h (car keys) v) (hash-init h (cdr keys) v))) h)
(def build-def-hash ()
(hash-init (hash) DEF-FORMS nil))
(def dox-build-def-name (name) name)
(def dox-chapters-expr-helper (chaps)
(cond chaps `(quote (,@chaps))))
(def dox-chapters-expr (chaps)
(cond (chapter-current) (dox-chapters-expr-helper (cons (chapter-current) (apply + nil chaps))) (cond chaps (dox-chapters-expr-helper (apply + chaps)))))
;; used internally by ‘mac (def define-mac-expr (name args body-forms)
`(do (hash-set macs ',name (fun ,args ,@(hash-get body-forms nil))) (dox-add-doc ',(dox-build-def-name name) 'mac ',(+ (fetch-and-clear-comments) (map car (hash-get body-forms 'comment))) ',args '(mac ,name ,args ,@(hash-get body-forms nil)) (hash 'chapters ,(dox-chapters-expr (hash-get body-forms 'chapter)) 'plugin ',this-plugin 'file ',this-script))))
(hash-set macs ‘mac
(fn (name args . body) (define-mac-expr name args (filter-forms (build-def-hash) body))))
(dox-add-doc ‘mac
'mac '("define a new global macro") '(name args . body) '`(hash-set macs ',name (fn ,args ,@body)) (hash 'chapters '(nydp-core) 'plugin this-plugin 'file this-script))
(dox-add-doc ‘do
'mac '("perform a series of operations") 'args '`((fn nil ,@args)) (hash 'chapters '(nydp-core) 'plugin this-plugin 'file this-script))
;; override later to use ‘= instead of ’assign, giving us hash-assignment and other goodies for free (mac def-assign args ‘(assign ,@args))
;; used internally by ‘def (def define-def-expr (name args body-forms)
`(do (def-assign ,name ((fn (self-name) (fun ,args ,@(filter-comments (hash-get body-forms nil)))) ',name)) (dox-add-doc ',(dox-build-def-name name) 'def ',(+ (fetch-and-clear-comments) (map car (hash-get body-forms 'comment))) ',args '(def ,name ,args ,@(hash-get body-forms nil)) (hash 'chapters ,(dox-chapters-expr (hash-get body-forms 'chapter)) 'plugin ',this-plugin 'file ',this-script))))
;; define a new function in the global namespace (mac def (name args . body)
(chapter nydp-core) (define-def-expr name args (filter-forms (build-def-hash) body)))
(mac comment (txt)
(assign comments (cons txt comments)) nil)