guile-hurd/common/utils.lisp

(in-package :hurd-common)

(defun largest-representable-number (bits)
  "Largest representable number having 'bits' bits available"
  (1- (expt 2 bits)))

(defun num-bits (bytes)
  "Tells how many bits there are in a number of bytes"
  (* 8 bytes))

(defmacro unless-return (call &body body)
  "Evaluates 'call' and returns its value if true, else evaluates and returns 'body'."
  ;; XXX this does not actually correspond to the description,
  ;; as this does ot discard the second, third, ... value.
  #`(or #,call #,body))

(defun translate-foreign-list (value ls &optional (order :from))
  "In a list with key/values finds a value using first/second as key, returning second/first from the item found."
  (let ((item (find value ls :key (if (eq order :from)
                                    #'first
                                    #'second))))
    (when item
      (if (eq order :from)
        (second item)
        (first item)))))

(defmacro select-error (error-code &optional (result #'#t))
  "If error-code is success returns result, else returns multiple values 'nil' and 'error-code'."
  #`(cond
     ((eq #,error-code #t)
      #,result)
     (#t
      (values nil #,error-code))))

(defmacro with-cleanup (cleanup &body body)
  "Unwind-protect with multiple expressions."
  #`(unwind-protect (progn #,@body)
      #,cleanup))

(defmacro chained-bit-op (op &body ls)
"Makes possible to have multiple arguments, instead of only two, in a boole operation."
  (syntax-case ls ()
	       (() #'0)
	       ((first . tail)
		#`(boole #,op
			 first
			 (chained-bit-op #,op . tail)))))

;; XXX verify these two defuns.
;; I don't understand the loop code.
(defun %find-different (str len chr pos)
  "Finds the position of a char different than chr from 'pos' in 'str'"
  (or (string-skip str chr pos len) len))

(defun split-path (str)
  "Splits a path into a list with each component. Examples:
a/b/c -> ('a' 'b' 'c')
/a/b -> ('a' 'b')     ;;; <-- XXX what?
a///b -> ('a' 'b')    ;;  <--- ditto? symlinks?
a/b/c/ -> ('a', 'b', 'c', '') pay attention to the last component!"
  ;; XXX what if str = "/"?
  (let* ((l (string-split #\/ str))
	 (last-empty? (if (null? l)
			  #f
			(string=? "" (last l))))
	 (lf (filter! (negate string-null?) l)))
    (if last-empty?
	lf
      (append! lf (list "")))))

(defun join-path (ls)
  "Joins a path previously split by split-path."
  (string-left-trim "/" (reduce (lambda (all x)
                                  (concatenate 'string all "/" x))
                                ls
                                :initial-value "")))

(defun %convert-list (item)
  (if (symbolp item)
    (list item)
    item))

(defun flag-is? (flags flag)
  "Checks if flags has the flag or flag's list 'flag' enabled."
  (let ((new-list (%convert-list flag)))
    (equal new-list
           (intersection flags new-list))))

(defun enable-flags (flags new-flags)
  "Enable all flags in new-flags."
  (union flags (%convert-list new-flags)))

(defun disable-flags (flags old-flags)
  "Disable all flags in old-flags."
  (set-difference flags (%convert-list old-flags)))

(defun only-flags (flags new-flags)
  "Only enable flags in new-flags."
  (intersection flags (%convert-list new-flags)))

(defun free-memory-list (ls)
  "Frees a list with pointers."
  (loop for item in ls
        do (when (and (pointerp item)
                      (not (null-pointer-p item)))
             (foreign-free item))))

(defun foreign-string-zero-separated-to-list (ptr ptr-len)
  "Converts a foreign string sequence separated by '\0' into a list of lisp strings."
  (let ((total-len 0))
    (loop until (eq total-len ptr-len)
          collect (let* ((str (foreign-string-to-lisp ptr))
                         (len (1+ (length str))))
                    (incf-pointer ptr len)
                    (incf total-len len)
                    str))))

(defmacro concatenate-string (&body rest)
  "Use concatenate to concat strings."
  #`(concatenate 'string #,@rest))

(define-syntax with-stream
  (syntax-rules ()
		"Open stream with name 'stream-name' and initialization 'init' and the close it."
		((_ (stream-name init) . body)
		 (let ((stream-name init))
		   (with-cleanup (close stream-name)
				 . body)))))

(defun string-list-len (ls)
  "Given a list of strings, return a list of string lengths plus one."
  (mapcar 1+ (mapcar length ls)))

(defun sum-list (ls)
  "Return sum of an number list."
  (apply + ls))

(defun list-to-foreign-string-zero-separated (ls ptr &optional ls-len)
  "Write a list of strings into a foreign array. Strings are '\0'-separated.
If you have the list with the length for each string pass it in ls-len."
  (unless ls-len
    (setf ls-len (string-list-len ls)))
  (loop* ((item #:in ls)
          (item-len #:in ls-len))
         #:do (progn
		(lisp-string-to-foreign item
					ptr
					item-len)
		(incf-pointer ptr item-len))))

(defmacro remove-declare (body)
  "Removes a potencial declare directive from body and returns it."
  `(when (and (>= (length ,body) 1)
              (eq (first (first ,body)) 'declare))
     (let ((ret (first ,body)))
       (setf ,body (rest ,body))
       ret)))

(defun microsecs->nanosecs (microsecs)
  "Convert microseconds to nanoseconds."
  (* microsecs 1000))

(defun nanosecs->microsecs (nanosecs)
  "Convert nanoseconds to microseconds."
  (/ nanosecs 1000))