changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: deferror

changeset 224: fdea20982c25
parent 223: b9ebec84fc18
child 225: 58d7c3925687
author: Richard Westhaver <ellis@rwest.io>
date: Sat, 09 Mar 2024 23:01:06 -0500
files: lisp/lib/log/stream.lisp lisp/lib/obj/direction.lisp lisp/lib/obj/pkg.lisp lisp/lib/obj/shape.lisp lisp/lib/obj/temperature.lisp lisp/lib/rdb/err.lisp lisp/lib/rdb/obj.lisp lisp/std/alien.lisp lisp/std/err.lisp lisp/std/fmt.lisp lisp/std/pkg.lisp lisp/std/tests.lisp rust/app/cli/alik/Cargo.toml rust/app/cli/alik/lib.rs
description: deferror
     1.1--- a/lisp/lib/log/stream.lisp	Thu Mar 07 23:06:25 2024 -0500
     1.2+++ b/lisp/lib/log/stream.lisp	Sat Mar 09 23:01:06 2024 -0500
     1.3@@ -1,2 +1,4 @@
     1.4 ;;; log/stream.lisp --- Logging streams
     1.5+
     1.6+;;; Code:
     1.7 (in-package :log)
     2.1--- a/lisp/lib/obj/direction.lisp	Thu Mar 07 23:06:25 2024 -0500
     2.2+++ b/lisp/lib/obj/direction.lisp	Sat Mar 09 23:01:06 2024 -0500
     2.3@@ -0,0 +1,1 @@
     2.4+(in-package :obj/direction)
     3.1--- a/lisp/lib/obj/pkg.lisp	Thu Mar 07 23:06:25 2024 -0500
     3.2+++ b/lisp/lib/obj/pkg.lisp	Sat Mar 09 23:01:06 2024 -0500
     3.3@@ -206,6 +206,24 @@
     3.4    :table-from-csv
     3.5    :table-from-tvs))
     3.6 
     3.7+(defpackage :obj/temperature
     3.8+  (:nicknames :temperature)
     3.9+  (:use :cl :std)
    3.10+  (:export :fahrenheit :celsius :kelvin :rankine))
    3.11+
    3.12+(defpackage :obj/direction
    3.13+  (:nicknames :direction)
    3.14+  (:use :cl :std)
    3.15+  (:export :up :down :left
    3.16+   :right :east :west :north
    3.17+   :north-east :north-west :south-east :south-west
    3.18+   :direction :angle))
    3.19+
    3.20+(defpackage :obj/shape
    3.21+  (:nicknames :shape)
    3.22+  (:use :cl :std)
    3.23+  (:export :circle :square :cube :sphere :triangle :pyramid))
    3.24+
    3.25 (defpackage :obj/db
    3.26   (:nicknames :db)
    3.27   (:use :cl :std :id :seq :sb-mop :sb-pcl)
     4.1--- a/lisp/lib/obj/shape.lisp	Thu Mar 07 23:06:25 2024 -0500
     4.2+++ b/lisp/lib/obj/shape.lisp	Sat Mar 09 23:01:06 2024 -0500
     4.3@@ -0,0 +1,1 @@
     4.4+(in-package :obj/shape)
     5.1--- a/lisp/lib/obj/temperature.lisp	Thu Mar 07 23:06:25 2024 -0500
     5.2+++ b/lisp/lib/obj/temperature.lisp	Sat Mar 09 23:01:06 2024 -0500
     5.3@@ -0,0 +1,1 @@
     5.4+(in-package :obj/temperature)
     6.1--- a/lisp/lib/rdb/err.lisp	Thu Mar 07 23:06:25 2024 -0500
     6.2+++ b/lisp/lib/rdb/err.lisp	Sat Mar 09 23:01:06 2024 -0500
     6.3@@ -1,8 +1,9 @@
     6.4 (in-package :rdb)
     6.5 
     6.6-(define-condition rdb-error (error)
     6.7+(deferror rdb-error ()
     6.8   ((message :initarg :message
     6.9             :reader rdb-error-message))
    6.10+  (:auto t)
    6.11   (:documentation "Error signaled by the RDB system"))
    6.12 
    6.13 (define-condition rocksdb-error (rdb-error)
    6.14@@ -70,5 +71,3 @@
    6.15                                             condition)))))
    6.16             (progn ,@body))
    6.17        (handle-errptr ,e ,errtyp ,params))))
    6.18-        
    6.19-          
     7.1--- a/lisp/lib/rdb/obj.lisp	Thu Mar 07 23:06:25 2024 -0500
     7.2+++ b/lisp/lib/rdb/obj.lisp	Sat Mar 09 23:01:06 2024 -0500
     7.3@@ -59,7 +59,7 @@
     7.4   (make-rdb-opts :create-if-missing t))
     7.5 
     7.6 ;;; bytes
     7.7-(defclass rdb-bytes (sequence)
     7.8+(defclass rdb-bytes ()
     7.9     ((buffer :initarg :buffer :type (array unsigned-byte) :accessor rdb-bytes-buffer))
    7.10   (:documentation "RDB unsigned-byte array. Implements the iterator protocol."))
    7.11 
    7.12@@ -116,13 +116,15 @@
    7.13     :key (make-rdb-key key) 
    7.14     :val (make-rdb-val val)))
    7.15 
    7.16+(defvar *default-rdb-kv* (make-rdb-kv #() #()))
    7.17+
    7.18 ;;; rdb-cf
    7.19-(defstruct rdb-cf
    7.20+(defstruct (rdb-cf (:constructor make-rdb-cf (name &key kv sap)))
    7.21   "RDB Column Family structure. Contains a name, a cons of (rdb-key-type
    7.22 . rdb-val-type), and a system-area-pointer to the underlying
    7.23 rocksdb_cf_t handle."
    7.24   (name "" :type string)
    7.25-  (kv (make-instance 'rdb-kv) :type rdb-kv)
    7.26+  (kv *default-rdb-kv* :type rdb-kv)
    7.27   (sap nil :type (or null alien)))
    7.28 
    7.29 ;; TODO: fix
    7.30@@ -139,9 +141,20 @@
    7.31 
    7.32 (defun create-db (name &key opts cfs)
    7.33   "Construct a new RDB instance from NAME and optional OPTS and DB-PTR."
    7.34-  (make-rdb :name name 
    7.35+  (when (probe-file name) (log:warn! "directory already exists: " name))
    7.36+  (make-rdb :name (typecase name
    7.37+                    (pathname (namestring name))
    7.38+                    (string name)
    7.39+                    (t (error "invalid NAME: ~S" name)))
    7.40             :opts (or opts (default-rdb-opts))
    7.41-            :cfs (or cfs (make-array 0 :element-type 'rdb-cf :adjustable t :fill-pointer 0))
    7.42+            :cfs (or
    7.43+                  (when cfs
    7.44+                    (typecase cfs
    7.45+                      (list (coerce cfs 'vector))
    7.46+                      (vector cfs)
    7.47+                      (rdb-cf (vector cfs))
    7.48+                      (t (log:warn! "invalid CF passed to create-db"))))
    7.49+                  (make-array 0 :element-type 'rdb-cf :adjustable t :fill-pointer 0))
    7.50             :db (open-db-raw name (if opts (rdb-opts-sap opts) (default-rocksdb-options)))))
    7.51 
    7.52 (defmethod push-cf ((cf rdb-cf) (db rdb))
     8.1--- a/lisp/std/alien.lisp	Thu Mar 07 23:06:25 2024 -0500
     8.2+++ b/lisp/std/alien.lisp	Sat Mar 09 23:01:06 2024 -0500
     8.3@@ -115,3 +115,7 @@
     8.4 
     8.5 (defun bool-to-foreign-int (val)
     8.6   (if val 1 0))
     8.7+
     8.8+(defun num-cpus ()
     8.9+  "Return the number of CPU threads online."
    8.10+  (alien-funcall (extern-alien "sysconf" (function int int)) sb-unix:sc-nprocessors-onln))
     9.1--- a/lisp/std/err.lisp	Thu Mar 07 23:06:25 2024 -0500
     9.2+++ b/lisp/std/err.lisp	Sat Mar 09 23:01:06 2024 -0500
     9.3@@ -3,13 +3,40 @@
     9.4 ;;; Code:
     9.5 (in-package :std)
     9.6 
     9.7+(defvar *std-error-message* "An error occured")
     9.8+
     9.9 (define-condition std-error (error)
    9.10   ((message :initarg :message
    9.11+            :initform *std-error-message*
    9.12             :reader std-error-message))
    9.13-  (:documentation "Standard Error"))
    9.14-  
    9.15-;; TODO
    9.16-;; (defmacro deferror (name (&rest parent-types) (&rest slot-specs) &body body))
    9.17+  (:documentation "Std Error")
    9.18+  (:report (lambda (condition stream)
    9.19+             (format stream "~X" (std-error-message condition)))))
    9.20+
    9.21+(defun std-error (&rest args)
    9.22+  (cerror
    9.23+   "Ignore and continue"
    9.24+   'std-error
    9.25+   :message (format nil "~A: ~A" *std-error-message* args)))
    9.26+
    9.27+(defun car-eql (a cons)
    9.28+  (eql a (car cons)))
    9.29+
    9.30+(defmacro deferror (name (&rest parent-types) (&rest slot-specs) &rest options)
    9.31+  "Define an error condition."
    9.32+  (let ((fun (member :auto options :test #'car-eql)))
    9.33+    (when fun (setq options (remove (car fun) options)))
    9.34+    `(progn
    9.35+       (define-condition ,name ,(or parent-types '(std-error)) ,slot-specs ,@options)
    9.36+       (when ',fun (def-error-reporter ,name)))))
    9.37+
    9.38+(defmacro def-error-reporter (err)
    9.39+    `(defun ,err (&rest args)
    9.40+       ,(format nil "Signal an error of type ~A with ARGS." err)
    9.41+       (cerror
    9.42+        "Ignore and continue"
    9.43+        ',err
    9.44+        :message (format nil "~A: ~A" *std-error-message* args))))
    9.45 
    9.46 (defmacro nyi! (&optional comment)
    9.47   `(prog1
    10.1--- a/lisp/std/fmt.lisp	Thu Mar 07 23:06:25 2024 -0500
    10.2+++ b/lisp/std/fmt.lisp	Sat Mar 09 23:01:06 2024 -0500
    10.3@@ -27,8 +27,7 @@
    10.4 (defun fmt-row (data)
    10.5   (format nil "| ~{~A~^ | ~} |~%" data))
    10.6 
    10.7-;;; IDs
    10.8-(defun fmt-sxhash (code)
    10.9+(defun format-sxhash (code)
   10.10   "Turn the fixnum value CODE into a human-friendly string. CODE should
   10.11 be produced by `sxhash'."
   10.12   (let (r)
    11.1--- a/lisp/std/pkg.lisp	Thu Mar 07 23:06:25 2024 -0500
    11.2+++ b/lisp/std/pkg.lisp	Sat Mar 09 23:01:06 2024 -0500
    11.3@@ -9,7 +9,9 @@
    11.4    :with-unique-names :symbolicate :package-symbolicate :keywordicate :gensymify*)
    11.5   (:export
    11.6    ;; err
    11.7-   :std-error :std-error-message :deferror
    11.8+   :std-error :std-error-message
    11.9+   :define-error-reporter
   11.10+   :deferror
   11.11    :nyi!
   11.12    :required-argument
   11.13    :ignore-some-conditions
   11.14@@ -187,6 +189,7 @@
   11.15    :define-alien-loader
   11.16    :c-string-to-string-list
   11.17    :list-all-shared-objects
   11.18+   :num-cpus
   11.19    ;; os
   11.20    :list-all-users
   11.21    :list-all-groups
    12.1--- a/lisp/std/tests.lisp	Thu Mar 07 23:06:25 2024 -0500
    12.2+++ b/lisp/std/tests.lisp	Sat Mar 09 23:01:06 2024 -0500
    12.3@@ -75,7 +75,8 @@
    12.4   (is (equal (ensure-cons 0) (ensure-cons 0))))
    12.5 
    12.6 (deftest err ()
    12.7-  "Test standard error handlers")
    12.8+  "Test standard error handlers"
    12.9+  (deferror testing-err nil nil (:auto t) (:documentation "testing")))
   12.10 
   12.11 (deftest thread ()
   12.12   "Test standard threads"
    13.1--- a/rust/app/cli/alik/Cargo.toml	Thu Mar 07 23:06:25 2024 -0500
    13.2+++ b/rust/app/cli/alik/Cargo.toml	Sat Mar 09 23:01:06 2024 -0500
    13.3@@ -17,7 +17,7 @@
    13.4 db = { path = "../../../lib/db", features = ["rocksdb"] }
    13.5 tenex = { path = "../../../lib/tenex" }
    13.6 tokio = { workspace = true, features = ["full"] }
    13.7-clap = { version = "4.4.10", features = ["derive","env","string"] }
    13.8+clap = { version = "4.5.2", features = ["derive","env","string"] }
    13.9 serde = { workspace = true, features = ["derive"] }
   13.10 [build-dependencies]
   13.11 util = { path = "../../../lib/util", features = ["bs"] }
    14.1--- a/rust/app/cli/alik/lib.rs	Thu Mar 07 23:06:25 2024 -0500
    14.2+++ b/rust/app/cli/alik/lib.rs	Sat Mar 09 23:01:06 2024 -0500
    14.3@@ -26,7 +26,7 @@
    14.4 pub use krypt::KryptConfig;
    14.5 use logger::{
    14.6   log,
    14.7-  tracing::{self, Span},
    14.8+  tracing::Span,
    14.9 };
   14.10 use net::{http::tower::trace::TraceLayer, reqwest::Client};
   14.11 use obj::{Configure, Objective};
   14.12@@ -148,7 +148,7 @@
   14.13     .route("/", get(proxy_via_reqwest))
   14.14     .layer(TraceLayer::new_for_http().on_body_chunk(
   14.15       |chunk: &Bytes, _latency: Duration, _span: &Span| {
   14.16-        tracing::debug!("streaming {} bytes", chunk.len());
   14.17+        log::debug!("streaming {} bytes", chunk.len());
   14.18       },
   14.19     ))
   14.20     .with_state(client);