rose-ash/sx/sx/spec-introspect.sx

(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})))))