FOOPReference usecase: multiple loggers

[hartrock]

[*] Introduction to multiple loggers usecase

[*] Modules needed

[*] Session

[*] Explanation and interpretation of some session results

[*] What do you think?

[/list]
If you want to skip the details, you may directly jump to 'Interpretation of some session results'.



publishing for reuse[/i] by others (this is not intended here).



Util.lsp :

Code Select Expand


(context 'Util)

(define (sym? strOrSym ctx)
  (sym strOrSym ctx nil))
(define (lambda-or-macro-symbol? expr)
  (and (symbol? expr)
       (or (lambda? (eval expr))
           (macro? (eval expr)))))

(define (sym-string s , symStr)
  (set 'symStr (string s))
  (if (find ":" symStr)
      (letn ((prefixCtx (prefix s))
             (parsedStr (parse symStr ":"))
             (prefixStr (first parsedStr))
             (termStr (last parsedStr))
             (prefixCtxStr (string prefixCtx)))
        (if (!= prefixStr prefixCtxStr)
            (append symStr " [" prefixStr ":] " prefixCtxStr ":" termStr)
            symStr))
      (string (prefix s) ":" (term s))))

(define (add-prefix-to-sym prefixStr symbol)
  (sym (append prefixStr (term symbol))
       (prefix symbol))) ; get correct ctx prefix
(define (add-postfix-to-sym postfixStr symbol)
  (sym (append (term symbol) postfixStr)
       (prefix symbol))) ; get correct ctx prefix
(define (add-prefix-to-syms prefixStr symList)
  (map (curry add-prefix-to-sym prefixStr) symList))
(define (add-postfix-to-syms postfixStr symList)
  (map (curry add-postfix-to-sym postfixStr) symList))

(define (swap-symbols symList_1 symList_2)
  (map (fn (s_1 s_2) (swap (eval s_1) (eval s_2)))
       symList_1 symList_2))

;; These functions are an intermediate between
;; - (new srcCtx dstCtx) : not overwriting the vals of existing syms in dstCtx;
;; and
;; - (new srcCtx dstCtx true) : overwriting the val of existing syms in dstCtx.
;; They overwrite the vals of existing syms in dstCtx, but only then, if they
;; are:
;; 1. Variant: *not* nil in srcCtx (overwrite in case of non-nil conflicts).
;; 2. Variant: nil in dstCtx (*no* overwrite in case of non-nil conflicts).
;; Motivation:
;; - There may be nil syms in srcCtx just by referencing syms expected to be in
;;   dstCtx, which *should* *not* be overwritten in dstCtx.
;; - There may be nil syms in dstCtx by referencing syms expected to be in
;;   srcCtx, which *should* be overwritten.
;; Notes:
;; - *non*-existent syms in dstCtx will be created even with nil vals from
;;   srcCtx.
;; - in case of a conflict between not-nil values of a sym in both contexts,
;;   srcCtx losses (1.) or wins (2.).
;;
;; 1. this variant does not overwrite non-nils by non-nils.
;; Note: to be preferred against 2. variant below, if overwritng not needed (for
;; the reason see note there).
(define (mixin-no-overwrite-of-non-nil srcCtx dstCtx)
  (dolist
   (s (symbols srcCtx))
   (if (or (not (sym? s dstCtx))
           (nil? (eval (sym s dstCtx))))
       (def-new s (sym s dstCtx))
       "skip (no overwrite of non-nil vals)")))
;; 2. this variant overwrites non-nils by non-nils.
;; Note: this may overwrite *** just created *** non-nils - by recursively
;; created deps during creation of former symbols.
(define (mixin-no-overwrite-with-nil srcCtx dstCtx)
  (dolist
   (s (symbols srcCtx))
   (if (or (not (sym? s dstCtx))
           (eval s)) ; not nil
       (def-new s (sym s dstCtx))
       "skip (no overwrite with nil vals)")))


(context MAIN)

FOOPReference.lsp :

Code Select Expand


(context 'FOOPReference)

;; indices of elems in FOOP list
(constant 's_class 0 's_ref 1)
;; helpers
(define (ref-context-sym ix)
  (sym (string (context) "_" ix) MAIN))
(define (new-ref-context-sym)
  (ref-context-sym (++ foopCount))) ; foopCount for identifying FR instances
(define (new-ref-context)
  (let (ref_contextSym (new-ref-context-sym))
    (prefix (sym ref_contextSym ref_contextSym)))); without switching to new ctx
;; standard functor: each call increases foopCount
(define (FOOPReference:FOOPReference)
  (letn ((ref_context (new-ref-context)) ; increments foopCount
         (foop (cons (context) (cons ref_context (args)))))
    (set (sym (string ref_context) ref_context) foop) ; set ref context default
    ref_context))
;; accessors
(define (class)     ; FOOP Class
  (self s_class))
(define (reference) ; FOOP reference context
  (self s_ref))
;; cleaners
(define (delete-ref ctxSym)
  (delete ctxSym)  ; syms in context including foop default
  (delete ctxSym)) ; context in MAIN
(define (delete-ref-ix ix)
  (delete-ref (ref-context-sym ix)))
(define (delete-all-refs) ; robust against missing refs/foops already deleted
  (while (> foopCount 0)
    (delete-ref-ix foopCount)
    (-- foopCount)))

(context MAIN)

Logger.lsp :

Code Select Expand


(when (not (context? FOOPReference))
  (write-line 2 "[FATAL] Logger needs module FOOPReference.lsp.")
  (exit 1))
(when (not (context? Util))
  (write-line 2 "[FATAL] Logger needs module Util.lsp.")
  (exit 1))

(when (context? Logger)
  (write-line 2 "[Warning] Context Logger already defined."))


(new FOOPReference 'Logger)

(context Logger)

;;
;; script properties
;; - should probably become part of getopts or an own module
;;

;; *** old basename (now scriptname) too limited ***
;;
;;;; works for both newLisp and #!/.../newlisp
;;(define (basename)
;;  (setq execPath (or (main-args 1) (main-args 0)))
;;  (last (parse execPath "/")))

;;
;; A (scriptpath), (scriptname), (scriptargs) solution for skipping newlisp opts
;; and their args: could be a helper for getopts.
;;
;; Should be correct for typical shebang (#!/...) cases, but of interest here
;; are newlisp calls like:
;;   newlisp -s 4096 -m 10 someScript.lsp
;; .
;;
;; But it has limitations: it is only correkt, if *first* non-option arg of
;; newlisp is the script of interest.
;; E.g. calling
;;   newlisp -m 10 nonExistentFile
;; results into
;;   > (Logger:scriptname)
;;   "nonExistentFile"
;; .
;; Therefrom it should be allowed and documented how to override; this can be
;; done by setting scriptpath_ix explicitely, in case of used heuristics fails.
;;
;; See file:///usr/share/doc/newlisp/newlisp_manual.html#options:
;;
;;  -h this help                   -> OK (enters interpreter)
;;  -n no init.lsp (must be first) -> OK
;;  -x <source> <target> link      -> error: should not been reached by script
;;  -v version                     -> OK (enters interpreter)
;;  -s <stacksize>                 -> OK
;;  -m <max-mem-MB> cell memory    -> OK
;;  -e <quoted lisp expression>    -> OK (enters interpreter)
;;  -l <path-file> log connections -> OK
;;  -L <path-file> log all         -> OK
;;  -w <working dir>               -> OK
;;  -c no prompts, HTTP            -> OK
;;  -C force prompts               -> OK
;;  -t <usec-server-timeout>       -> OK
;;  -p <port-no>                   -> OK
;;  -d <port-no> demon mode        -> OK
;;  -http only                     -> OK
;;  -6 IPv6 mode                   -> OK
;;
(set'opt_without_arg
 '("-h" ; enters interpreter
   "-n" ; -> skipped
   "-v" ; enters interpreter
   "-c" ; -> skipped
   "-C" ; -> skipped
   "-http" ; -> skipped
   "-6" ; -> skipped
   )
 'opt_with_arg
 '("-s" ; -> skipped
   "-e" ; enters interpreter
   "-m" ; -> skipped
   "-l" ; -> skipped
   "-L" ; -> skipped
   "-w" ; -> skipped
   "-t" ; -> skipped
   "-p" ; -> skipped
   "-d" ; -> skipped
   )
 'opt_with_2_args
 '("-x" ; should not been reached by script
   ;;"-y" ; for testing errorcase...
   ))
(local (breakFlag skip_next ix execPath)
  (set 'ix 0) ; without any args ix 0 refers to newlisp bin
  (dolist
   (o (1 (main-args)) breakFlag) ; without args, there is no loop here
   (cond
    (skip_next
     (++ ix)
     (set 'skip_next nil)) ; skip once
    ((find o opt_without_arg)
     (++ ix))
    ((find o opt_with_arg)
     (++ ix)
     (set 'skip_next true))
    ((find o opt_with_2_args)
     (throw-error "should not been reached"))
    ("default" ; end loop: first newlisp noopt should be script
     (++ ix) ; needed: loop started with ix of previous element
     (set 'breakFlag true))))
  (set 'scriptpath_ix ix ; 0 or index of first element not being a newlisp option with its args
       'scriptargs_ ((+ 1 scriptpath_ix) (main-args))
       'scriptpath_ (main-args scriptpath_ix)
       'scriptname_ (last (parse scriptpath_ "/"))))
;; iface
(define (scriptpath-ix)
  scriptpath_ix)
(define (scriptargs) ; good as getopts arg
  scriptargs_)
(define (scriptpath)
  scriptpath_)
(define (scriptname) ; Linux (to be extended for other OSes)
  scriptname_)
(define (shebang?) ; works for Linux; to be extended for other OSes
  (and (= (main-args 0) "/usr/local/bin/newlisp")
       (!= (scriptname) "newlisp")))

;;
;; .. script properties
;;


;; helper
;;
(define (write-string str)
  (write-line (fd) str))
(define (prefix-loc-string (locStrOrSym "") (extraPrefix ""))
  (format
   (if (null? locStrOrSym)
       "%s[%s%s]%s "
       "%s[%s %s]%s ")
   (preprefix-string) (scriptname) (string locStrOrSym) extraPrefix))
(define (prefix-string (extraPrefix ""))
  (prefix-loc-string "" extraPrefix))
(define (to-string arguments)
  ;;(println "arguments: " arguments)
  (if (null? arguments)
      "? (no msg)"
      (apply string arguments)))
(define (msg-format arguments)
  (write-string (to-string arguments)))
(constant 'c_fatalStr   "[FATAL]"
          'c_errorStr   "[ERROR]"
          'c_warningStr "[Warning]"
          'c_infoStr    "[Info]")

;; iface
;;
;; (msg arg [arg [...]]) : like args for println
(define (msg)
  (when (<= (level) level_debug)
    (write-string (append (prefix-string)
                          (to-string (args))))))
(define (msg-loc locStrOrSym)
  (when (<= (level) level_debug)
    (write-string (append (prefix-loc-string locStrOrSym)
                          (to-string (args))))))
(define (info)
  (when (<= (level) level_info)
    (write-string (append (prefix-string c_infoStr)
                          (to-string (args))))))
(define (info-loc locStrOrSym)
  (when (<= (level) level_info)
    (write-string (append (prefix-loc-string locStrOrSym c_infoStr)
                          (to-string (args))))))
(define (warn)
  (when (<= (level) level_warn)
    (write-string (append (prefix-string c_warningStr)
                          (to-string (args))))))
(define (h_warn-loc-string locStrOrSym arguments)
  (append (prefix-loc-string locStrOrSym c_warningStr)
          (to-string arguments)))
(define (warn-loc locStrOrSym)
  (when (<= (level) level_warn)
    (write-string (h_warn-loc-string locStrOrSym (args)))))
(define (error)
  (when (<= (level) level_error)
    (write-string (append (prefix-string c_errorStr)
                          (to-string (args))))))
(define (error-loc locStrOrSym)
  (when (<= (level) level_error)
    (write-string (append (prefix-loc-string locStrOrSym c_errorStr)
                          (to-string (args))))))
(define (fatal)
  (when (<= (level) level_fatal)
    (write-string (append (prefix-string c_fatalStr)
                          (to-string (args))))))
(define (fatal-loc locStrOrSym)
  (when (<= (level) level_fatal)
    (write-string (append (prefix-loc-string locStrOrSym c_fatalStr)
                          (to-string (args))))))


;; helper
;;
(constant 'indentIncrement 2)
(define (indent-string)
  (let (str "")
    (dotimes (n (indent)) ; uses foop indent
             (extend str " "))
    str))


;;
;; iface
;;

;; overload global begin: this is *dangerous* for all contexts ..
(define (Logger:begin (what "")) ; .. getting syms from here!
  (when (<= (level) level_debug)
    (write-string (append
                   (prefix-string)
                   (indent-string)
                   "(" (string what) "..."))
    (++ (self s_indent) indentIncrement)))

(define (end (what ""))
  (when (<= (level) level_debug)
    (-- (self s_indent) indentIncrement)
    (write-string (append
                   (prefix-string)
                   (indent-string)
                   "..." (string what) ")"))))

;; macro to show expr unevaluated; returns evaluation
(define-macro (wrap expr (what (string expr)))
  (begin what) ; Logger:begin
  (let (res (eval expr))
    (end what)
    res))

(define (convenience-forward FunSym ctx)
  (let (Ctx (sym (string ctx) MAIN)) ; alt (slower): use (context) ..
    (set (sym FunSym ctx)
         (expand '(lambda ()
                    (:FunSym Ctx ; .. instead of Ctx here. avoid ..
                             (apply string (args)))))))) ; .. forwarding as list
(define (convenience-forward-first-rest FunSym ctx)
  (let (Ctx (sym (string ctx) MAIN))
    (set (sym FunSym ctx)
         (expand '(lambda ()
                    (:FunSym Ctx
                             (args 0) ; unchanged first (loc) and stringified ..
                             (apply string (rest (args))))))))) ; .. rest args

(when (not standard_constructor) ; be robust against module reload
  (set 'standard_constructor Logger)) ; store ctor from FOOPReference for reuse

;; FOOP Logger ctor with check for int fd
(define (Logger (fd 2) ; stderr
                (preprefix-string (fn () "")) ; optional
                (log-level level_default)) ; optional
  (if (not (integer? fd))
      (MAIN:begin ; avoid Logger:begin
       ;; difficult to use a logger here...
       (write-line 2 "[FATAL] fd arg has to be an int.")
       (exit 1)))
  (let (ref_ctx (standard_constructor fd
                                      preprefix-string
                                      log-level
                                      0)) ; indent starting with 0

    ;; convenience func forwards from ref context to foop
    [text] ;(convenience-forward 'info ref_ctx) results into (for first logger):
    (lambda () (: Logger:info Logger_1 (apply string (args))))
    [/text]
    (convenience-forward            'msg       ref_ctx)
    (convenience-forward-first-rest 'msg-loc   ref_ctx)
    (convenience-forward            'info      ref_ctx)
    (convenience-forward-first-rest 'info-loc  ref_ctx)
    (convenience-forward            'warn      ref_ctx)
    (convenience-forward-first-rest 'warn-loc  ref_ctx)
    (convenience-forward            'error     ref_ctx)
    (convenience-forward-first-rest 'error-loc ref_ctx)
    (convenience-forward            'fatal     ref_ctx)
    (convenience-forward-first-rest 'fatal-loc ref_ctx)
    ;; log level forwards
    (set (sym 'level-debug ref_ctx) (lambda () (:level-debug (context))))
    (set (sym 'level-all   ref_ctx) (lambda () (:level-all (context))))
    (set (sym 'level-info  ref_ctx) (lambda () (:level-info (context))))
    (set (sym 'level-warn  ref_ctx) (lambda () (:level-warn (context))))
    (set (sym 'level-error ref_ctx) (lambda () (:level-error (context))))
    (set (sym 'level-fatal ref_ctx) (lambda () (:level-fatal (context))))
    (set (sym 'level       ref_ctx) (lambda () (:level (context))))
    (set (sym 'begin       ref_ctx) (lambda ((what ""))
                                      (:begin (context) what)))
    (set (sym 'end         ref_ctx) (lambda ((what ""))
                                      (:end (context) what)))

    ;; mixins
    (setq ref_ctx:mixin-expr
          (lambda ()
            (Util:mixin-no-overwrite-of-non-nil MAIN:LoggerExpr (context))))
    (setq ref_ctx:mixin-expr-debug
          (lambda ()
            ((eval (sym "mixin-expr" (context)))) ; not elegant, but it works
            (Util:mixin-no-overwrite-of-non-nil MAIN:LoggerDebug (context))))

    ;; default logger for being used by other modules
    (if (not Logger:default) ; overload MAIN:default
        (set 'Logger:default ref_ctx))
    ref_ctx))

;; foop accessor indices (starting with 2)
(constant 's_fd 2 's_preprefixStr_func 3 's_logLevel 4 's_indent 5)

;; loglevels
(constant 'level_all   0
          'level_debug 0
          'level_info  1
          'level_warn  2
          'level_error 3
          'level_fatal 4
          'level_default level_info)

;; accessors
(define (fd)                           (self s_fd))
(define (set-fd fd)              (setq (self s_fd) fd))
(define (preprefix-func)               (self s_preprefixStr_func))
(define (set-preprefix-func fun) (setq (self s_preprefixStr_func) fun))
(define (log-level)                    (self s_logLevel))
(define (set-log-level l)        (setq (self s_logLevel) l))
(define (indent)                       (self s_indent))
(define (set-indent indent)      (setq (self s_indent) indent))

;; indirect getters
(define (preprefix-string)
  ((self s_preprefixStr_func))) ; call func
;; indirect setters
(define (use-timestamp-prefix)
  (set-preprefix-func (fn () (date (date-value) 0 "[%Y-%m-%d %X]"))))
(define (use-debug-prefix)
  (set-preprefix-func (fn () "[dbg]")))
(define (use-no-prefix)
  (setq (set-preprefix_func (fn () ""))))
(define (use-prefix-fun prefixFun)
  (set-preprefix-func prefixFun))

;; loglevel getters
(define (level)
  (self s_logLevel))
(define (get-level-default) ; needed?
  level_default)

;; loglevel setters
(define (level-default)
  (setq (self s_logLevel) level_default))
(define (level-all)
  (setq (self s_logLevel) level_all))
;;
(define (level-debug)
  (setq (self s_logLevel) level_debug))
(define (level-info)
  (setq (self s_logLevel) level_info))
(define (level-warn)
  (setq (self s_logLevel) level_warn))
(define (level-error)
  (setq (self s_logLevel) level_error))
(define (level-fatal)
  (setq (self s_logLevel) level_fatal))


(context MAIN) ; ...Logger



;; Logger extended for expression info: shows expressions both unevaluated and
;; evaluated. Evaluation happens before forwarding to foop, which is not suited,
;; because it changes (self).
(context 'LoggerExpr)

(define (default? symbol)
  (and (context? symbol)
       (default symbol)))
;;
(define (rep a)
  (if
   (float? a) (format "%f" a)
   (string? a) (append """ a """)
   (array? a) (append "[]" (string a))
   (quote? a) (append "'" (rep (eval a)))
   (context? a) (append
                 "[ctx] " (string a)
                 (let (default_flag (Util:sym? (string a) a)) ; no new sym by check
                   (if default_flag
                       (append ", " (string a) ":" (string a)
                               " -> " (string (default a)))
                       "")))
   (symbol? a) (Util:sym-string a)
   (string a)))
(define (name-rep a sepFlag restFlag)
  (local (sym_identical_flag)
  (append
   (if restFlag (if sepFlag "n, " "; ") "")
   (if (number? a) (string a) ; source rep: 1 for 1.0 !
       (symbol? a) (begin
                     (set 'sym_identical_flag (= a (eval a)))
                     (rep a))
       (rep a))
   (if sym_identical_flag " == " " -> ")
   (if sepFlag ">>n" "")
   (rep (setq lastExprEval (eval a)))
   (if sepFlag "n<<" ""))))
(define (expr-info-string arguments sepFlag)
  (local (nameReps)
    (if (null? arguments)
        (format "%s %s:expr: no argument" Logger:c_warningStr (string (context)))
        (begin
         (push (name-rep (first arguments) sepFlag) nameReps)
         (dolist (a (rest arguments))
                 (push (name-rep a sepFlag true) nameReps -1))
         (join nameReps)))))
(define (tloc2string loc) ; used by lib/assert.lsp
  (format "%s %d"
          (string (last loc))
          (first loc)))
(define (expr-info-string-tloc tloc arguments sepFlag)
  (append
   (string "[" (tloc2string tloc) "] ")
   (expr-info-string arguments sepFlag)))


;;
;; iface (to be moved to corresponding context (instead of using by FOOP)
;; to be fully functional)
;;

;; without output, just expr info string
(define-macro (expr-str)
  (expr-info-string (args)))
;; new:
(define-macro (expr-str-sep)
  (expr-info-string (args) true))

;;
;; with output into log channel
(define-macro (expr)
  ; after mixin into created Logger reference is (context) ..
  (:msg (context) ; .. a FOOPReference with foop default getting :msg call
        (expr-info-string (args)))
  lastExprEval)
;; robustness against missing locStrOrSym
(define-macro (expr-loc (locStrOrSym ""))
  (:msg-loc (context)
            (string (eval locStrOrSym))
            (expr-info-string (args)))
  lastExprEval) ;)
;;
(define-macro (expr-sep)
  (:msg (context)
        (expr-info-string (args) true))
  lastExprEval)
(define-macro (expr-loc-sep (locStrOrSym ""))
  (:msg-loc (context)
            (string (eval locStrOrSym))
            (expr-info-string (args) true))
  lastExprEval)

;; convenience forward to macro in foop; returns wrapped expr
(define-macro (wrap)
  (eval (append '(:wrap (context)) (args))))


(context MAIN) ; ...LoggerExpr


(context 'LoggerDebug) ; specific dbg: functions

;; on/off switching of debug messages ...
(set 'symbols-to-be-switched
     '(msg msg-loc LoggerDebug:begin end wrap ; not defined as tweakable below
       ;; expr-str[-sep][_tweaked] not to be switched
       expr expr-loc
       expr-sep expr-loc-sep
       info info-loc) ; not defined as tweakable below
     'symbols-to-be-switched-store (Util:add-prefix-to-syms
                                    "_"
                                    symbols-to-be-switched))
;; use empty non-evaluating macros for switched off versions
(dolist (s symbols-to-be-switched-store)
        (set s (lambda-macro ())))
(setq LoggerDebug:debug true) ; default (overload MAIN:debug)
(define (switch)
  (setq LoggerDebug:debug (not LoggerDebug:debug)) ; does not change nodebug flag!
  ;; to be swapped with their prefixed stored counterparts
  (Util:swap-symbols symbols-to-be-switched
                     symbols-to-be-switched-store))
(define (on)
  (if (not debug) ; LoggerDebug:debug
      (MAIN:begin ; overloaded above
       (switch)
       "Now on.")
      "Already on."))
(define (off)
  (if debug ; LoggerDebug:debug
      (MAIN:begin ; overloaded above
        (switch)
        "Off.")
      "Already off."))


(context MAIN) ; ...LoggerDebug



;; loading modules:
(map load '("Util.lsp" "FOOPReference.lsp" "Logger.lsp"))
;;
(set 'l (Logger))
(global 'l) ; for being visible in contexts loaded later
;;
(l:info "an info") (l:warn "a warning") (l:error "an error") (l:fatal "a fatal condition")
;; but:
(l:msg "a message needing level-debug")
(l:level-debug)  ; (default is level-info)
(l:msg "a message needing level-debug")
;;
;;
;; There are more features by mixing-in some additional functionality:
;;
(set 'le (Logger 2 (fn () "[le]") Logger:level_all)) ; stderr, preprefix fun
(global 'le) ; for being visible in contexts loaded later
(le:info "an info")
;; now let's mixin
(le:mixin-expr)
;; now this works:
(le:expr (+ 1 2))
;; or showing itself
(le:expr le)
;; -> shows it being a context having a default Logger FOOP
;;    (this is due to being a FOOPReference)
;;
;;
;; show properties of loggers l and le
;;
(le:expr l) (le:expr le)
;;
;;
;;
;; syms of minimal logger's FOOPReference
;;
(symbols l)
;;
;;
;; syms of extended logger's FOOPReference
;;
(symbols le)
;;
;;
;; *shared* FOOP part (used by *both* loggers)
;;
(symbols Logger)
;;
;;
;; mixin part (visible in syms of le)
;;
(symbols LoggerExpr)
[/code]
Session as a whole (by copy/paste session commands):

Code Select Expand


newLISP v.10.6.4 64-bit on Linux IPv4/6 UTF-8 libffi, options: newlisp -h

> ;; loading modules:
> (map load '("Util.lsp" "FOOPReference.lsp" "Logger.lsp"))
(MAIN MAIN MAIN)
> ;;
> (set 'l (Logger))
Logger_1
> (global 'l) ; for being visible in contexts loaded later
l
> ;;
> (l:info "an info") (l:warn "a warning") (l:error "an error") (l:fatal "a fatal condition")
[newlisp][Info] an info
24
[newlisp][Warning] a warning
29
[newlisp][ERROR] an error
26
[newlisp][FATAL] a fatal condition
35
> ;; but:
> (l:msg "a message needing level-debug")
nil
> (l:level-debug)  ; (default is level-info)
0
> (l:msg "a message needing level-debug")
[newlisp] a message needing level-debug
40
> ;;
> ;;
> ;; There are more features by mixing-in some additional functionality:
> ;;
> (set 'le (Logger 2 (fn () "[le]") Logger:level_all)) ; stderr, preprefix fun
Logger_2
> (global 'le) ; for being visible in contexts loaded later
le
> (le:info "an info")
[le][newlisp][Info] an info
28
> ;; now let's mixin
> (le:mixin-expr)
Logger_2:wrap
> ;; now this works:
> (le:expr (+ 1 2))
[le][newlisp] (+ 1 2) -> 3
3
> ;; or showing itself
> (le:expr le)
[le][newlisp] MAIN:le -> [ctx] Logger_2, Logger_2:Logger_2 -> (Logger Logger_2 2 (lambda () "[le]") 0 0)
Logger_2
> ;; -> shows it being a context having a default Logger FOOP
> ;;    (this is due to being a FOOPReference)
> ;;
> ;;
> ;; show properties of loggers l and le
> ;;
> (le:expr l) (le:expr le)
[le][newlisp] MAIN:l -> [ctx] Logger_1, Logger_1:Logger_1 -> (Logger Logger_1 2 (lambda () "") 0 0)
Logger_1
[le][newlisp] MAIN:le -> [ctx] Logger_2, Logger_2:Logger_2 -> (Logger Logger_2 2 (lambda () "[le]") 0 0)
Logger_2
> ;;
> ;;
> ;;
> ;; syms of minimal logger's FOOPReference
> ;;
> (symbols l)
(Logger_1:Logger_1 Logger_1:begin Logger_1:end Logger_1:error Logger_1:error-loc
 Logger_1:fatal Logger_1:fatal-loc Logger_1:info Logger_1:info-loc Logger_1:level
 Logger_1:level-all Logger_1:level-debug Logger_1:level-error Logger_1:level-fatal
 Logger_1:level-info Logger_1:level-warn Logger_1:mixin-expr Logger_1:mixin-expr-debug
 Logger_1:msg Logger_1:msg-loc Logger_1:warn Logger_1:warn-loc)
> ;;
> ;;
> ;; syms of extended logger's FOOPReference
> ;;
> (symbols le)
(Logger_2:Logger_2 Logger_2:a Logger_2:arguments Logger_2:begin Logger_2:default?
 Logger_2:default_flag Logger_2:end Logger_2:error Logger_2:error-loc Logger_2:expr
 Logger_2:expr-info-string Logger_2:expr-info-string-tloc Logger_2:expr-loc Logger_2:expr-loc-sep
 Logger_2:expr-sep Logger_2:expr-str Logger_2:expr-str-sep Logger_2:fatal Logger_2:fatal-loc
 Logger_2:info Logger_2:info-loc Logger_2:lastExprEval Logger_2:level Logger_2:level-all
 Logger_2:level-debug Logger_2:level-error Logger_2:level-fatal Logger_2:level-info
 Logger_2:level-warn Logger_2:loc Logger_2:locStrOrSym Logger_2:mixin-expr Logger_2:mixin-expr-debug
 Logger_2:msg Logger_2:msg-loc Logger_2:name-rep Logger_2:nameReps Logger_2:rep Logger_2:restFlag
 Logger_2:sepFlag Logger_2:sym_identical_flag Logger_2:symbol Logger_2:tloc Logger_2:tloc2string
 Logger_2:warn Logger_2:warn-loc Logger_2:wrap)
> ;;
> ;;
> ;; *shared* FOOP part (used by *both* loggers)
> ;;
> (symbols Logger)
(Logger:Ctx Logger:FunSym Logger:Logger Logger:arguments Logger:begin Logger:breakFlag
 Logger:c_errorStr Logger:c_fatalStr Logger:c_infoStr Logger:c_warningStr Logger:class
 Logger:convenience-forward Logger:convenience-forward-first-rest Logger:ctx Logger:ctxSym
 Logger:default Logger:delete-all-refs Logger:delete-ref Logger:delete-ref-ix Logger:end
 Logger:error Logger:error-loc Logger:execPath Logger:expr Logger:extraPrefix Logger:fatal
 Logger:fatal-loc Logger:fd Logger:foop Logger:foopCount Logger:fun Logger:get-level-default
 Logger:h_warn-loc-string Logger:indent Logger:indent-string Logger:indentIncrement
 Logger:info Logger:info-loc Logger:ix Logger:l Logger:level Logger:level-all Logger:level-debug
 Logger:level-default Logger:level-error Logger:level-fatal Logger:level-info Logger:level-warn
 Logger:level_all Logger:level_debug Logger:level_default Logger:level_error Logger:level_fatal
 Logger:level_info Logger:level_warn Logger:locStrOrSym Logger:log-level Logger:msg
 Logger:msg-format Logger:msg-loc Logger:n Logger:new-ref-context Logger:new-ref-context-sym
 Logger:o Logger:opt_with_2_args Logger:opt_with_arg Logger:opt_without_arg Logger:prefix-loc-string
 Logger:prefix-string Logger:prefixFun Logger:preprefix-func Logger:preprefix-string
 Logger:ref-context-sym Logger:ref_context Logger:ref_contextSym Logger:ref_ctx Logger:reference
 Logger:res Logger:s_class Logger:s_fd Logger:s_indent Logger:s_logLevel Logger:s_preprefixStr_func
 Logger:s_ref Logger:scriptargs Logger:scriptargs_ Logger:scriptname Logger:scriptname_
 Logger:scriptpath Logger:scriptpath-ix Logger:scriptpath_ Logger:scriptpath_ix Logger:set-fd
 Logger:set-indent Logger:set-log-level Logger:set-preprefix-func Logger:set-preprefix_func
 Logger:shebang? Logger:skip_next Logger:standard_constructor Logger:str Logger:to-string
 Logger:use-debug-prefix Logger:use-no-prefix Logger:use-prefix-fun Logger:use-timestamp-prefix
 Logger:warn Logger:warn-loc Logger:what Logger:wrap Logger:write-string)
> ;;
> ;;
> ;; mixin part (visible in syms of le)
> ;;
> (symbols LoggerExpr)
(LoggerExpr:a LoggerExpr:arguments LoggerExpr:default? LoggerExpr:default_flag LoggerExpr:expr
 LoggerExpr:expr-info-string LoggerExpr:expr-info-string-tloc LoggerExpr:expr-loc
 LoggerExpr:expr-loc-sep LoggerExpr:expr-sep LoggerExpr:expr-str LoggerExpr:expr-str-sep
 LoggerExpr:lastExprEval LoggerExpr:loc LoggerExpr:locStrOrSym LoggerExpr:msg LoggerExpr:msg-loc
 LoggerExpr:name-rep LoggerExpr:nameReps LoggerExpr:rep LoggerExpr:restFlag LoggerExpr:sepFlag
 LoggerExpr:sym_identical_flag LoggerExpr:symbol LoggerExpr:tloc LoggerExpr:tloc2string
 LoggerExpr:wrap)
>



> ;; syms of minimal logger's FOOPReference
> ;;
> (symbols l)
(Logger_1:Logger_1 Logger_1:begin Logger_1:end Logger_1:error Logger_1:error-loc
 Logger_1:fatal Logger_1:fatal-loc Logger_1:info Logger_1:info-loc Logger_1:level
 Logger_1:level-all Logger_1:level-debug Logger_1:level-error Logger_1:level-fatal
 Logger_1:level-info Logger_1:level-warn Logger_1:mixin-expr Logger_1:mixin-expr-debug
 Logger_1:msg Logger_1:msg-loc Logger_1:warn Logger_1:warn-loc)
> ;;
> ;;
> ;; syms of extended logger's FOOPReference
> ;;
> (symbols le)
(Logger_2:Logger_2 Logger_2:a Logger_2:arguments Logger_2:begin Logger_2:default?
 Logger_2:default_flag Logger_2:end Logger_2:error Logger_2:error-loc Logger_2:expr
 Logger_2:expr-info-string Logger_2:expr-info-string-tloc Logger_2:expr-loc Logger_2:expr-loc-sep
 Logger_2:expr-sep Logger_2:expr-str Logger_2:expr-str-sep Logger_2:fatal Logger_2:fatal-loc
 Logger_2:info Logger_2:info-loc Logger_2:lastExprEval Logger_2:level Logger_2:level-all
 Logger_2:level-debug Logger_2:level-error Logger_2:level-fatal Logger_2:level-info
 Logger_2:level-warn Logger_2:loc Logger_2:locStrOrSym Logger_2:mixin-expr Logger_2:mixin-expr-debug
 Logger_2:msg Logger_2:msg-loc Logger_2:name-rep Logger_2:nameReps Logger_2:rep Logger_2:restFlag
 Logger_2:sepFlag Logger_2:sym_identical_flag Logger_2:symbol Logger_2:tloc Logger_2:tloc2string
 Logger_2:warn Logger_2:warn-loc Logger_2:wrap)
> ;;
[/code]
Note: many of these functions are convenience forwards from FOOPReference to FOOP; e.g. from (l:warn "a warning") to (:warn l "a warning").



Symbols of shared FOOP part (code used by both loggers):

Code Select Expand


> ;;
> ;; *shared* FOOP part (used by *both* loggers)
> ;;
> (symbols Logger)
(Logger:Ctx Logger:FunSym Logger:Logger Logger:arguments Logger:begin Logger:breakFlag
 Logger:c_errorStr Logger:c_fatalStr Logger:c_infoStr Logger:c_warningStr Logger:class
 Logger:convenience-forward Logger:convenience-forward-first-rest Logger:ctx Logger:ctxSym
 Logger:default Logger:delete-all-refs Logger:delete-ref Logger:delete-ref-ix Logger:end
 Logger:error Logger:error-loc Logger:execPath Logger:expr Logger:extraPrefix Logger:fatal
 Logger:fatal-loc Logger:fd Logger:foop Logger:foopCount Logger:fun Logger:get-level-default
 Logger:h_warn-loc-string Logger:indent Logger:indent-string Logger:indentIncrement
 Logger:info Logger:info-loc Logger:ix Logger:l Logger:level Logger:level-all Logger:level-debug
 Logger:level-default Logger:level-error Logger:level-fatal Logger:level-info Logger:level-warn
 Logger:level_all Logger:level_debug Logger:level_default Logger:level_error Logger:level_fatal
 Logger:level_info Logger:level_warn Logger:locStrOrSym Logger:log-level Logger:msg
 Logger:msg-format Logger:msg-loc Logger:n Logger:new-ref-context Logger:new-ref-context-sym
 Logger:o Logger:opt_with_2_args Logger:opt_with_arg Logger:opt_without_arg Logger:prefix-loc-string
 Logger:prefix-string Logger:prefixFun Logger:preprefix-func Logger:preprefix-string
 Logger:ref-context-sym Logger:ref_context Logger:ref_contextSym Logger:ref_ctx Logger:reference
 Logger:res Logger:s_class Logger:s_fd Logger:s_indent Logger:s_logLevel Logger:s_preprefixStr_func
 Logger:s_ref Logger:scriptargs Logger:scriptargs_ Logger:scriptname Logger:scriptname_
 Logger:scriptpath Logger:scriptpath-ix Logger:scriptpath_ Logger:scriptpath_ix Logger:set-fd
 Logger:set-indent Logger:set-log-level Logger:set-preprefix-func Logger:set-preprefix_func
 Logger:shebang? Logger:skip_next Logger:standard_constructor Logger:str Logger:to-string
 Logger:use-debug-prefix Logger:use-no-prefix Logger:use-prefix-fun Logger:use-timestamp-prefix
 Logger:warn Logger:warn-loc Logger:what Logger:wrap Logger:write-string)
> ;;


Here the difference in amount of minimal logger's FOOPReference symbols and its shared (with other loggers like le in the example) FOOP symbols is obvious.



If there are multiple loggers - e.g. by logging to different file descriptors or with different functionality -, sharing the FOOP code becomes effective.



This shared FOOP code will be applied to the FOOPs of loggers l and le:

Code Select Expand


> ;;
> ;; show properties of loggers l and le
> ;;
> (le:expr l) (le:expr le)
[le][newlisp] MAIN:l -> [ctx] Logger_1, Logger_1:Logger_1 -> (Logger Logger_1 2 (lambda () "") 0 0)
Logger_1
[le][newlisp] MAIN:le -> [ctx] Logger_2, Logger_2:Logger_2 -> (Logger Logger_2 2 (lambda () "[le]") 0 0)
Logger_2
> ;;
; whose FOOPs are shown after last '->' in output line as '(Logger Logger_...'.



[size=150]What do you think?[/size]