Level 2: symbolic-time-memory skill - memory-objects-since(timestamp) — hash-table walk, objects with version >= timestamp - memory-objects-in-range(since until) — version between two timestamps - context-query-with-time — extended query with :since :until - 6 tests, 100% pass Level 3: sensor-time skill - format-time-for-llm — TIME: section for system prompt (iso/natural format) - session-duration — session start tracking - sensor-time-tick — deadline scanning, cron-registered, 0 LLM tokens - TIME_AWARENESS / TIME_FORMAT / DEADLINE_WARNING_MINUTES env vars - 13 tests, 100% pass Level 1: TIME injection in think() (core-reason) - fboundp-guarded call to format-time-for-llm - session duration included when sensor-time skill loaded - Injected at top of system prompt in both token-economics and fallback paths Full suite: 135/135 (100%)
135 lines
5.0 KiB
Common Lisp
135 lines
5.0 KiB
Common Lisp
(in-package :passepartout)
|
|
|
|
(defvar *session-cost* (list :total 0.0 :calls 0 :by-provider nil)
|
|
"Session cost accumulator: (:total <float> :calls <int> :by-provider <alist>)")
|
|
|
|
(defvar *session-cost-lock* (bordeaux-threads:make-lock "session-cost-lock")
|
|
"Lock protecting *session-cost* from concurrent updates.")
|
|
|
|
(defun cost-track-call (provider prompt-text &optional response-text)
|
|
"Compute and accumulate the cost of a single LLM call.
|
|
Returns the cost of this call in USD."
|
|
(let* ((input-tokens (funcall (symbol-function 'count-tokens) (or prompt-text "")))
|
|
(output-tokens (if response-text (funcall (symbol-function 'count-tokens) response-text) 0))
|
|
(total-tokens (+ input-tokens output-tokens))
|
|
(cost (provider-token-cost provider total-tokens)))
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(incf (getf *session-cost* :total) cost)
|
|
(incf (getf *session-cost* :calls))
|
|
(let ((by-prov (getf *session-cost* :by-provider)))
|
|
(let ((entry (assoc provider by-prov)))
|
|
(if entry
|
|
(incf (cdr entry) cost)
|
|
(setf (getf *session-cost* :by-provider)
|
|
(acons provider cost by-prov))))))
|
|
(log-message "COST TRACKER: ~a call: ~,4f USD (session total: ~,4f USD)"
|
|
provider cost (getf *session-cost* :total))
|
|
cost))
|
|
|
|
(defun cost-session-total ()
|
|
"Returns the current session's total cost in USD."
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(getf *session-cost* :total)))
|
|
|
|
(defun cost-session-calls ()
|
|
"Returns the total number of LLM calls in this session."
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(getf *session-cost* :calls)))
|
|
|
|
(defun cost-by-provider ()
|
|
"Returns an alist of (provider . total-cost) for this session."
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(getf *session-cost* :by-provider)))
|
|
|
|
(defun cost-session-reset ()
|
|
"Zeroes the session cost accumulator."
|
|
(bordeaux-threads:with-lock-held (*session-cost-lock*)
|
|
(setf (getf *session-cost* :total) 0.0)
|
|
(setf (getf *session-cost* :calls) 0)
|
|
(setf (getf *session-cost* :by-provider) nil)
|
|
(log-message "COST TRACKER: Session cost reset.")))
|
|
|
|
(defun cost-format-budget-status (&optional (daily-budget nil))
|
|
"Returns a string for the TUI status bar showing session cost.
|
|
If DAILY-BUDGET is provided, includes percentage of budget used."
|
|
(let* ((total (cost-session-total))
|
|
(calls (cost-session-calls))
|
|
(budget (or daily-budget
|
|
(ignore-errors
|
|
(parse-integer (uiop:getenv "COST_BUDGET_DAILY")))
|
|
0))
|
|
(pct (if (> budget 0) (* 100.0 (/ total budget)) 0.0))
|
|
(status (cond
|
|
((= calls 0) "—")
|
|
((< pct 50) "OK")
|
|
((< pct 90) "WARN")
|
|
(t "HIGH"))))
|
|
(if (> budget 0)
|
|
(format nil "[Cost: $~,2f (~,0f%) ~a]" total pct status)
|
|
(format nil "[Cost: $~,2f | ~d calls]" total calls))))
|
|
|
|
(defun cost-track-backend-call (backend prompt-text &optional response-text)
|
|
"Track cost of a backend cascade call."
|
|
(cost-track-call backend prompt-text response-text))
|
|
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :passepartout-cost-tests
|
|
(:use :cl :fiveam :passepartout)
|
|
(:export #:cost-suite))
|
|
|
|
(in-package :passepartout-cost-tests)
|
|
|
|
(def-suite cost-suite :description "Cost tracking and budget management")
|
|
(in-suite cost-suite)
|
|
|
|
(test test-cost-track-call
|
|
"Contract 1: cost-track-call returns a positive number."
|
|
(cost-session-reset)
|
|
(let ((cost (cost-track-call :deepseek "hello world")))
|
|
(is (numberp cost))
|
|
(is (> cost 0.0))))
|
|
|
|
(test test-cost-session-total-accumulates
|
|
"Contract 2: session total grows with multiple calls."
|
|
(cost-session-reset)
|
|
(cost-track-call :deepseek "hello")
|
|
(cost-track-call :deepseek "world")
|
|
(let ((total (cost-session-total)))
|
|
(is (> total 0.0))
|
|
(is (= 2 (cost-session-calls)))))
|
|
|
|
(test test-cost-session-reset
|
|
"Contract 3: cost-session-reset zeroes the accumulator."
|
|
(cost-session-reset)
|
|
(cost-track-call :deepseek "hello")
|
|
(is (> (cost-session-total) 0.0))
|
|
(cost-session-reset)
|
|
(is (= 0.0 (cost-session-total)))
|
|
(is (= 0 (cost-session-calls))))
|
|
|
|
(test test-cost-format-budget-status
|
|
"Contract 4: format-budget-status returns a string."
|
|
(cost-session-reset)
|
|
(cost-track-call :deepseek "hello world")
|
|
(let ((status (cost-format-budget-status 100)))
|
|
(is (stringp status))
|
|
(is (search "$" status))))
|
|
|
|
(test test-cost-by-provider
|
|
"Contract: cost-by-provider returns per-provider breakdown."
|
|
(cost-session-reset)
|
|
(cost-track-call :deepseek "a")
|
|
(cost-track-call :groq "b")
|
|
(let ((by (cost-by-provider)))
|
|
(is (listp by))
|
|
(is (assoc :deepseek by))
|
|
(is (assoc :groq by))))
|
|
|
|
(test test-cost-track-no-response
|
|
"Contract 1: cost-track-call works without response-text."
|
|
(cost-session-reset)
|
|
(let ((cost (cost-track-call :deepseek "test")))
|
|
(is (> cost 0.0))))
|