;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE:               ffn=-n.lisp
;;;;LANGUAGE:           Common-Lisp
;;;;SYSTEM:             Common-Lisp
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;    
;;;;    Implements a function such as (= (f (f x))  (- x)) for some values...
;;;;    See http://www.informatimago.com/misc/ffn=-n.html
;;;;    
;;;;AUTHORS
;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;;    2008-03-09 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    GPL
;;;;    
;;;;    Copyright Pascal Bourguignon 2008 - 2008
;;;;    
;;;;    This program is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU General Public License
;;;;    as published by the Free Software Foundation; either version
;;;;    2 of the License, or (at your option) any later version.
;;;;    
;;;;    This program is distributed in the hope that it will be
;;;;    useful, but WITHOUT ANY WARRANTY; without even the implied
;;;;    warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;;;    PURPOSE.  See the GNU General Public License for more details.
;;;;    
;;;;    You should have received a copy of the GNU General Public
;;;;    License along with this program; if not, write to the Free
;;;;    Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;;    Boston, MA 02111-1307 USA
;;;;**************************************************************************

(declaim (ftype (function (integer) (unsigned-byte 32))
                32-bit
                32-bit/2-complement-neg))

(defun 32-bit (x)
  "Mask off 32-bits of X"
  (logand #xffffffff x))

(defun 32-bit/plusp (n)
  "Whether N represents a positive integer."
  (declare (type (unsigned-byte 32) n))
  (zerop (ldb (byte 1 31) n)))

(defun 32-bit/2-complement-neg (n)
  "Return the negation of N in 2-complement."
  (declare (type (unsigned-byte 32) n))
  (32-bit (1+ (lognot n))))


(defun integer/f (n)
  "
Assuming n is an INTEGER, (= (- n) (f (f n)))
     0 -->  0 
    +1 --> -2 --> -1 --> +2 --> +1
    +3 --> -4 --> -3 --> +4 --> +3
    ...
    +(2k+1) --> -(2k+2) --> -(2k+1) --> +(2k+2) --> +(2k+1)
"
  (declare (type integer n))
  (if (zerop n)
      0
      (if (plusp n)
          (if (oddp n)
              (1- (- n))
              (1- n))
          (if(oddp n)
              (1+ (- n))
              (1+ n)))))

(defun 32-bit/f (n)
  "
Assuming n is a 32-bit 2-complement signed integer different 
from 0 and -2³¹,  (= (- n) (f (f n)))
"
  (declare (type (unsigned-byte 32) n))
  (32-bit
   (case n                              ; (f (f n))
     ((#x00000000) #x80000001)          ; --> 0x80000000
     ((#x80000000) #x7FFFFFFF)          ; --> 0x00000000
     ((#x7FFFFFFF) #x00000000)          ; --> 0x80000001 
     ((#x80000001) #x80000000)          ; --> 0x7fffffff
     ;;  For the above exceptions, any permutation is valid;
     ;;  we choose here to break it for 0 and M, with
     ;;  f(f(0))=M and f(f(M))=0,
     ;;  to keep f(f(2³¹-1))= -(2³¹-1) and f(f(-(2³¹-1)))= 2³¹-1
     (otherwise
      (if (32-bit/plusp n)
          (if (oddp n)
              (lognot n)
              (1- n))
          (if (oddp n)
              (+ (lognot n) 2)
              (1+ n)))))))


(defun test-f ()
  (let* ((zet '32-bit)
         (f  (if (eq zet 'integer)
                 (function integer/f)
                 (function 32-bit/f)))
         (n  (if (eq zet 'integer)
                 (function -)
                 (function 32-bit/2-complement-neg)))
         (*print-base*  (if (eq zet 'integer) 10. 16.)))
    (loop
       :with range = 20
       :for i :in (append
                   (loop :repeat range :for i :from 0 :collect i)
                   (loop :repeat range :for i :from 1 :collect (funcall n i))
                   (loop :repeat range :for i :from (- #x80000000 range) :collect i)
                   (loop :repeat range :for i :from (- #x7fffffff range -2) :collect (funcall n i)))
       :initially (format t "~2%~{~12@A ~}~%"
                          '("i" "-i" "(f (f i))" "(f i)" "(- (f (f i)))"))
       :do (format t "    ~8,'0X     ~8,'0X ~:[  ~;/=~]  ~8,'0X    ~8,'0X     ~8,'0X ~%"
                   i
                   (funcall n i)
                   (/= (funcall n i)
                       (funcall f (funcall f i)))
                   (funcall f (funcall f i))
                   (funcall f i)
                   (funcall n (funcall f (funcall f i)))))))

;;;; THE END ;;;;