fork(1) download
copy 
  1. ; your code goes here
  2.  
  3. (defparameter *config* (make-hash-table))
  4.  
  5. (define-condition value-not-found (error) 
  6.   ((text :initarg :text :reader text :initform "")))
  7.  
  8. (defmethod print-object ((obj value-not-found) stream)
  9.   (print-unreadable-object (obj stream :type t)
  10.     (format stream "~s" (slot-value obj 'text))))
  11.  
  12. (defun get-single-value (name)
  13.   (multiple-value-bind (v exist) (gethash name *config*)
  14.     (if exist v (error 'value-not-found :text (format nil "no config value for ~a" name)))))
  15.  
  16. (defun select-any (names)
  17.   (loop for name in names
  18.      do (let ((value (handler-case (get-single-value name)
  19.                        (value-not-found () nil))))
  20.           (when value
  21.             (return-from select-any value))))
  22.   (error 'value-not-found :text (format nil "no config values in ANY ~a" names)))
  23.  
  24. (defun select-all (names)
  25.   (loop for name in names
  26.        collect (handler-case (get-single-value name)
  27.                  (value-not-found ()
  28.                    (error 'value-not-found
  29.                           :text (format nil "no config value for ~a in ALL ~a" name names))))))
  30.  
  31. (defun select-values (spec)
  32.   (if (= (length spec) 1)
  33.       (get-single-value (car spec))
  34.       (case (car spec)
  35.         ((:any) (select-any (cdr spec)))
  36.         ((:all) (cons 'list (select-all (cdr spec))))
  37.         (t (error 'config-spec-unsupported "spec ~a unsupported" spec)))))
  38.  
  39. (defmacro get-value (&rest body)
  40.   (select-values body))
  41.  
  42. (defun set-value (name value)
  43.   (setf (gethash name *config*) value))
  44.  
  45. (set-value 'shard 5)
  46. (set-value 'host "super-host.com")
  47.  
  48. (defun test ()
  49.   (get-value :any shard host)
  50.   (get-value :any host shard)
  51.   (get-value :all host shard)
  52.   (get-value :any shard unknown-value)
  53.   (get-value :all host unknown-value))
  54.  
Runtime error #stdin #stdout #stderr 0.01s 10888KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
*** - #<VALUE-NOT-FOUND
      "no config value for UNKNOWN-VALUE in ALL (HOST UNKNOWN-VALUE)">
https://ideone.com/nvmCcd
language:
Common Lisp (clisp 2.49.92)
created:
8 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!