feat: run the real clojure.tools.logging (defmacro/syntax-quote/ns + host shims)
Pivot from a jolt reimplementation to running the upstream library verbatim.
Vendors the real clojure/tools/logging.clj; jolt provides the backend and the
host primitives it needs. Language features (broadly useful for real Clojure
libs), all covered in 3-mode conformance + spec suites:
- defmacro: multi-arity dispatch (jolt-q8l) and a docstring + attr-map + params
head (jolt-qnr) — the 4-arity log macro and every level macro need these.
- syntax-quote resolves an alias-qualified symbol to its target ns (jolt-9av),
so a macro template (impl/get-logger) resolves at the use site.
- the ns macro unwraps ^{:map} metadata on the ns name (jolt-8w2 workaround,
matching def/defn/defmacro).
- a namespace object self-evaluates, so ~*ns* can be spliced into a template.
Host shims (ported from / modeled on clojure where applicable):
- clojure.string/trim-newline (ported, CharSequence interop -> count/subs)
- agent/send-off/send (minimal synchronous stubs; jolt has no thread pool/STM)
- clojure.lang.LockingTransaction/isRunning -> false
- a minimal clojure.pprint (pprint/with-pprint-dispatch/code-dispatch, for spy)
- clojure.tools.logging.impl: a jolt stderr LoggerFactory backend (the library's
designed pluggable extension point)
docs/libraries.md lists tools.logging; grammar.ebnf metadata note clarified.
Conformance 355/355 x3 modes; full jpm test gate green.
This commit is contained in:
Yogthos
parent
72e36f46de
commit
cf1fdfdb24
14 changed files with 556 additions and 95 deletions
|
|
@ -123,9 +123,12 @@ deref = "@" , form ; (* (deref form) *)
|
|||
metadata = "^" , meta-form , ws , form ; (* attach metadata to form *)
|
||||
meta-form = map | keyword | symbol | string ;
|
||||
(* Normalized like Clojure: a symbol or string is a type hint -> {:tag ...};
|
||||
a keyword -> {keyword true}; a map is used as-is. On a symbol the metadata
|
||||
rides on the symbol (it stays a bare symbol, so a hint like ^String is
|
||||
transparent in params/lets/bodies); other targets use a runtime with-meta. *)
|
||||
a keyword -> {keyword true}; a map is used as-is. A keyword/symbol/string
|
||||
meta-form on a symbol rides ON the symbol (it stays a bare symbol, so a hint
|
||||
like ^String is transparent in params/lets/bodies). A MAP meta-form routes
|
||||
through a runtime (with-meta form ...) even on a symbol (jolt-8w2), so a name
|
||||
with ^{:map} metadata reads as a form, not a bare symbol — def/defn/defmacro/ns
|
||||
unwrap that to the bare name (and attach the metadata). *)
|
||||
|
||||
(* --------------------------------------------------------------------------
|
||||
Dispatch forms — introduced by "#".
|
||||
|
|
|
|||
|
|
@ -24,6 +24,13 @@ Libraries confirmed to load and pass their conformance checks on Jolt
|
|||
[jolt-lang/db](https://github.com/jolt-lang/db) (`next.jdbc`, `next.jdbc.sql`,
|
||||
`next.jdbc.prepare`, `next.jdbc.transaction`) over `jdbc.core`, for libraries
|
||||
that target the next.jdbc API
|
||||
* [tools.logging](https://github.com/clojure/tools.logging) — the real
|
||||
`clojure.tools.logging` source runs verbatim. jolt provides a native
|
||||
`clojure.tools.logging.impl` backend (a stderr `LoggerFactory` — the library's
|
||||
designed extension point, where slf4j/log4j/jul adapters normally plug in) plus
|
||||
the host shims it needs (`agent`/`send-off`, `clojure.lang.LockingTransaction`,
|
||||
a `clojure.pprint` subset, `clojure.string/trim-newline`). The level macros,
|
||||
`logf`/`logp`, `spy`, and `enabled?` all work; output goes to stderr.
|
||||
* [migratus](https://github.com/yogthos/migratus) — database migrations; loads
|
||||
unmodified and runs filesystem SQL/EDN migrations against SQLite through the
|
||||
next.jdbc layer above. `migrate`/`rollback` round-trip end to end. Caveat:
|
||||
|
|
|
|||
|
|
@ -110,7 +110,12 @@
|
|||
;; then. Its body resolves fn/map/reduce/cond at EXPANSION time, by which point all
|
||||
;; of 00-syntax has loaded, so using them here is fine.
|
||||
(defmacro ns [nm & clauses]
|
||||
(let [calls (reduce
|
||||
;; ^{:map} metadata on the ns name reads as a (with-meta sym {...}) form, not an
|
||||
;; annotated symbol (jolt-8w2). Real libraries put :author/:doc there
|
||||
;; (clojure.tools.logging), so unwrap to the bare symbol; jolt does not track
|
||||
;; namespace metadata, so the map is dropped.
|
||||
(let [nm (if (and (seq? nm) (= 'with-meta (first nm))) (second nm) nm)
|
||||
calls (reduce
|
||||
(fn [acc clause]
|
||||
(if (seq? clause)
|
||||
(let [head (first clause) args (rest clause)]
|
||||
|
|
|
|||
|
|
@ -177,3 +177,30 @@
|
|||
(defmethod print-method :jolt/chan [c w]
|
||||
(.write w "#<channel>")
|
||||
nil)
|
||||
|
||||
;; Minimal synchronous agent shim. jolt has no thread pool or STM, so this is
|
||||
;; enough for libraries that hold an agent but don't depend on asynchronous
|
||||
;; dispatch (e.g. clojure.tools.logging's *logging-agent*, which only sends from
|
||||
;; within a transaction — never the case here, so it always logs directly). An
|
||||
;; agent is an atom; send/send-off apply the action immediately. NOT concurrent.
|
||||
(defn agent
|
||||
"Creates an agent (an atom on jolt — synchronous, no async dispatch)."
|
||||
[state & _opts]
|
||||
(atom state))
|
||||
|
||||
(defn send-off
|
||||
"Apply (action state & args) to the agent's state immediately; return the agent."
|
||||
[a f & args]
|
||||
(apply swap! a f args)
|
||||
a)
|
||||
|
||||
(defn send
|
||||
"Like send-off on jolt (no separate thread pool)."
|
||||
[a f & args]
|
||||
(apply swap! a f args)
|
||||
a)
|
||||
|
||||
(defn agent-error
|
||||
"jolt agents never enter an error state."
|
||||
[_a]
|
||||
nil)
|
||||
|
|
|
|||
28
src/jolt/clojure/pprint.clj
Normal file
28
src/jolt/clojure/pprint.clj
Normal file
|
|
@ -0,0 +1,28 @@
|
|||
;; clojure.pprint — minimal jolt shim.
|
||||
;;
|
||||
;; The real clojure.pprint is a full pretty-printer (thousands of lines of column
|
||||
;; tracking / dispatch tables). This shim provides just the surface that portable
|
||||
;; libraries reach for when they "pretty print" a value — notably
|
||||
;; clojure.tools.logging/spy (pprint + with-pprint-dispatch + code-dispatch).
|
||||
;; pprint writes the value readably with a trailing newline (no pretty layout);
|
||||
;; the dispatch vars are recognized but not used for layout.
|
||||
(ns clojure.pprint)
|
||||
|
||||
(def code-dispatch
|
||||
"Recognized but not used for layout on jolt." :code-dispatch)
|
||||
(def simple-dispatch
|
||||
"Recognized but not used for layout on jolt." :simple-dispatch)
|
||||
|
||||
(def ^:dynamic *print-pprint-dispatch* simple-dispatch)
|
||||
|
||||
(defn pprint
|
||||
"Print object readably followed by a newline. Writes to *out* (or the given
|
||||
writer). Not a pretty-printer on jolt — no column-aware layout."
|
||||
([object] (prn object))
|
||||
([object writer] (binding [*out* writer] (prn object))))
|
||||
|
||||
(defmacro with-pprint-dispatch
|
||||
"Evaluate body with the given pprint dispatch selected. On jolt the dispatch is
|
||||
recognized but does not affect layout, so this just evaluates body."
|
||||
[_dispatch & body]
|
||||
`(do ~@body))
|
||||
|
|
@ -135,3 +135,17 @@
|
|||
(let [c (str ch)]
|
||||
(if (or (= c "\\") (= c "$")) (str "\\" c) c)))
|
||||
(seq replacement))))
|
||||
|
||||
;; Ported from clojure.string/trim-newline (CharSequence interop replaced with
|
||||
;; portable count/subs). Removes all trailing \n or \r characters.
|
||||
(defn trim-newline
|
||||
"Removes all trailing newline \\n or return \\r characters from
|
||||
string. Similar to Perl's chomp."
|
||||
[s]
|
||||
(loop [index (count s)]
|
||||
(if (zero? index)
|
||||
""
|
||||
(let [c (subs s (dec index) index)]
|
||||
(if (or (= c "\n") (= c "\r"))
|
||||
(recur (dec index))
|
||||
(subs s 0 index))))))
|
||||
|
|
|
|||
|
|
@ -1,75 +1,338 @@
|
|||
;; clojure.tools.logging — jolt shim of the public API.
|
||||
;;
|
||||
;; Faithful to the upstream macro surface (logp/logf, the level macros and their
|
||||
;; f-variants, log, enabled?, spy), dispatching through the Logger/LoggerFactory
|
||||
;; protocols in clojure.tools.logging.impl. Two deliberate departures from
|
||||
;; upstream, both forced by jolt not being a JVM:
|
||||
;;
|
||||
;; - log* writes directly. The real log* may hand off to an agent when inside a
|
||||
;; running clojure.lang.LockingTransaction; jolt has neither agents nor STM.
|
||||
;; - The throwable-first-argument branch is dropped. Upstream splits args on
|
||||
;; (instance? Throwable x); on jolt that is always false for exception values,
|
||||
;; so the would-be throwable simply becomes part of the printed message. This
|
||||
;; also avoids the double-evaluation the branch would otherwise cause here.
|
||||
(ns clojure.tools.logging
|
||||
;;; logging.clj -- delegated logging for Clojure
|
||||
|
||||
;; by Alex Taggart
|
||||
;; July 27, 2009
|
||||
|
||||
;; Copyright (c) Alex Taggart, July 2009. All rights reserved. The use
|
||||
;; and distribution terms for this software are covered by the Eclipse
|
||||
;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
||||
;; which can be found in the file epl-v10.html at the root of this
|
||||
;; distribution. By using this software in any fashion, you are
|
||||
;; agreeing to be bound by the terms of this license. You must not
|
||||
;; remove this notice, or any other, from this software.
|
||||
(ns ^{:author "Alex Taggart"
|
||||
:doc "Logging macros which delegate to a specific logging implementation.
|
||||
|
||||
A logging implementation is selected at runtime when this namespace is first
|
||||
loaded. For more details, see the documentation for *logger-factory*.
|
||||
|
||||
If you want to test that your code emits specific log messages, see the
|
||||
clojure.tools.logging.test namespace."}
|
||||
clojure.tools.logging
|
||||
(:use
|
||||
[clojure.string :only [trim-newline]]
|
||||
[clojure.pprint :only [code-dispatch pprint with-pprint-dispatch]])
|
||||
(:require [clojure.tools.logging.impl :as impl]))
|
||||
|
||||
;; The LoggerFactory used to obtain loggers. Defaults to the jolt stderr
|
||||
;; factory; rebind to plug in a different backend.
|
||||
(def ^:dynamic *logger-factory* (impl/find-factory))
|
||||
(def ^{:doc
|
||||
"The default agent used for performing logging when direct logging is
|
||||
disabled. See log* for details." :dynamic true}
|
||||
*logging-agent* (agent nil :error-mode :continue))
|
||||
|
||||
(def ^{:doc
|
||||
"The set of levels that will require using an agent when logging from within a
|
||||
running transaction. Defaults to #{:info :warn}. See log* for details." :dynamic true}
|
||||
*tx-agent-levels* #{:info :warn})
|
||||
|
||||
(def ^{:doc
|
||||
"Overrides the default rules for choosing between logging directly or via an
|
||||
agent. Defaults to nil. See log* for details." :dynamic true}
|
||||
*force* nil)
|
||||
|
||||
(defn log*
|
||||
"Write a log entry through the logger. Direct, unlike upstream's agent path."
|
||||
"Attempts to log a message, either directly or via an agent; does not check if
|
||||
the level is enabled.
|
||||
|
||||
For performance reasons, an agent will only be used when invoked within a
|
||||
running transaction, and only for logging levels specified by
|
||||
*tx-agent-levels*. This allows those entries to only be written once the
|
||||
transaction commits, and are discarded if it is retried or aborted. As
|
||||
corollary, other levels (e.g., :debug, :error) will be written even from
|
||||
failed transactions though at the cost of repeat messages during retries.
|
||||
|
||||
One can override the above by setting *force* to :direct or :agent; all
|
||||
subsequent writes will be direct or via an agent, respectively."
|
||||
[logger level throwable message]
|
||||
(impl/write! logger level throwable message)
|
||||
(if (case *force*
|
||||
:agent true
|
||||
:direct false
|
||||
(and (clojure.lang.LockingTransaction/isRunning)
|
||||
(*tx-agent-levels* level)))
|
||||
(send-off *logging-agent*
|
||||
(fn [_#] (impl/write! logger level throwable message)))
|
||||
(impl/write! logger level throwable message))
|
||||
nil)
|
||||
|
||||
(defmacro logp
|
||||
"Log a message built by print-str of args, at the given level. Args are
|
||||
evaluated only when the level is enabled."
|
||||
[level & args]
|
||||
`(let [logger# (clojure.tools.logging.impl/get-logger *logger-factory* ~(str *ns*))]
|
||||
(when (clojure.tools.logging.impl/enabled? logger# ~level)
|
||||
(log* logger# ~level nil (print-str ~@args)))))
|
||||
|
||||
(defmacro logf
|
||||
"Log a clojure.core/format message at the given level. Args are evaluated
|
||||
only when the level is enabled."
|
||||
[level & args]
|
||||
`(let [logger# (clojure.tools.logging.impl/get-logger *logger-factory* ~(str *ns*))]
|
||||
(when (clojure.tools.logging.impl/enabled? logger# ~level)
|
||||
(log* logger# ~level nil (format ~@args)))))
|
||||
(declare ^{:dynamic true} *logger-factory*) ; default LoggerFactory instance for calling impl/get-logger
|
||||
|
||||
(defmacro log
|
||||
([level message] `(logp ~level ~message))
|
||||
([level throwable message] `(logp ~level ~throwable ~message)))
|
||||
"Evaluates and logs a message only if the specified level is enabled. See log*
|
||||
for more details."
|
||||
([level message]
|
||||
`(log ~level nil ~message))
|
||||
([level throwable message]
|
||||
`(log ~*ns* ~level ~throwable ~message))
|
||||
([logger-ns level throwable message]
|
||||
`(log *logger-factory* ~logger-ns ~level ~throwable ~message))
|
||||
([logger-factory logger-ns level throwable message]
|
||||
`(let [logger# (impl/get-logger ~logger-factory ~logger-ns)]
|
||||
(if (impl/enabled? logger# ~level)
|
||||
(log* logger# ~level ~throwable ~message)))))
|
||||
|
||||
(defmacro trace [& args] `(logp :trace ~@args))
|
||||
(defmacro debug [& args] `(logp :debug ~@args))
|
||||
(defmacro info [& args] `(logp :info ~@args))
|
||||
(defmacro warn [& args] `(logp :warn ~@args))
|
||||
(defmacro error [& args] `(logp :error ~@args))
|
||||
(defmacro fatal [& args] `(logp :fatal ~@args))
|
||||
(defmacro logp
|
||||
"Logs a message using print style args. Can optionally take a throwable as its
|
||||
second arg. See level-specific macros, e.g., debug.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([level message & more] [level throwable message & more])}
|
||||
[level x & more]
|
||||
(if (or (instance? String x) (nil? more)) ; optimize for common case
|
||||
`(log ~level (print-str ~x ~@more))
|
||||
`(let [logger# (impl/get-logger *logger-factory* ~*ns*)]
|
||||
(if (impl/enabled? logger# ~level)
|
||||
(let [x# ~x]
|
||||
(if (instance? Throwable x#) ; type check only when enabled
|
||||
(log* logger# ~level x# (print-str ~@more))
|
||||
(log* logger# ~level nil (print-str x# ~@more))))))))
|
||||
|
||||
(defmacro tracef [& args] `(logf :trace ~@args))
|
||||
(defmacro debugf [& args] `(logf :debug ~@args))
|
||||
(defmacro infof [& args] `(logf :info ~@args))
|
||||
(defmacro warnf [& args] `(logf :warn ~@args))
|
||||
(defmacro errorf [& args] `(logf :error ~@args))
|
||||
(defmacro fatalf [& args] `(logf :fatal ~@args))
|
||||
(defmacro logf
|
||||
"Logs a message using a format string and args. Can optionally take a
|
||||
throwable as its second arg. See level-specific macros, e.g., debugf.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([level fmt & fmt-args] [level throwable fmt & fmt-args])}
|
||||
[level x & more]
|
||||
(if (or (instance? String x) (nil? more)) ; optimize for common case
|
||||
`(log ~level (format ~x ~@more))
|
||||
`(let [logger# (impl/get-logger *logger-factory* ~*ns*)]
|
||||
(if (impl/enabled? logger# ~level)
|
||||
(let [x# ~x]
|
||||
(if (instance? Throwable x#) ; type check only when enabled
|
||||
(log* logger# ~level x# (format ~@more))
|
||||
(log* logger# ~level nil (format x# ~@more))))))))
|
||||
|
||||
(defmacro enabled?
|
||||
"True if the given level is enabled for the (optionally given) logger ns."
|
||||
([level] `(clojure.tools.logging.impl/enabled? (clojure.tools.logging.impl/get-logger *logger-factory* ~(str *ns*)) ~level))
|
||||
([level log-ns] `(clojure.tools.logging.impl/enabled? (clojure.tools.logging.impl/get-logger *logger-factory* ~log-ns) ~level)))
|
||||
"Returns true if the specific logging level is enabled. Use of this macro
|
||||
should only be necessary if one needs to execute alternate code paths beyond
|
||||
whether the log should be written to."
|
||||
([level]
|
||||
`(enabled? ~level ~*ns*))
|
||||
([level logger-ns]
|
||||
`(impl/enabled? (impl/get-logger *logger-factory* ~logger-ns) ~level)))
|
||||
|
||||
(defmacro spy
|
||||
"Evaluate expr, log it at the given level (default :debug) as expr => value,
|
||||
and return the value. Single variadic arity (jolt defmacro takes only the
|
||||
first clause of a multi-arity macro), dispatching on arg count."
|
||||
[& args]
|
||||
(let [level (if (= 1 (count args)) :debug (first args))
|
||||
expr (if (= 1 (count args)) (first args) (second args))]
|
||||
"Evaluates expr and may write the form and its result to the log. Returns the
|
||||
result of expr. Defaults to :debug log level."
|
||||
([expr]
|
||||
`(spy :debug ~expr))
|
||||
([level expr]
|
||||
`(let [a# ~expr]
|
||||
(logp ~level (print-str '~expr "=>" (pr-str a#)))
|
||||
(log ~level
|
||||
(let [s# (with-out-str
|
||||
(with-pprint-dispatch code-dispatch ; need a better way
|
||||
(pprint '~expr)
|
||||
(print "=> ")
|
||||
(pprint a#)))]
|
||||
(trim-newline s#)))
|
||||
a#)))
|
||||
|
||||
(defmacro spyf
|
||||
"Evaluates expr and may write (format fmt result) to the log. Returns the
|
||||
result of expr. Defaults to :debug log level.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
([fmt expr]
|
||||
`(spyf :debug ~fmt ~expr))
|
||||
([level fmt expr]
|
||||
`(let [a# ~expr]
|
||||
(log ~level (format ~fmt a#))
|
||||
a#)))
|
||||
|
||||
(defn log-stream
|
||||
"Creates a PrintStream that will output to the log at the specified level."
|
||||
[level logger-ns]
|
||||
(let [logger (impl/get-logger *logger-factory* logger-ns)]
|
||||
(java.io.PrintStream.
|
||||
(proxy [java.io.ByteArrayOutputStream] []
|
||||
(flush []
|
||||
; deal with reflection in proxy-super
|
||||
(let [^java.io.ByteArrayOutputStream this this]
|
||||
(proxy-super flush)
|
||||
(let [message (.trim (.toString this))]
|
||||
(proxy-super reset)
|
||||
(if (> (.length message) 0)
|
||||
(log* logger level nil message))))))
|
||||
true)))
|
||||
|
||||
(let [orig (atom nil) ; holds original System.out and System.err
|
||||
monitor (Object.)] ; sync monitor for calling setOut/setErr
|
||||
(defn log-capture!
|
||||
"Captures System.out and System.err, piping all writes of those streams to
|
||||
the log. If unspecified, levels default to :info and :error, respectively.
|
||||
The specified logger-ns value will be used to namespace all log entries.
|
||||
|
||||
Note: use with-logs to redirect output of *out* or *err*.
|
||||
|
||||
Warning: if the logging implementation is configured to output to System.out
|
||||
(as is the default with java.util.logging) then using this function will
|
||||
result in StackOverflowException when writing to the log."
|
||||
; Implementation Notes:
|
||||
; - only set orig when nil to preserve original out/err
|
||||
; - no enabled? check before making streams since that may change later
|
||||
([logger-ns]
|
||||
(log-capture! logger-ns :info :error))
|
||||
([logger-ns out-level err-level]
|
||||
(locking monitor
|
||||
(compare-and-set! orig nil [System/out System/err])
|
||||
(System/setOut (log-stream out-level logger-ns))
|
||||
(System/setErr (log-stream err-level logger-ns)))))
|
||||
(defn log-uncapture!
|
||||
"Restores System.out and System.err to their original values."
|
||||
[]
|
||||
(locking monitor
|
||||
(when-let [[out err :as v] @orig]
|
||||
(swap! orig (constantly nil))
|
||||
(System/setOut out)
|
||||
(System/setErr err)))))
|
||||
|
||||
(defmacro with-logs
|
||||
"Evaluates exprs in a context in which *out* and *err* write to the log. The
|
||||
specified logger-ns value will be used to namespace all log entries.
|
||||
|
||||
By default *out* and *err* write to :info and :error, respectively."
|
||||
{:arglists '([logger-ns & body]
|
||||
[[logger-ns out-level err-level] & body])}
|
||||
[arg & body]
|
||||
; Implementation Notes:
|
||||
; - no enabled? check before making writers since that may change later
|
||||
(let [[logger-ns out-level err-level] (if (vector? arg)
|
||||
arg
|
||||
[arg :info :error])]
|
||||
`(binding [*out* (java.io.OutputStreamWriter.
|
||||
(log-stream ~out-level ~logger-ns))
|
||||
*err* (java.io.OutputStreamWriter.
|
||||
(log-stream ~err-level ~logger-ns))]
|
||||
~@body)))
|
||||
|
||||
;; level-specific macros
|
||||
|
||||
(defmacro trace
|
||||
"Trace level logging using print-style args.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([message & more] [throwable message & more])}
|
||||
[& args]
|
||||
`(logp :trace ~@args))
|
||||
|
||||
(defmacro debug
|
||||
"Debug level logging using print-style args.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([message & more] [throwable message & more])}
|
||||
[& args]
|
||||
`(logp :debug ~@args))
|
||||
|
||||
(defmacro info
|
||||
"Info level logging using print-style args.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([message & more] [throwable message & more])}
|
||||
[& args]
|
||||
`(logp :info ~@args))
|
||||
|
||||
(defmacro warn
|
||||
"Warn level logging using print-style args.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([message & more] [throwable message & more])}
|
||||
[& args]
|
||||
`(logp :warn ~@args))
|
||||
|
||||
(defmacro error
|
||||
"Error level logging using print-style args.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([message & more] [throwable message & more])}
|
||||
[& args]
|
||||
`(logp :error ~@args))
|
||||
|
||||
(defmacro fatal
|
||||
"Fatal level logging using print-style args.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([message & more] [throwable message & more])}
|
||||
[& args]
|
||||
`(logp :fatal ~@args))
|
||||
|
||||
(defmacro tracef
|
||||
"Trace level logging using format.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([fmt & fmt-args] [throwable fmt & fmt-args])}
|
||||
[& args]
|
||||
`(logf :trace ~@args))
|
||||
|
||||
(defmacro debugf
|
||||
"Debug level logging using format.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([fmt & fmt-args] [throwable fmt & fmt-args])}
|
||||
[& args]
|
||||
`(logf :debug ~@args))
|
||||
|
||||
(defmacro infof
|
||||
"Info level logging using format.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([fmt & fmt-args] [throwable fmt & fmt-args])}
|
||||
[& args]
|
||||
`(logf :info ~@args))
|
||||
|
||||
(defmacro warnf
|
||||
"Warn level logging using format.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([fmt & fmt-args] [throwable fmt & fmt-args])}
|
||||
[& args]
|
||||
`(logf :warn ~@args))
|
||||
|
||||
(defmacro errorf
|
||||
"Error level logging using format.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([fmt & fmt-args] [throwable fmt & fmt-args])}
|
||||
[& args]
|
||||
`(logf :error ~@args))
|
||||
|
||||
(defmacro fatalf
|
||||
"Fatal level logging using format.
|
||||
Use the 'logging.readable' namespace to avoid wrapping args in pr-str."
|
||||
{:arglists '([fmt & fmt-args] [throwable fmt & fmt-args])}
|
||||
[& args]
|
||||
`(logf :fatal ~@args))
|
||||
|
||||
(defn- call-str [str]
|
||||
(let [fq-sym (symbol str)
|
||||
ns-str (or (namespace fq-sym)
|
||||
(throw (RuntimeException.
|
||||
(format "The value of the clojure.tools.logging.factory system property is not fully-qualified: %s"
|
||||
(pr-str str)))))
|
||||
ns-sym (symbol ns-str)
|
||||
_ (try
|
||||
(require ns-sym)
|
||||
(catch Exception ex
|
||||
(throw (RuntimeException.
|
||||
(format "Could not resolve namespace for %s. Either it does not exist or it has a (circular) dependency on clojure.tools.logging."
|
||||
(pr-str str))))))
|
||||
fn-sym (symbol (name fq-sym))
|
||||
fn-var (ns-resolve ns-sym fn-sym)]
|
||||
(if fn-var
|
||||
(fn-var)
|
||||
(throw (RuntimeException.
|
||||
(format "Could not resolve var for %s."
|
||||
(pr-str str)))))))
|
||||
|
||||
(defn- find-factory []
|
||||
(if-let [factory-fn-str (System/getProperty "clojure.tools.logging.factory")]
|
||||
(call-str factory-fn-str)
|
||||
(impl/find-factory)))
|
||||
|
||||
(def ^:dynamic *logger-factory*
|
||||
"An instance satisfying the clojure.tools.logging.impl/LoggerFactory protocol,
|
||||
which allows uniform access to an underlying logging implementation.
|
||||
|
||||
The default value will be obtained by invoking a no-arg function named by the
|
||||
\"clojure.tools.logging.factory\" system property, or if unset, by invoking
|
||||
clojure.tools.logging.impl/find-factory.
|
||||
|
||||
After loading, this var can be programmatically changed to a different
|
||||
LoggerFactory implementation via binding or alter-var-root.
|
||||
|
||||
See the various factory functions in clojure.tools.logger.impl."
|
||||
(find-factory))
|
||||
|
|
|
|||
|
|
@ -198,7 +198,16 @@
|
|||
{:jolt/type :symbol
|
||||
:ns (or (get (ctx :env) :compile-ns) (ctx-current-ns ctx))
|
||||
:name nm}))
|
||||
form))
|
||||
# Alias-qualified (impl/foo): resolve the alias to its target namespace so the
|
||||
# emitted symbol resolves at the macro's USE site, which has no such alias
|
||||
# (jolt-9av). Matches Clojure's syntax-quote. A real ns name (not an alias)
|
||||
# has no entry and is left as written.
|
||||
(let [cur (ctx-find-ns ctx (or (get (ctx :env) :compile-ns) (ctx-current-ns ctx)))
|
||||
target (and cur (or (ns-alias-lookup cur (form :ns))
|
||||
(ns-import-lookup cur (form :ns))))]
|
||||
(if target
|
||||
{:jolt/type :symbol :ns target :name (form :name)}
|
||||
form))))
|
||||
|
||||
(defn- d-realize
|
||||
"Realize a lazy-seq to an array for positional destructuring / splicing; pass
|
||||
|
|
@ -1828,36 +1837,56 @@
|
|||
"defmacro" (let [# ^{:map} metadata on the name reads as a (with-meta sym …)
|
||||
# form (jolt-8w2); unwrap to the bare symbol like def does.
|
||||
name-sym (unwrap-meta-name (in form 1))
|
||||
rest-form (tuple/slice form 2)
|
||||
# optional docstring
|
||||
has-doc? (and (> (length rest-form) 0) (string? (first rest-form)))
|
||||
raw-args (if has-doc? (in rest-form 1) (first rest-form))
|
||||
raw-body (tuple/slice rest-form (if has-doc? 2 1))
|
||||
# arity-clause form: (defmacro name ([params] body...)) — like
|
||||
# fn/defn. In a code form a vector literal is a tuple and a list
|
||||
# is an array, so a params vector reads as a tuple while an arity
|
||||
# clause reads as a list (array): unwrap its params + body. Single
|
||||
# arity only (what real macros use); a multi-arity macro takes the
|
||||
# first clause.
|
||||
arity-clause? (array? raw-args)
|
||||
args-form (if arity-clause? (first raw-args) raw-args)
|
||||
body (if arity-clause? (tuple/slice raw-args 1) raw-body)
|
||||
param-info (parse-params args-form)
|
||||
fixed-pats (param-info :fixed)
|
||||
rest-pat (param-info :rest)
|
||||
after-name (tuple/slice form 2)
|
||||
# Skip an optional leading docstring (string) then an optional
|
||||
# attr-map (a struct that is not a symbol — a map literal reads
|
||||
# as a struct), matching defn. Real macros use both, e.g.
|
||||
# (defmacro info "doc" {:arglists '(...)} [& args] …).
|
||||
a1 (if (and (> (length after-name) 0) (string? (first after-name)))
|
||||
(tuple/slice after-name 1) after-name)
|
||||
after-meta (if (and (> (length a1) 0)
|
||||
(struct? (first a1))
|
||||
(not= :symbol (get (first a1) :jolt/type)))
|
||||
(tuple/slice a1 1) a1)
|
||||
# What remains is either a params VECTOR (tuple) + body, or one
|
||||
# or more arity CLAUSES (each a list, i.e. a janet array). Build
|
||||
# a uniform arity list [{:params … :body …} …].
|
||||
multi? (and (> (length after-meta) 0) (array? (first after-meta)))
|
||||
arities (if multi?
|
||||
(map (fn [cl] {:params (first cl) :body (tuple/slice cl 1)})
|
||||
after-meta)
|
||||
@[{:params (first after-meta) :body (tuple/slice after-meta 1)}])
|
||||
defining-ns (ctx-current-ns ctx)]
|
||||
(def interp-fn (fn [& macro-args]
|
||||
(def n (length macro-args))
|
||||
# Pick the arity: an exact fixed-count match wins; otherwise the
|
||||
# first variadic arity that accepts n args (Clojure fn dispatch).
|
||||
(var chosen nil)
|
||||
(each ar arities
|
||||
(def pi (parse-params (ar :params)))
|
||||
(when (and (nil? chosen) (not (pi :rest)) (= n (length (pi :fixed))))
|
||||
(set chosen [pi (ar :body)])))
|
||||
(when (nil? chosen)
|
||||
(each ar arities
|
||||
(def pi (parse-params (ar :params)))
|
||||
(when (and (nil? chosen) (pi :rest) (>= n (length (pi :fixed))))
|
||||
(set chosen [pi (ar :body)]))))
|
||||
(when (nil? chosen)
|
||||
(error (string "no matching arity for macro " (name-sym :name)
|
||||
" (" n " args)")))
|
||||
(def pi (chosen 0))
|
||||
(def body (chosen 1))
|
||||
(var new-bindings @{})
|
||||
(table/setproto new-bindings bindings)
|
||||
(put new-bindings "&env" @{}) # implicit &env for macro bodies (table — nil-safe)
|
||||
(var i 0)
|
||||
# Destructure macro params (like fn), so [& [a & more :as all]]
|
||||
# and {:keys …} rest forms work in macro arglists.
|
||||
(each pat fixed-pats
|
||||
(each pat (pi :fixed)
|
||||
(destructure-bind ctx new-bindings pat (macro-args i))
|
||||
(++ i))
|
||||
(when rest-pat
|
||||
(destructure-bind ctx new-bindings rest-pat (rest-args-val macro-args i)))
|
||||
(when (pi :rest)
|
||||
(destructure-bind ctx new-bindings (pi :rest) (rest-args-val macro-args i)))
|
||||
# Use defining namespace for symbol resolution
|
||||
(def saved-ns (ctx-current-ns ctx))
|
||||
(ctx-set-current-ns ctx defining-ns)
|
||||
|
|
@ -1870,12 +1899,20 @@
|
|||
(set result (eval-form ctx new-bindings bf)))
|
||||
(ctx-set-current-ns ctx saved-ns)
|
||||
result))
|
||||
# Prefer a COMPILED expander (native-speed expansion, zero runtime
|
||||
# cost). Skip when the body uses &env/&form (the compiled fn has no
|
||||
# such params) — those fall back to the interpreted closure.
|
||||
(def uses-env (or (form-uses-sym? body "&env") (form-uses-sym? body "&form")))
|
||||
# A COMPILED expander (native-speed) is only built for the
|
||||
# single-arity case (the compile hook + recompile path take one
|
||||
# [args body]); multi-arity macros use the interpreted expander.
|
||||
(def single? (= 1 (length arities)))
|
||||
(def args-form (and single? ((first arities) :params)))
|
||||
(def body (and single? ((first arities) :body)))
|
||||
(def uses-env (do (var u false)
|
||||
(each ar arities
|
||||
(when (or (form-uses-sym? (ar :body) "&env")
|
||||
(form-uses-sym? (ar :body) "&form"))
|
||||
(set u true)))
|
||||
u))
|
||||
(def compiled-fn
|
||||
(when (and macro-compile-hook (not uses-env))
|
||||
(when (and macro-compile-hook single? (not uses-env))
|
||||
(macro-compile-hook ctx args-form body)))
|
||||
(def macro-fn (or compiled-fn interp-fn))
|
||||
(let [ns-name (ctx-current-ns ctx)
|
||||
|
|
@ -1886,8 +1923,10 @@
|
|||
# compile it once the analyzer is alive (staged bootstrap): a
|
||||
# macro defined WHILE the analyzer is still being built gets an
|
||||
# interpreted closure now, a compiled expander later. uses-env
|
||||
# macros stay interpreted (the compiled fn* has no &env/&form).
|
||||
(put v :macro-src @[args-form body])
|
||||
# macros stay interpreted (the compiled fn* has no &env/&form);
|
||||
# multi-arity macros keep the interpreted dispatch (no single
|
||||
# [args body] to recompile).
|
||||
(when single? (put v :macro-src @[args-form body]))
|
||||
(put v :macro-uses-env uses-env)
|
||||
(when compiled-fn (put v :macro-compiled true))
|
||||
# A (re)defined macro invalidates any cached expansions.
|
||||
|
|
@ -2412,8 +2451,11 @@
|
|||
(if (= :jolt/char (form :jolt/type))
|
||||
form
|
||||
# a UUID/inst value flowing back through eval (macro expansion, eval of a
|
||||
# read form) is a self-evaluating literal, like chars.
|
||||
(if (or (= :jolt/uuid (form :jolt/type)) (= :jolt/inst (form :jolt/type)))
|
||||
# read form) is a self-evaluating literal, like chars. A namespace object
|
||||
# does too: `~*ns*` in a syntax-quote (clojure.tools.logging) splices the
|
||||
# live ns into the expansion.
|
||||
(if (or (= :jolt/uuid (form :jolt/type)) (= :jolt/inst (form :jolt/type))
|
||||
(= :jolt/namespace (form :jolt/type)))
|
||||
form
|
||||
(if (= :jolt/set (form :jolt/type))
|
||||
# evaluate each element (set literals like #{(inc 1)} must compute)
|
||||
|
|
|
|||
|
|
@ -542,6 +542,9 @@
|
|||
# (resources/<dir>). getSystemClassLoader yields the same stub.
|
||||
(each nm ["ClassLoader" "java.lang.ClassLoader"]
|
||||
(register-class-statics! nm @{"getSystemClassLoader" (fn [] @{:jolt/type :jolt/classloader})}))
|
||||
# No STM on jolt: a transaction is never running, so logging libraries that
|
||||
# gate agent-vs-direct on it (clojure.tools.logging/log*) always log directly.
|
||||
(register-class-statics! "clojure.lang.LockingTransaction" @{"isRunning" (fn [] false)})
|
||||
(register-tagged-methods! :jolt/classloader
|
||||
@{"getResource" (fn [self path] nil)
|
||||
"getResources" (fn [self path] nil)
|
||||
|
|
|
|||
|
|
@ -495,6 +495,25 @@
|
|||
# ns (jolt-9pu — it used to see an empty table).
|
||||
["cross-ns methods visible" "[:sql]"
|
||||
"(do (ns cf.mm) (defmulti ext identity) (defmethod ext :default [_] :d) (defn allk [] (vec (for [[k v] (methods ext) :when (not= k :default)] k))) (ns cf.mmi) (defmethod cf.mm/ext :sql [_] :s) (in-ns (quote user)) (cf.mm/allk))"]
|
||||
|
||||
### ---- defmacro surface + syntax-quote/ns (enabling real clojure libs) ----
|
||||
# multi-arity defmacro (clojure.tools.logging/log has 4 arities)
|
||||
["defmacro multi-arity" "[6 5 6]"
|
||||
"(do (defmacro mar ([a] (list (quote +) a 1)) ([a b] (list (quote +) a b)) ([a b c] (list (quote +) a b c))) [(mar 5) (mar 2 3) (mar 1 2 3)])"]
|
||||
# defmacro with docstring AND attr-map before the params (every tools.logging
|
||||
# level macro is shaped this way)
|
||||
["defmacro doc + attr-map" "10"
|
||||
"(do (defmacro mam \"doc\" {:arglists (quote ([x]))} [x] (list (quote inc) x)) (mam 9))"]
|
||||
# syntax-quote resolves a namespace ALIAS to its target ns, so a macro's
|
||||
# template resolves at the USE site (jolt-9av)
|
||||
["syntax-quote resolves alias" "\"HI\""
|
||||
"(do (ns sq.lib (:require [clojure.string :as s])) (defmacro up [x] `(s/upper-case ~x)) (in-ns (quote user)) (sq.lib/up \"hi\"))"]
|
||||
# ^{:map} metadata on an ns name (jolt-8w2): the ns name is the bare symbol
|
||||
["ns name with ^{:map} meta" "5"
|
||||
"(do (ns ^{:author \"a\" :doc \"d\"} nm.meta) (def q 5) (in-ns (quote user)) nm.meta/q)"]
|
||||
# ~*ns* splices the live namespace object into a template (it self-evaluates)
|
||||
["unquote *ns* in template" "true"
|
||||
"(do (defmacro cur-ns [] `(str ~*ns*)) (string? (cur-ns)))"]
|
||||
])
|
||||
|
||||
# Run every case under a given context factory and return the failures. The same
|
||||
|
|
|
|||
|
|
@ -259,8 +259,12 @@
|
|||
["file-seq finds files" "true"
|
||||
"(do (require '[clojure.java.io :as io]) (pos? (count (filter (fn [f] (.isFile f)) (file-seq (io/file \"docs\"))))))"])
|
||||
|
||||
# clojure.tools.logging shim (jolt-nzg): the macro surface works, debug/trace
|
||||
# are suppressed (no-op nil) by default, and the impl protocol layer is present.
|
||||
# The REAL clojure.tools.logging (vendored verbatim) runs on jolt: a jolt
|
||||
# clojure.tools.logging.impl backend (stderr LoggerFactory) plus host shims
|
||||
# (agent/send-off, clojure.lang.LockingTransaction/isRunning, a clojure.pprint
|
||||
# subset, clojure.string/trim-newline) and the defmacro/syntax-quote/ns fixes.
|
||||
# These cases assert the public API behaves; the level rows return nil because
|
||||
# the real level macros return the (nil) result of log* when enabled.
|
||||
(defspec "host-interop / clojure.tools.logging"
|
||||
["info returns nil" "nil" "(do (require '[clojure.tools.logging :as log]) (log/info \"hi\" 42))"]
|
||||
["debug suppressed" "nil" "(do (require '[clojure.tools.logging :as log]) (log/debug \"x\"))"]
|
||||
|
|
@ -269,4 +273,20 @@
|
|||
["enabled? debug" "false" "(do (require '[clojure.tools.logging :as log]) (log/enabled? :debug))"]
|
||||
["spy returns value" "3" "(do (require '[clojure.tools.logging :as log]) (log/spy :info (+ 1 2)))"]
|
||||
["impl factory name" "\"jolt/stderr\""
|
||||
"(do (require '[clojure.tools.logging.impl :as impl]) (impl/name (impl/find-factory)))"])
|
||||
"(do (require '[clojure.tools.logging.impl :as impl]) (impl/name (impl/find-factory)))"]
|
||||
# vars that exist only in the real library (not in a hand-rolled shim)
|
||||
["real lib *tx-agent-levels*" "#{:info :warn}"
|
||||
"(do (require '[clojure.tools.logging :as log]) log/*tx-agent-levels*)"]
|
||||
["real lib log-capture! present" "true"
|
||||
"(do (require '[clojure.tools.logging :as log]) (fn? log/log-capture!))"]
|
||||
["real lib spyf present" "true"
|
||||
"(do (require '[clojure.tools.logging :as log]) (boolean (resolve 'log/spyf)))"])
|
||||
|
||||
# Host shims that let the real clojure.tools.logging load: no STM (a transaction
|
||||
# is never running) and a minimal clojure.pprint (used by spy).
|
||||
(defspec "host-interop / logging host shims"
|
||||
["LockingTransaction/isRunning" "false" "(clojure.lang.LockingTransaction/isRunning)"]
|
||||
["pprint writes value" "\"[1 2 3]\\n\""
|
||||
"(do (require '[clojure.pprint :as pp]) (with-out-str (pp/pprint [1 2 3])))"]
|
||||
["with-pprint-dispatch runs body" "42"
|
||||
"(do (require '[clojure.pprint :as pp]) (pp/with-pprint-dispatch pp/code-dispatch 42))"])
|
||||
|
|
|
|||
|
|
@ -93,3 +93,16 @@
|
|||
["docstring + arity" "15" "(do (defmacro th \"triple\" ([x] (list (quote *) x 3))) (th 5))"]
|
||||
["^{:map} name meta" "7" "(do (defmacro ^{:private true} pm [] 7) (pm))"]
|
||||
["multi-form body" "6" "(do (defmacro mb ([a b] (list (quote +) a b))) (mb 2 4))"])
|
||||
|
||||
# Multi-arity defmacro (dispatch on arg count) and the docstring + attr-map +
|
||||
# params form — both needed to run real Clojure macros, e.g.
|
||||
# clojure.tools.logging/log (4 arities) and its level macros (jolt-q8l, jolt-qnr).
|
||||
(defspec "macros / defmacro multi-arity & attr-map"
|
||||
["multi-arity 1" "6" "(do (defmacro ma ([a] (list (quote +) a 1)) ([a b] (list (quote +) a b))) (ma 5))"]
|
||||
["multi-arity 2" "5" "(do (defmacro ma ([a] (list (quote +) a 1)) ([a b] (list (quote +) a b))) (ma 2 3))"]
|
||||
["arity delegates" "[:d nil 9]"
|
||||
"(do (defmacro lg ([m] `(lg :d nil ~m)) ([l t m] (list (quote vector) l t m))) (lg 9))"]
|
||||
["doc + attr-map + params" "10"
|
||||
"(do (defmacro am \"doc\" {:arglists (quote ([x]))} [x] (list (quote inc) x)) (am 9))"]
|
||||
["doc + attr-map + variadic" "6"
|
||||
"(do (defmacro vg \"d\" {:arglists (quote ([& a]))} [& xs] `(+ ~@xs)) (vg 1 2 3))"])
|
||||
|
|
|
|||
|
|
@ -37,3 +37,12 @@
|
|||
(defspec "state / promises"
|
||||
["promise deliver" "5" "(let [p (promise)] (deliver p 5) @p)"]
|
||||
["promise undelivered" "nil" "(let [p (promise)] @p)"])
|
||||
|
||||
# Minimal synchronous agent shim (jolt has no thread pool/STM) — enough for
|
||||
# libraries that hold an agent without depending on async dispatch.
|
||||
(defspec "state / agents (synchronous shim)"
|
||||
["agent deref" "0" "(deref (agent 0))"]
|
||||
["agent with opts" "0" "(deref (agent 0 :error-mode :continue))"]
|
||||
["send-off applies" "5" "(let [a (agent 0)] (send-off a + 5) (deref a))"]
|
||||
["send applies" "7" "(let [a (agent 1)] (send a + 6) (deref a))"]
|
||||
["agent-error nil" "nil" "(agent-error (agent 0))"])
|
||||
|
|
|
|||
|
|
@ -62,3 +62,11 @@
|
|||
["get out of range nil" "nil" "(get \"abc\" 9)"]
|
||||
["get negative nil" "nil" "(get \"abc\" -1)"]
|
||||
["get default honored" ":none" "(get \"abc\" 9 :none)"])
|
||||
|
||||
# clojure.string/trim-newline (ported from clojure.string): strips trailing \n/\r.
|
||||
(defspec "clojure.string / trim-newline"
|
||||
["trailing newline" "\"x\"" "(do (require (quote [clojure.string :as s])) (s/trim-newline \"x\\n\"))"]
|
||||
["trailing \\r\\n" "\"x\"" "(do (require (quote [clojure.string :as s])) (s/trim-newline \"x\\r\\n\"))"]
|
||||
["no trailing" "\"ab\"" "(do (require (quote [clojure.string :as s])) (s/trim-newline \"ab\"))"]
|
||||
["only newlines" "\"\"" "(do (require (quote [clojure.string :as s])) (s/trim-newline \"\\n\\n\"))"]
|
||||
["interior kept" "\"a\\nb\"" "(do (require (quote [clojure.string :as s])) (s/trim-newline \"a\\nb\\n\"))"])
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue