(in-package :de.bauhh.gilbert)

(declaim (inline lsdb))

(defun ldsb (byte-spec value)
  (- (logand
      (1- (ash 1 (byte-size byte-spec)))
      (+ (ldb byte-spec value)
         (ash 1 (1- (byte-size byte-spec)))))
     (ash 1 (1- (byte-size byte-spec)))))

(define-compiler-macro ldsb (&whole whole byte-spec value &environment env)
  (cond ((or (constantp byte-spec env)
             (and (typep byte-spec '(cons (member byte) (cons t (cons t null))))
                  (constantp (cadr byte-spec) env)
                  (constantp (caddr byte-spec) env)))
         ;; Sigh, we need a proper compiler eventually, ours are not smart enough.
         (let* ((evaled-byte-spec (eval byte-spec #|env|#))
                (n (byte-size evaled-byte-spec))
                (p (byte-position evaled-byte-spec)))
           `(the 
             (signed-byte ,n)
             (- (the (unsigned-byte ,n)
                     (logand (the (unsigned-byte ,(1+ n))
                                  (+ ,(if (= 0 p)
                                          `(logand ,value ,(1- (ash 1 n)))
                                          `(ldb ,byte-spec ,value))
                                     ,(ash 1 (1- n))))
                             ,(1- (ash 1 n))))
                ,(ash 1 (1- n))))))
        (t
         whole)))