newLISP Fan Club
Forum => Anything else we might add? => Topic started by: hartrock on August 27, 2015, 08:55:22 AM
If you want to skip the details, you may directly jump to 'Interpretation of some session results'.
Util.lsp :
(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 :
(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 :
(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):
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
Symbols of
> ;;
> ;; *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
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
> ;;
> ;; 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
> ;;
[size=150]What do you think?[/size]