(load "ghelper")
(load "discovery")

(define inverse
  (make-generic-operator 1 #f 'inverse))
(define plus
  (make-generic-operator 2 #f 'plus))
(define minus
  (make-generic-operator 2 #f 'minus))
  
(assign-operation inverse
          (lambda (x) (/ 1 x))
          (lambda (x) (and (number? x)
                   (not (integer? x)))))

; actually a transpose, but meh
(assign-operation inverse
          (lambda (x) (apply zip x))
          (lambda (x) 
            (and (list? x)
             (for-all? x list?))))

(define any? (lambda (x) #t))
(assign-operation minus - any? any?)
(assign-operation plus + any? any?)

(plus 1 2)
; 3

;(minus 3)
; ERROR

(inverse 6.5)
;Value: .15384615384615385

(discover:opers-for 6.5)
;Value 52: (inverse #[compound-procedure 49 operator])

(discover:named-opers-for 6.5)
;Value 53: (inverse)

(discover:named-opers-for 1 2)
;Value 54: (plus minus)

(environment-lookup (the-environment) 'inverse)
;Value 49: #[compound-procedure 49 operator]

(hash-table/get *generic-operator-table* inverse #f)
;Value 59: (1 (#[compound-procedure 57] . #[compound-procedure 60]) (#[compound-procedure 61] . #[compound-procedure 62]))

(hash-table/get *generic-operator-table* minus #f)
;Value 63: (2 (#[compound-procedure 56 any?] (#[compound-procedure 56 any?] . #[arity-dispatched-procedure 28])))

(hash-table-size *generic-operator-table*)
;Value: 6    ; for this file
;Value: 92   ; for scmutils

;this prints all keys line by line
(for-each
 (lambda (x) (newline)
     (display x))
 (hash-table/key-list *generic-operator-table*))

(define add1 (make-generic-operator 1 #f 'add1))
(define sub1 (make-generic-operator 1 #f 'sub1))
(define double (make-generic-operator 1 #f 'double))
(define square (make-generic-operator 1 #f 'square))
(define inverse (make-generic-operator 1 #f 'inverse))
(defhandler add1 (lambda (x) (+ x 1)) number?)
(defhandler sub1 (lambda (x) (- x 1)) number?)
(defhandler double (lambda (x) (* 2 x)) number?)
(defhandler square (lambda (x) (* x x)) number?)
(defhandler inverse (lambda (x) (/ 1 x)) (lambda (n)
                       (and (number? n)
                        (not (zero? n)))))

(discover:apply-all 3)
;Value 89: (1/3 4 9 2 6)

(discover:satisfy (lambda (x) (eq? x 9)) (/ 1 2))
;Value 35: (9)

(discover:satisfy-sequence (lambda (x) (eq? x 9)) (/ 1 2))
;Value 36: (((9) square double add1) ((9) square add1 inverse))

(discover:satisfy-sequence (lambda (x) (eq? x 49)) (/ 5 6))
;Value 37: (((49) square sub1 inverse sub1))

(define (prime? n)
  (cond ((null? n) #f)
	((not (integer? n)) #f)
	((> 0 n) #f)
	(else (let lp ((m 2))
		(cond ((> m (sqrt n)) #t)
		      ((integer? (/ n m)) #f)
		      (else (lp (+ m 1))))))))

(prime? 47)
; #t

(discover:satisfy-sequence prime? (/ 5 6))
;Value 39: (((5) inverse sub1 inverse))

(discover:satisfy-sequence prime? 923)
;Value 44: (((1847) add1 double))

(discover:named-opers)