File: toolkit.lisp

package info (click to toggle)
acl2 8.6%2Bdfsg-3
  • links: PTS
  • area: main
  • in suites: sid
  • size: 1,138,276 kB
  • sloc: lisp: 17,818,294; java: 125,359; python: 28,122; javascript: 23,458; cpp: 18,851; ansic: 11,569; perl: 7,678; xml: 5,591; sh: 3,978; makefile: 3,840; ruby: 2,633; yacc: 1,126; ml: 763; awk: 295; csh: 233; lex: 197; php: 178; tcl: 49; asm: 23; haskell: 17
file content (85 lines) | stat: -rw-r--r-- 2,254 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
(in-package #:org.shirakumo.zippy)

(defvar *default-version-made*
  '(4 5))

(defvar *default-version-needed*
  '(2 0))

(defun version< (version1 version2)
  (destructuring-bind (major1 minor1) version1
    (destructuring-bind (major2 minor2) version2
      (or (< major1 major2)
          (and (= major1 major2) (< minor1 minor2))))))

(defvar *compatibility*
  #+windows :ntfs
  #+darwin :darwin
  #+(and unix (not darwin)) :unix)

(defvar *default-buffer-size* 4096)

(defun default-attributes-for (system)
  (case system
    ((:darwin :unix) #o644)
    (T 0)))

(defun ensure-buffer (buffer)
  (etypecase buffer
    (vector buffer)
    (integer (make-array buffer :element-type '(unsigned-byte 8)))
    (null (make-array *default-buffer-size* :element-type '(unsigned-byte 8)))))

(defun ensure-password (password)
  (etypecase password
    (string (babel:string-to-octets password :encoding :utf-8))
    ((vector (unsigned-byte 8)) password)
    (null (restart-case (error 'password-required)
            (use-value (password)
              (ensure-password password))))))

(defun alist-vector (alist)
  (let* ((max (loop for cons in alist maximize (car cons)))
         (vec (make-array (1+ max) :initial-element :unknown)))
    (loop for (i . e) in alist
          do (setf (svref vec i) e))
    vec))

(defun alist-table (alist)
  (let ((table (make-hash-table)))
    (loop for (i . e) in alist
          do (setf (gethash i table) e))
    table))

(defun n-bit-p (bits &rest integers)
  (let ((max (1- (ash 1 bits))))
    (every (lambda (integer) (< integer max)) integers)))

(defun cap (value bits)
  (let ((max (1- (ash 1 bits))))
    (if (< max value)
        max
        value)))

(defun bitfield (&rest bits)
  (let ((int 0))
    (loop for i from 0
          for bit in bits
          do (when bit (setf (ldb (byte 1 i) int) 1)))
    int))

(defun enbitfield (list &rest bits)
  (let ((int 0))
    (loop for i from 0
          for bit in bits
          do (when (find bit list) (setf (ldb (byte 1 i) int) 1)))
    int))

(defun debitfield (int &rest bits)
  (loop for i from 0
        for bit in bits
        when (logbitp i int)
        collect bit))

(defun enlist (thing &rest values)
  (if (listp thing) thing (list* thing values)))