宏高级技巧 #

(defmacro safe-let [bindings & body]
  `(let [~@bindings]
     ~@body))

(let [x 10]
  (safe-let [x 20]
    x))

(defmacro unsafe-swap [a b]
  `(let [temp ~a]
     (set! ~a ~b)
     (set! ~b temp)))

(let [temp 100
      x 1
      y 2]
  (unsafe-swap x y)
  temp)

(defmacro safe-swap [a b]
  (let [temp-sym (gensym "temp")]
    `(let [~temp-sym ~a]
       (set! ~a ~b)
       (set! ~b ~temp-sym))))

(let [temp 100
      x 1
      y 2]
  (safe-swap x y)
  [x y temp])

(defmacro safe-swap [a b]
  `(let [temp# ~a]
     (set! ~a ~b)
     (set! ~b temp#)))

(macroexpand-1 '(safe-swap x y))

(defmacro defn-cached [name & body]
  (let [doc-string (when (string? (first body)) (first body))
        params (if doc-string (second body) (first body))
        fn-body (if doc-string (nnext body) (next body))]
    `(defn ~name ~@(when doc-string [doc-string]) ~params
       (let [cache# (atom {})]
         (if-let [cached# (@cache# [~@params])]
           cached#
           (let [result# (do ~@fn-body)]
             (swap! cache# assoc [~@params] result#)
             result#))))))

(defn-cached expensive-calc [x]
  (println "Computing...")
  (* x x))

(expensive-calc 5)

(expensive-calc 5)

(defmacro defmulti-impl [name & impls]
  (let [dispatch-fn (first impls)
        methods (next impls)]
    `(do
       (defmulti ~name ~dispatch-fn)
       ~@(for [[dispatch-val params & body] methods]
           `(defmethod ~name ~dispatch-val ~params
              ~@body)))))

(defmulti-impl area :shape
  [:circle [{:keys [radius]}]]
  (* Math/PI radius radius)
  [:rectangle [{:keys [width height]}]]
  (* width height))

(area {:shape :circle :radius 5})

(area {:shape :rectangle :width 10 :height 5})

(defmacro with-options [name options & body]
  (let [opts (apply hash-map options)]
    `(let [~@(mapcat (fn [[k v]] [k v]) opts)]
       ~@body)))

(with-options my-fn
  {:timeout 5000
   :retries 3}
  [timeout retries])

(defmacro with-logging [name & body]
  `(do
     (println "Starting:" '~name)
     (let [result# (do ~@body)]
       (println "Finished:" '~name)
       result#)))

(defmacro with-timing [name & body]
  `(let [start# (System/nanoTime)
         result# (do ~@body)
         end# (System/nanoTime)]
     (println "Time for" '~name ":" (/ (double (- end# start#)) 1000000.0) "ms")
     result#))

(defmacro with-instrumentation [name & body]
  `(with-logging ~name
     (with-timing ~name
       ~@body)))

(with-instrumentation my-operation
  (Thread/sleep 100)
  :done)

(defmacro deftracer [name]
  `(defmacro ~name [expr]
     `(let [result# ~expr]
        (println '~name ":" '~expr "=" result#)
        result#)))

(deftracer trace)

(trace (+ 1 2))

(defmacro let-if [bindings condition & body]
  (let [pairs (partition 2 bindings)]
    `(if ~condition
       (let [~@(mapcat identity pairs)]
         ~@body)
       (let [~@(mapcat (fn [[k v]] [k nil]) pairs)]
         ~@body))))

(let-if [x 10 y 20] true
  [x y])

(let-if [x 10 y 20] false
  [x y])

(defmacro match [expr & clauses]
  (let [g (gensym)]
    `(let [~g ~expr]
       (cond
         ~@(mapcat
             (fn [[pattern result]]
               (if (= pattern :else)
                 [true result]
                 [`(= ~g ~pattern) result]))
             (partition 2 clauses))))))

(match 1
  1 "one"
  2 "two"
  :else "other")

(match 5
  1 "one"
  2 "two"
  :else "other")

(defmacro defroute [name & routes]
  `(defn ~name [request#]
     (case (:path request#)
       ~@(mapcat
           (fn [[path handler]]
             [path `(~handler request#)])
           (partition 2 routes))
       {:status 404 :body "Not Found"})))

(defroute api-routes
  "/users" (fn [req] {:status 200 :body "Users"})
  "/posts" (fn [req] {:status 200 :body "Posts"}))

(api-routes {:path "/users"})

(api-routes {:path "/posts"})

(api-routes {:path "/unknown"})

(defmacro compile-time-inc [n]
  (inc n))

(compile-time-inc 5)

(macroexpand-1 '(compile-time-inc 5))

(defmacro def-fast [name params & body]
  (let [hinted-params (mapv (fn [p]
                              (if (vector? p)
                                (with-meta (first p) {:tag (second p)})
                                p))
                            params)]
    `(defn ~name ~hinted-params
       ~@body)))

(def-fast add [[x Long] [y Long]]
  (+ x y))

(defmacro when-compile [condition & body]
  (when condition
    `(do ~@body)))

(when-compile true
  (println "This is compiled in"))

(when-compile false
  (println "This is not compiled in"))

(defmacro inline-map [f coll]
  (if (vector? coll)
    (mapv (fn [x] `(~f ~x)) coll)
    `(map ~f ~coll)))

(inline-map inc [1 2 3])

(macroexpand-1 '(inline-map inc [1 2 3]))

(defmacro macro-trace [form]
  `(do
     (println "Input:" '~form)
     (println "Expand-1:" (quote ~(macroexpand-1 form)))
     (println "Expand:" (quote ~(macroexpand form)))
     ~form))

(defmacro my-when [test & body]
  `(if ~test (do ~@body)))

(macro-trace (my-when true (println "hi")))

(defmacro assert-macro [expected actual]
  `(let [exp# ~expected
         act# ~actual]
     (when-not (= exp# act#)
       (throw (ex-info "Macro assertion failed"
                       {:expected exp# :actual act#})))))

(assert-macro
  '(if true (do (println "hi")))
  (macroexpand-1 '(my-when true (println "hi"))))

(defmacro defstate [name & transitions]
  (let [states (set (map first transitions))]
    `(defn ~name [current# event#]
       (case [current# event#]
         ~@(mapcat
             (fn [[from to event]]
               [[from event] to])
             transitions)
         current#))))

(defstate door-state
  [:closed :open :open]
  [:open :close :closed])

(door-state :closed :open)

(door-state :open :close)

(door-state :closed :invalid)

(defmacro validate [value & rules]
  (let [v (gensym "v")]
    `(let [~v ~value]
       (and
         ~@(for [[pred msg] (partition 2 rules)]
             `(or (~pred ~v)
                  (throw (ex-info ~msg {:value ~v}))))))))

(validate 5
  pos? "Must be positive"
  even? "Must be even"
  #(< % 10) "Must be less than 10")

(validate 6
  pos? "Must be positive"
  even? "Must be even"
  #(< % 10) "Must be less than 10")

(defmacro query [table & clauses]
  (let [where-clause (some #(when (= (first %) :where) %) clauses)
        select-clause (some #(when (= (first %) :select) %) clauses)]
    `{:table ~table
      :select ~(second select-clause)
      :where ~(second where-clause)}))

(query users
  :select [:id :name :email]
  :where {:active true})

(defmacro def-enum [name & values]
  (when (empty? values)
    (throw (ex-info "def-enum requires at least one value" {})))
  `(do
     ~@(for [v values]
         `(def ~(symbol (str name "-" v)) ~v))
     (def ~name #{~@values})))

(def-enum status :active :inactive :pending)

status-active

status

(defmacro with-resource
  "Evaluates body with resource bound to expr, ensuring resource is closed.
   
   Example:
   (with-resource [r (FileInputStream. \"file.txt\")]
     (.read r))"
  [[sym expr] & body]
  `(let [~sym ~expr]
     (try
       ~@body
       (finally
         (.close ~sym)))))