;;; -------- Lambda calculus Booleans

(setq true (lambda (x) (lambda (y) x)))
(closure (t) (x) #'(lambda (y) x))
(setq false (lambda (x) (lambda (y) y))) 
(closure (t) (x) #'(lambda (y) y))

;; (b false) true


; (true false) true ->

(\x.(\y.x) \x'.(\y'.y')) any -> (\y. (\x'. (\y' y'))) any -> (\x'. (\y' y'))

;; --- logical NOT b:  (b false) true

(funcall true false)
(closure ((x closure (t) (x) #'...) t) (y) x)

(funcall (funcall true false) true)
(closure (t) (x) #'(lambda (y) y))

(funcall (funcall false false) true)
(closure (t) (x) #'(lambda (y) x))

;; --- logical AND a b:  a b false 

(funcall true true) 
(closure ((x closure (t) (x) #'...) t) (y) x)

(funcall (funcall true true) false)
(closure (t) (x) #'(lambda (y) x))

(equal (funcall (funcall true true) false)
       false)
nil

(equal (funcall (funcall true true) false)
       true)
t

(funcall (funcall true false) false)
(closure (t) (x) #'(lambda (y) y))

(equal (funcall (funcall true false) false)
       false)
t

(funcall (funcall false true) false)
(closure (t) (x) #'(lambda (y) y))

(funcall (funcall false false) false)
(closure (t) (x) #'(lambda (y) y))

;;; logical OR a b:  a true b 

(funcall false true) 
(closure ((x closure (t) (x) #'...) t) (y) y)

(print (funcall true true) )

(closure ((x closure (t) (x) #'(lambda (y) x)) t) (y) x)
(closure ((x closure (t) (x) #'...) t) (y) x)


(funcall (funcall false true) true)
(closure (t) (x) #'(lambda (y) x))  ; true 

(funcall (funcall true true) false) 
(closure (t) (x) #'(lambda (y) x))  ; true 

(funcall (funcall true true) true)
(closure (t) (x) #'(lambda (y) x))  ; true 

(funcall (funcall false true) false)
(closure (t) (x) #'(lambda (y) y))  ; false

;; ---- K and KI

(defun K (x)
  (lambda (y) x))
K

(defun KI (x)
  (lambda (y) y))
KI

(K 'f)
(closure ((x . f) t) (y) x)

(funcall (K 'f) 'g)
f

(funcall (KI 'f) 'g)
g

(disassemble-internal 'K 2 nil)
    doc:   ...
    args: (arg1)
  0	  constant  make-closure
  1	  constant  <compiled-function>
        doc:   ...
        args: (arg1)
      0	      constant  V0  
      1	      return    

  2	  stack-ref 2
  3	  call	    2
  4	  return    
nil

(disassemble-internal 'KI 2 nil)
    doc:   ...
    args: (arg1)
  0	  constant  <compiled-function>
        doc:   ...
        args: (arg1)
      0	      return    

  1	  return    
nil

;;; For comparison, we can define two-argument variants of K and KI and disassemble them:

(K2 'f 'g)
f

(KI2 'f 'g)
g

(defun K2 (x y) x)
K2

(defun KI2 (x y) y)
KI2

(disassemble-internal 'K2 2 nil)
    doc:   ...
    args: (arg1 arg2)  ; stack: [arg2 arg1]
  0	  stack-ref 1  ; stack: [arg1 arg2 arg1]
  1	  return    
nil

(disassemble-internal 'KI2 2 nil)
    doc:   ...
    args: (arg1 arg2)  ; stack: [arg2 arg1]
  0	  return       ; arg2 is the return value
nil