loading and upgrading asdf on the way by levgue@gmx.net

New About Yours API Help
5.9 KB, Common Lisp
#.(declaim (optimize (safety 3) (debug 3) (space 0) (speed 0) (compilation-speed 0) (inhibit-warnings 0)))

(require :asdf)
#-asdf2 (error "You lose")
(asdf:load-system :asdf)

(defmethod asdf:perform :around ((o asdf:load-op)
                                 (c asdf:cl-source-file))
   (handler-case (call-next-method o c)
      ;; If a fasl was stale, try to recompile and load (once).
      (sb-ext:invalid-fasl ()
         (asdf:perform (make-instance 'asdf:compile-op) c)
         (call-next-method))))

(load "/home/oleo/quicklisp/setup.lisp")

(asdf:initialize-source-registry 
 '(:source-registry
   (:tree "/home/oleo/common-lisp/source/asdf/")
   (:tree "/home/oleo/quicklisp/dists/quicklisp/software/clx-20190813-git/")
   (:exclude "/home/oleo/common-lisp/source/")
   :ignore-inherited-configuration))

(asdf:initialize-source-registry 
 '(:source-registry
   (:tree "/home/oleo/common-lisp/source/asdf/")
   (:tree "/home/oleo/quicklisp/dists/quicklisp/software/clx-20190813-git")
    (:exclude "/home/oleo/common-lisp/source/")
   :inherit-configuration))

(push '(:exclude "/usr/share/common-lisp/") asdf::*default-source-registry-exclusions*)

(asdf:initialize-output-translations
 `(:output-translations
   #.(let ((wild-subdir
	    (make-pathname :directory '(:relative :wild-inferiors)))
	   (wild-file
	    (make-pathname :name :wild :version :wild :type :wild)))
       `((:root ,wild-subdir ,wild-file)
	 (:user-cache ,wild-subdir ,wild-file)))
   :ignore-inherited-configuration))

(asdf:initialize-output-translations
 `(:output-translations
   #.(let ((wild-subdir
	    (make-pathname :directory '(:relative :wild-inferiors)))
	   (wild-file
	    (make-pathname :name :wild :version :wild :type :wild)))
       `((:root ,wild-subdir ,wild-file)
	 (:user-cache ,wild-subdir ,wild-file)))
   :inherit-configuration))

(in-package :cl-user)

(ql:quickload :clx)

(in-package xlib)

(defun display-keyboard-mapping (display)
  (declare (type display display))
  (declare (clx-values (simple-array keysym (display-max-keycode keysyms-per-keycode))))
  (setf (display-keysym-mapping display) (keyboard-mapping display)))

(in-package :cl-user)

;;newlim-init.lisp
(setq
 *print-pretty* t
 *print-escape* nil
 *print-circle* nil
 *print-right-margin* 110
 *read-default-float-format* 'double-float
 *readtable* (copy-readtable nil))
;;*break-on-signals* nil)

(if (not (member :rune-is-character *features*))
    (push :rune-is-character *features*))

(defun compiler-policy () (funcall (lambda () (sb-ext:describe-compiler-policy))))

(defvar *last-package* nil)
(defvar *cached-prompt* nil)
(defvar *prompt* nil)

(defun package-prompt (stream)
  (unless (eq *last-package* *package*)
    (setf *cached-prompt*
	  (concatenate 'string (or (first (package-nicknames *package*))
				   (package-name *package*))
		       "> "))
    (setf *last-package* *package*))
  (terpri)
  (princ *cached-prompt* stream))

(setf sb-int:*repl-prompt-fun* #'package-prompt)

(defun date ()
(progn (terpri t) (run-program "/usr/bin/date" '() :output t) (values)))

(defun datetime (&key (as-list nil) (time nil) (date nil))
  (multiple-value-bind (second minute hour day month year day-of-week dst-p tz)
      (get-decoded-time)
    (let* ((day-names
            '("Monday" "Tuesday" "Wednesday"
              "Thursday" "Friday" "Saturday"
              "Sunday"))
           (now (format nil "~2,'0d:~2,'0d:~2,'0d" hour minute second))
           (today (format nil "~a, ~2,'0d.~2,'0d.~d, GMT~@d" (nth day-of-week day-names) day month year (- tz)))
           (result
            (format nil "time: ~2,'0d:~2,'0d:~2,'0d~%date: ~a, ~2,'0d.~2,'0d.~d, GMT~@d" hour minute second
                    (nth day-of-week day-names) day month year (- tz))))
      (cond (as-list
             (multiple-value-list
              (with-input-from-string (s result) (values (intern (read-line s)) (intern (read-line s))))))
            (time now)
            (date today)
            (t
             (with-input-from-string (s result) (values (intern (read-line s)) (intern (read-line s)))))))))

(defun next-epsi (epsi) (/ epsi 2))

(defun epsi-sig-single-p (epsi) (> (+ 1.0f0 epsi) 1.0f0))
(defun epsi-sig-double-p (epsi) (> (+ 1.0d0 epsi) 1.0d0))

(defun is-epsi-single-p (epsi) 
  (and (epsi-sig-single-p epsi) 
    (not (epsi-sig-single-p (next-epsi epsi)))))

(defun is-epsi-double-p (epsi) 
  (and (epsi-sig-double-p epsi) 
    (not (epsi-sig-double-p (next-epsi epsi)))))

(defun find-epsi-single (&OPTIONAL (epsi 1.0f0)) 
  (if (is-epsi-single-p epsi)  ; if the next epsi candidate isn't significant
    epsi  ; we have found epsilon
    (find-epsi-single (next-epsi epsi)))) ; otherwise, go smaller

(defun find-epsi-double (&OPTIONAL (epsi 1.0d0)) 
  (if (is-epsi-double-p epsi)  ; if the next epsi candidate isn't significant
    epsi  ; we have found epsilon
    (find-epsi-double (next-epsi epsi)))) ; otherwise, go smaller

(let ()
(format t "~% machine-epsilon-single: ~a ~% machine-epsilon-double: ~a ~% epsi-sig-single-p? ~a ~% epsi-sig-double-p? ~a ~%"(find-epsi-single) (find-epsi-double) (epsi-sig-single-p (find-epsi-single)) (epsi-sig-double-p (find-epsi-double))) (values))

(let ()
(terpri t)
(let () (format t "Happy lisping!~%") (values))
;;(write-char #\Newline t) ;;is identical to (terpri t)
(terpri t)
(let () (format t "Machine: ~a~&" (machine-version)) (values))
(let () (format t "OS: ~a ~a~&" (software-type) (software-version)) (values))
(let () (format t "Host: ~a~&" (machine-instance)) (values))
(let () (format t "Implementation: ~a~&" (lisp-implementation-type)) (values))
(let () (format t "Type: ~a~&" (machine-type)) (values))
(let () (format t "Version: ~a~&" (lisp-implementation-version)) (values))
(terpri t)
(let () (format t "Time: ~a Date: ~a" (datetime :time t) (datetime :date t)) (values))
(terpri)
(values))
Pasted 2 months, 2 weeks ago — Expires in 285 days
URL: http://dpaste.com/3V9BKEZ