(define spec-form-name (fn (form) (if (< (len form) 2) nil (let ((head (symbol-name (first form))) (name-part (nth form 1))) (cond (= head "define") (if (= (type-of name-part) "symbol") (symbol-name name-part) nil) (or (= head "defcomp") (= head "defisland") (= head "defmacro")) (if (= (type-of name-part) "symbol") (symbol-name name-part) nil) :else nil))))) (define spec-form-effects (fn (form) (let ((result (list)) (found false)) (when (> (len form) 3) (for-each (fn (item) (if found (when (and (list? item) (empty? result)) (for-each (fn (eff) (append! result (if (= (type-of eff) "symbol") (symbol-name eff) (str eff)))) item) (set! found false)) (when (and (= (type-of item) "keyword") (= (keyword-name item) "effects")) (set! found true)))) (slice form 2))) result))) (define spec-form-params (fn (form) (if (< (len form) 2) (list) (let ((body (nth form (- (len form) 1)))) (if (and (list? body) (> (len body) 1) (= (type-of (first body)) "symbol") (or (= (symbol-name (first body)) "fn") (= (symbol-name (first body)) "lambda"))) (let ((raw-params (nth body 1))) (if (list? raw-params) (map (fn (p) (cond (= (type-of p) "symbol") {:type nil :name (symbol-name p)} (and (list? p) (>= (len p) 3) (= (type-of (first p)) "symbol")) {:type (if (and (>= (len p) 3) (= (type-of (nth p 2)) "symbol")) (symbol-name (nth p 2)) nil) :name (symbol-name (first p))} :else {:type nil :name (str p)})) raw-params) (list))) (list)))))) (define spec-form-kind (fn (form) (let ((head (symbol-name (first form)))) (cond (= head "defcomp") "component" (= head "defisland") "island" (= head "defmacro") "macro" (= head "define") (let ((body (last form))) (if (and (list? body) (> (len body) 0) (= (type-of (first body)) "symbol") (or (= (symbol-name (first body)) "fn") (= (symbol-name (first body)) "lambda"))) "function" "constant")) :else "unknown")))) (define spec-form-signature (fn (form) (let ((head (symbol-name (first form))) (name (spec-form-name form))) (cond (or (= head "define") (= head "defcomp") (= head "defisland") (= head "defmacro")) (let ((body (last form))) (if (and (list? body) (> (len body) 0) (= (type-of (first body)) "symbol") (or (= (symbol-name (first body)) "fn") (= (symbol-name (first body)) "lambda"))) (let ((params (nth body 1))) (str "(" head " " name " (fn " (serialize params) " …))")) (str "(" head " " name " …)"))) :else (str "(" head " " name " …)"))))) (define spec-group-sections (fn (forms source) (let ((sections (list)) (current-title "Definitions") (current-comment nil) (current-defines (list))) (for-each (fn (form) (when (and (list? form) (> (len form) 1)) (let ((name (spec-form-name form))) (when name (append! current-defines {:kind (spec-form-kind form) :name name}))))) forms) (when (not (empty? current-defines)) (append! sections {:defines current-defines :title current-title :comment current-comment})) sections))) (define spec-compute-stats (fn (sections source) (let ((total 0) (pure 0) (mutation 0) (io 0) (render 0) (lines (len (split source "\n")))) (for-each (fn (section) (for-each (fn (d) (set! total (inc total)) (if (empty? (get d "effects")) (set! pure (inc pure)) (for-each (fn (eff) (cond (= eff "mutation") (set! mutation (inc mutation)) (= eff "io") (set! io (inc io)) (= eff "render") (set! render (inc render)))) (get d "effects")))) (get section "defines"))) sections) {:lines lines :io-count io :render-count render :pure-count pure :mutation-count mutation :test-total 0 :total-defines total}))) (define spec-explore-define :effects (io) (fn (filename def-name) (let ((source (helper "read-spec-file" filename))) (if (starts-with? source ";; spec file not found") nil (let ((forms (sx-parse source)) (found nil)) (for-each (fn (form) (when (and (not found) (list? form) (> (len form) 1)) (let ((name (spec-form-name form))) (when (= name def-name) (set! found {:kind (spec-form-kind form) :effects (spec-form-effects form) :params (spec-form-params form) :source (serialize form) :name name}))))) forms) found))))) (define spec-explore :effects (io) (fn (filename title desc) (let ((source (helper "read-spec-file" filename))) (if (starts-with? source ";; spec file not found") nil (let ((forms (sx-parse source)) (sections (spec-group-sections forms source)) (stats (spec-compute-stats sections source))) {:stats stats :desc desc :title title :filename filename :platform-interface (list) :sections sections})))))